diff --git a/src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs b/src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
index 94e6fa14d75c5cd605f2160cd9e1aeb553c90746..90506ab7badd0f32bfb130a245ff67dffeff0608 100644
--- a/src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
+++ b/src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
@@ -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)
]
diff --git a/src/Gargantext/Components/Nodes/Corpus/Types.purs b/src/Gargantext/Components/Nodes/Corpus/Types.purs
index ce0011703a3778384d41ca0e161b8dcdff8db378..65449ef16776339340d98ebcb3761c6711ce6311 100644
--- a/src/Gargantext/Components/Nodes/Corpus/Types.purs
+++ b/src/Gargantext/Components/Nodes/Corpus/Types.purs
@@ -1,19 +1,14 @@
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
diff --git a/src/Gargantext/Components/Nodes/Dashboard/Types.purs b/src/Gargantext/Components/Nodes/Dashboard/Types.purs
index 332662e34e3ef74580f9d33f811d353c02eae6cc..fa3bc1f7ceb570c847b47c7f5b03deae28e584fa 100644
--- a/src/Gargantext/Components/Nodes/Dashboard/Types.purs
+++ b/src/Gargantext/Components/Nodes/Dashboard/Types.purs
@@ -1,13 +1,10 @@
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(..))
diff --git a/src/Gargantext/Types.purs b/src/Gargantext/Types.purs
index d80e4e3e5a2dd955ff3ce558bbec76df3a541f6f..ae8da7ccbe864f32cb1a0241823c3a38a23356bb 100644
--- a/src/Gargantext/Types.purs
+++ b/src/Gargantext/Types.purs
@@ -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