Skip to content

P
purescript-gargantext
Commit f0c91864 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[REFACT] read instances + fix warnings + code design

parent 28e62c6c
Hide whitespace changes
Inline Side-by-side
Showing with 112 additions and 101 deletions
src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
View file @ f0c91864
......@@ -9,12 +9,12 @@ import Effect.Uncurried (mkEffectFn1)
import Gargantext.Components.Forest.Tree.Node (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton)
import Gargantext.Prelude (Unit, bind, const, map, pure, show, ($), (<>), (>), (<<<), read)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT
import Gargantext.Types (NodeType(..), readNodeType)
import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
import Prelude (Unit, bind, const, map, pure, show, ($), (<>), (>), (<<<))
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -65,15 +65,14 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
nodeName@(name' /\ _) <- R.useState' "Name"
nodeType'@(nt /\ _) <- R.useState' $ fromMaybe NodeUser $ head nodeTypes
pure $ H.div {}
[ panelBody readNodeType nodeName nodeType'
[ panelBody nodeName nodeType'
, submitButton (AddNode name' nt) dispatch -- panelFooter nodeName nodeType'
]
where
panelBody :: (String -> NodeType)
-> R.State String
panelBody :: R.State String
-> R.State NodeType
-> R.Element
panelBody readIt (_ /\ setNodeName) (nt /\ setNodeType) =
panelBody (_ /\ setNodeName) (nt /\ setNodeType) =
H.div {className: "panel-body"}
[ H.div {className: "row"}
[ H.div {className: "col-md-10"}
......@@ -84,11 +83,14 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
SettingsBox {edit} = settingsBox nt
maybeEdit = [ if edit then
H.div {className: "form-group"}
[ H.input { type: "text"
, placeholder: "Node name"
[ H.input { type : "text"
, placeholder : "Node name"
, defaultValue: "Write Name here"
, className: "form-control"
, onInput: mkEffectFn1 $ setNodeName <<< const <<< R2.unsafeEventValue
, className : "form-control"
, onInput : mkEffectFn1
$ setNodeName
<<< const
<<< R2.unsafeEventValue
}
]
else
......@@ -99,7 +101,12 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
R.fragment [
H.div {className: "form-group"} $ [
R2.select { className: "form-control"
, onChange: mkEffectFn1 $ setNodeType <<< const <<< readIt <<< R2.unsafeEventValue
, onChange : mkEffectFn1
$ setNodeType
<<< const
<<< fromMaybe Error
<<< read
<<< R2.unsafeEventValue
}
(map (\opt -> H.option {} [ H.text $ show opt ]) nodeTypes)
]
......
src/Gargantext/Components/Nodes/Corpus/Types.purs
View file @ f0c91864
module Gargantext.Components.Nodes.Corpus.Types where
import Data.Maybe (Maybe(..))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (.:?), (:=), (~>), jsonEmptyObject)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.List as List
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.List ((:))
import Data.List as List
import Data.Maybe (Maybe)
import Gargantext.Prelude
import Data.Maybe (Maybe(..))
import Gargantext.Components.Node (NodePoly)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Prelude
type Author = String
type Description = String
......@@ -25,47 +20,47 @@ type MarkdownText = String
type Hash = String
newtype Hyperdata =
Hyperdata
{
fields :: List.List FTField
}
Hyperdata { fields :: List.List FTField }
instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do
obj <- decodeJson json
fields <- obj .: "fields"
pure $ Hyperdata {fields}
instance encodeHyperdata :: EncodeJson Hyperdata where
encodeJson (Hyperdata {fields}) = do
"fields" := fields
~> jsonEmptyObject
newtype Field a = Field {
name :: String
, typ :: a
}
newtype Field a =
Field { name :: String
, typ :: a
}
type FTField = Field FieldType
derive instance genericFTField :: Generic (Field FieldType) _
instance eqFTField :: Eq (Field FieldType) where
eq = genericEq
instance showFTField :: Show (Field FieldType) where
show = genericShow
data FieldType =
Haskell {
haskell :: HaskellCode
, tag :: Tag
}
| JSON {
authors :: Author
, desc :: Description
, query :: Query
, tag :: Tag
, title :: Title
}
| Markdown {
tag :: Tag
, text :: MarkdownText
}
Haskell { haskell :: HaskellCode
, tag :: Tag
}
| JSON { authors :: Author
, desc :: Description
, query :: Query
, tag :: Tag
, title :: Title
}
| Markdown { tag :: Tag
, text :: MarkdownText
}
isJSON :: FTField -> Boolean
......@@ -90,10 +85,13 @@ getCorpusInfo as = case List.head (List.filter isJSON as) of
}
derive instance genericFieldType :: Generic FieldType _
instance eqFieldType :: Eq FieldType where
eq = genericEq
instance showFieldType :: Show FieldType where
show = genericShow
instance decodeFTField :: DecodeJson (Field FieldType) where
decodeJson json = do
obj <- decodeJson json
......@@ -118,6 +116,7 @@ instance decodeFTField :: DecodeJson (Field FieldType) where
pure $ Markdown {tag, text}
_ -> Left $ "Unsupported 'type' " <> type_
pure $ Field {name, typ}
instance encodeFTField :: EncodeJson (Field FieldType) where
encodeJson (Field {name, typ}) =
"data" := typ
......@@ -128,6 +127,7 @@ instance encodeFTField :: EncodeJson (Field FieldType) where
typ' (Haskell _) = "Haskell"
typ' (JSON _) = "JSON"
typ' (Markdown _) = "Markdown"
instance encodeFieldType :: EncodeJson FieldType where
encodeJson (Haskell {haskell}) =
"haskell" := haskell
......@@ -146,42 +146,51 @@ instance encodeFieldType :: EncodeJson FieldType where
~> jsonEmptyObject
defaultHaskell :: FieldType
defaultHaskell = Haskell defaultHaskell'
defaultHaskell' = {
haskell: ""
, tag: "HaskellField"
}
defaultHaskell = Haskell defaultHaskell'
defaultHaskell' :: { haskell :: String, tag :: String }
defaultHaskell' = { haskell: ""
, tag : "HaskellField"
}
defaultJSON :: FieldType
defaultJSON = JSON defaultJSON'
defaultJSON' = {
authors: ""
, desc: ""
, query: ""
, tag: "JSONField"
, title: ""
}
defaultJSON' :: { authors :: String
, desc :: String
, query :: String
, tag :: String
, title :: String
}
defaultJSON' = { authors: ""
, desc: ""
, query: ""
, tag: "JSONField"
, title: ""
}
defaultMarkdown :: FieldType
defaultMarkdown = Markdown defaultMarkdown'
defaultMarkdown' = {
tag: "MarkdownField"
, text: "# New file"
}
defaultMarkdown' :: { tag :: String
, text :: String
}
defaultMarkdown' = { tag: "MarkdownField"
, text: "# New file"
}
defaultField :: FTField
defaultField = Field {
name: "New file"
, typ: defaultMarkdown
}
defaultField = Field { name: "New file"
, typ: defaultMarkdown
}
newtype CorpusInfo =
CorpusInfo
{ title :: String
, authors :: String
, desc :: String
, query :: String
, totalRecords :: Int }
CorpusInfo { title :: String
, authors :: String
, desc :: String
, query :: String
, totalRecords :: Int
}
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do
......
src/Gargantext/Components/Nodes/Dashboard/Types.purs
View file @ f0c91864
module Gargantext.Components.Nodes.Dashboard.Types where
import Data.Maybe (Maybe(..))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (.:?), (:=), (~>), jsonEmptyObject)
import Data.Maybe (Maybe)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (NodeType(..))
......
src/Gargantext/Types.purs
View file @ f0c91864
......@@ -9,11 +9,11 @@ import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Show (genericShow)
import Data.Int (toNumber)
import Data.Maybe (Maybe(..), maybe)
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Effect.Aff (Aff)
import Prim.Row (class Union)
import URI.Query (Query)
import Gargantext.Prelude (class Read)
import Gargantext.Prelude (class Read, read)
type ID = Int
type Name = String
......@@ -178,30 +178,28 @@ instance showNodeType :: Show NodeType where
show NodeList = "NodeList"
show Texts = "NodeTexts"
readNodeType :: String -> NodeType
readNodeType "NodeUser" = NodeUser
readNodeType "NodeFolder" = Folder
readNodeType "NodeFolderPrivate" = FolderPrivate
readNodeType "NodeFolderShared" = FolderShared
readNodeType "NodeFolderPublic" = FolderPublic
readNodeType "NodeAnnuaire" = Annuaire
readNodeType "NodeDashboard" = Dashboard
readNodeType "Document" = Url_Document
readNodeType "NodeGraph" = Graph
readNodeType "NodePhylo" = Phylo
readNodeType "Individu" = Individu
readNodeType "Node" = Node
readNodeType "Nodes" = Nodes
readNodeType "NodeCorpus" = Corpus
readNodeType "NodeContact" = NodeContact
readNodeType "Tree" = Tree
readNodeType "NodeTeam" = Team
readNodeType "NodeList" = NodeList
readNodeType "NodeTexts" = Texts
readNodeType "Annuaire" = Annuaire
readNodeType _ = Error
instance readNodeType :: Read NodeType where
read "NodeUser" = Just NodeUser
read "NodeFolder" = Just Folder
read "NodeFolderPrivate" = Just FolderPrivate
read "NodeFolderShared" = Just FolderShared
read "NodeFolderPublic" = Just FolderPublic
read "NodeAnnuaire" = Just Annuaire
read "NodeDashboard" = Just Dashboard
read "Document" = Just Url_Document
read "NodeGraph" = Just Graph
read "NodePhylo" = Just Phylo
read "Individu" = Just Individu
read "Node" = Just Node
read "Nodes" = Just Nodes
read "NodeCorpus" = Just Corpus
read "NodeContact" = Just NodeContact
read "Tree" = Just Tree
read "NodeTeam" = Just Team
read "NodeList" = Just NodeList
read "NodeTexts" = Just Texts
read "Annuaire" = Just Annuaire
read _ = Nothing
fldr :: NodeType -> Boolean -> String
......@@ -256,7 +254,7 @@ instance eqNodeType :: Eq NodeType where
instance decodeJsonNodeType :: DecodeJson NodeType where
decodeJson json = do
obj <- decodeJson json
pure $ readNodeType obj
pure $ fromMaybe Error $ read obj
instance encodeJsonNodeType :: EncodeJson NodeType where
encodeJson nodeType = encodeJson $ show nodeType
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment