Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Grégoire Locqueville
purescript-gargantext
Commits
f0c91864
Commit
f0c91864
authored
Jun 13, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[REFACT] read instances + fix warnings + code design
parent
28e62c6c
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
112 additions
and
101 deletions
+112
-101
Add.purs
src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
+18
-11
Types.purs
src/Gargantext/Components/Nodes/Corpus/Types.purs
+67
-58
Types.purs
src/Gargantext/Components/Nodes/Dashboard/Types.purs
+2
-5
Types.purs
src/Gargantext/Types.purs
+25
-27
No files found.
src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
View file @
f0c91864
...
@@ -9,12 +9,12 @@ import Effect.Uncurried (mkEffectFn1)
...
@@ -9,12 +9,12 @@ import Effect.Uncurried (mkEffectFn1)
import Gargantext.Components.Forest.Tree.Node (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton)
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.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT
import Gargantext.Types as GT
import Gargantext.Types (NodeType(..)
, readNodeType
)
import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix as R2
import Prelude (Unit, bind, const, map, pure, show, ($), (<>), (>), (<<<))
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as H
...
@@ -65,15 +65,14 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
...
@@ -65,15 +65,14 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
nodeName@(name' /\ _) <- R.useState' "Name"
nodeName@(name' /\ _) <- R.useState' "Name"
nodeType'@(nt /\ _) <- R.useState' $ fromMaybe NodeUser $ head nodeTypes
nodeType'@(nt /\ _) <- R.useState' $ fromMaybe NodeUser $ head nodeTypes
pure $ H.div {}
pure $ H.div {}
[ panelBody
readNodeType
nodeName nodeType'
[ panelBody nodeName nodeType'
, submitButton (AddNode name' nt) dispatch -- panelFooter nodeName nodeType'
, submitButton (AddNode name' nt) dispatch -- panelFooter nodeName nodeType'
]
]
where
where
panelBody :: (String -> NodeType)
panelBody :: R.State String
-> R.State String
-> R.State NodeType
-> R.State NodeType
-> R.Element
-> R.Element
panelBody
readIt
(_ /\ setNodeName) (nt /\ setNodeType) =
panelBody (_ /\ setNodeName) (nt /\ setNodeType) =
H.div {className: "panel-body"}
H.div {className: "panel-body"}
[ H.div {className: "row"}
[ H.div {className: "row"}
[ H.div {className: "col-md-10"}
[ H.div {className: "col-md-10"}
...
@@ -84,11 +83,14 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
...
@@ -84,11 +83,14 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
SettingsBox {edit} = settingsBox nt
SettingsBox {edit} = settingsBox nt
maybeEdit = [ if edit then
maybeEdit = [ if edit then
H.div {className: "form-group"}
H.div {className: "form-group"}
[ H.input { type: "text"
[ H.input { type
: "text"
, placeholder: "Node name"
, placeholder
: "Node name"
, defaultValue: "Write Name here"
, defaultValue: "Write Name here"
, className: "form-control"
, className : "form-control"
, onInput: mkEffectFn1 $ setNodeName <<< const <<< R2.unsafeEventValue
, onInput : mkEffectFn1
$ setNodeName
<<< const
<<< R2.unsafeEventValue
}
}
]
]
else
else
...
@@ -99,7 +101,12 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
...
@@ -99,7 +101,12 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
R.fragment [
R.fragment [
H.div {className: "form-group"} $ [
H.div {className: "form-group"} $ [
R2.select { className: "form-control"
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)
(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
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.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Generic.Rep.Show (genericShow)
import Data.List ((:))
import Data.Maybe (Maybe(..))
import Data.List as List
import Data.Maybe (Maybe)
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly)
import Gargantext.Components.Node (NodePoly)
import Gargantext.
Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.
Prelude
type Author = String
type Author = String
type Description = String
type Description = String
...
@@ -25,47 +20,47 @@ type MarkdownText = String
...
@@ -25,47 +20,47 @@ type MarkdownText = String
type Hash = String
type Hash = String
newtype Hyperdata =
newtype Hyperdata =
Hyperdata
Hyperdata { fields :: List.List FTField }
{
fields :: List.List FTField
}
instance decodeHyperdata :: DecodeJson Hyperdata where
instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do
decodeJson json = do
obj <- decodeJson json
obj <- decodeJson json
fields <- obj .: "fields"
fields <- obj .: "fields"
pure $ Hyperdata {fields}
pure $ Hyperdata {fields}
instance encodeHyperdata :: EncodeJson Hyperdata where
instance encodeHyperdata :: EncodeJson Hyperdata where
encodeJson (Hyperdata {fields}) = do
encodeJson (Hyperdata {fields}) = do
"fields" := fields
"fields" := fields
~> jsonEmptyObject
~> jsonEmptyObject
newtype Field a = Field {
newtype Field a =
name :: String
Field { name :: String
, typ :: a
, typ :: a
}
}
type FTField = Field FieldType
type FTField = Field FieldType
derive instance genericFTField :: Generic (Field FieldType) _
derive instance genericFTField :: Generic (Field FieldType) _
instance eqFTField :: Eq (Field FieldType) where
instance eqFTField :: Eq (Field FieldType) where
eq = genericEq
eq = genericEq
instance showFTField :: Show (Field FieldType) where
instance showFTField :: Show (Field FieldType) where
show = genericShow
show = genericShow
data FieldType =
data FieldType =
Haskell {
Haskell { haskell :: HaskellCode
haskell :: HaskellCode
, tag :: Tag
, tag :: Tag
}
}
| JSON { authors :: Author
| JSON {
, desc :: Description
authors :: Author
, query :: Query
, desc :: Description
, tag :: Tag
, query :: Query
, title :: Title
, tag :: Tag
}
, title :: Title
| Markdown { tag :: Tag
}
, text :: MarkdownText
| Markdown {
}
tag :: Tag
, text :: MarkdownText
}
isJSON :: FTField -> Boolean
isJSON :: FTField -> Boolean
...
@@ -90,10 +85,13 @@ getCorpusInfo as = case List.head (List.filter isJSON as) of
...
@@ -90,10 +85,13 @@ getCorpusInfo as = case List.head (List.filter isJSON as) of
}
}
derive instance genericFieldType :: Generic FieldType _
derive instance genericFieldType :: Generic FieldType _
instance eqFieldType :: Eq FieldType where
instance eqFieldType :: Eq FieldType where
eq = genericEq
eq = genericEq
instance showFieldType :: Show FieldType where
instance showFieldType :: Show FieldType where
show = genericShow
show = genericShow
instance decodeFTField :: DecodeJson (Field FieldType) where
instance decodeFTField :: DecodeJson (Field FieldType) where
decodeJson json = do
decodeJson json = do
obj <- decodeJson json
obj <- decodeJson json
...
@@ -118,6 +116,7 @@ instance decodeFTField :: DecodeJson (Field FieldType) where
...
@@ -118,6 +116,7 @@ instance decodeFTField :: DecodeJson (Field FieldType) where
pure $ Markdown {tag, text}
pure $ Markdown {tag, text}
_ -> Left $ "Unsupported 'type' " <> type_
_ -> Left $ "Unsupported 'type' " <> type_
pure $ Field {name, typ}
pure $ Field {name, typ}
instance encodeFTField :: EncodeJson (Field FieldType) where
instance encodeFTField :: EncodeJson (Field FieldType) where
encodeJson (Field {name, typ}) =
encodeJson (Field {name, typ}) =
"data" := typ
"data" := typ
...
@@ -128,6 +127,7 @@ instance encodeFTField :: EncodeJson (Field FieldType) where
...
@@ -128,6 +127,7 @@ instance encodeFTField :: EncodeJson (Field FieldType) where
typ' (Haskell _) = "Haskell"
typ' (Haskell _) = "Haskell"
typ' (JSON _) = "JSON"
typ' (JSON _) = "JSON"
typ' (Markdown _) = "Markdown"
typ' (Markdown _) = "Markdown"
instance encodeFieldType :: EncodeJson FieldType where
instance encodeFieldType :: EncodeJson FieldType where
encodeJson (Haskell {haskell}) =
encodeJson (Haskell {haskell}) =
"haskell" := haskell
"haskell" := haskell
...
@@ -146,42 +146,51 @@ instance encodeFieldType :: EncodeJson FieldType where
...
@@ -146,42 +146,51 @@ instance encodeFieldType :: EncodeJson FieldType where
~> jsonEmptyObject
~> jsonEmptyObject
defaultHaskell :: FieldType
defaultHaskell :: FieldType
defaultHaskell = Haskell defaultHaskell'
defaultHaskell = Haskell defaultHaskell'
defaultHaskell' = {
haskell: ""
defaultHaskell' :: { haskell :: String, tag :: String }
, tag: "HaskellField"
defaultHaskell' = { haskell: ""
}
, tag : "HaskellField"
}
defaultJSON :: FieldType
defaultJSON :: FieldType
defaultJSON = JSON defaultJSON'
defaultJSON = JSON defaultJSON'
defaultJSON' = {
authors: ""
, desc: ""
defaultJSON' :: { authors :: String
, query: ""
, desc :: String
, tag: "JSONField"
, query :: String
, title: ""
, tag :: String
}
, title :: String
}
defaultJSON' = { authors: ""
, desc: ""
, query: ""
, tag: "JSONField"
, title: ""
}
defaultMarkdown :: FieldType
defaultMarkdown :: FieldType
defaultMarkdown = Markdown defaultMarkdown'
defaultMarkdown = Markdown defaultMarkdown'
defaultMarkdown' = {
defaultMarkdown' :: { tag :: String
tag: "MarkdownField"
, text :: String
, text: "# New file"
}
}
defaultMarkdown' = { tag: "MarkdownField"
, text: "# New file"
}
defaultField :: FTField
defaultField :: FTField
defaultField = Field {
defaultField = Field { name: "New file"
name: "New file"
, typ: defaultMarkdown
, typ: defaultMarkdown
}
}
newtype CorpusInfo =
newtype CorpusInfo =
CorpusInfo
CorpusInfo
{ title :: String
{ title
:: String
, authors
:: String
, authors
:: String
, desc
:: String
, desc
:: String
, query
:: String
, query :: String
, totalRecords :: Int
, totalRecords :: Int
}
}
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do
decodeJson json = do
...
...
src/Gargantext/Components/Nodes/Dashboard/Types.purs
View file @
f0c91864
module Gargantext.Components.Nodes.Dashboard.Types where
module Gargantext.Components.Nodes.Dashboard.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.Maybe (Maybe)
import Data.Maybe (Maybe
(..)
)
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get, put)
import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (NodeType(..))
import Gargantext.Types (NodeType(..))
...
...
src/Gargantext/Types.purs
View file @
f0c91864
...
@@ -9,11 +9,11 @@ import Data.Generic.Rep.Eq (genericEq)
...
@@ -9,11 +9,11 @@ import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Show (genericShow)
import Data.Generic.Rep.Show (genericShow)
import Data.Int (toNumber)
import Data.Int (toNumber)
import Data.Maybe (Maybe(..), maybe)
import Data.Maybe (Maybe(..), maybe
, fromMaybe
)
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import Prim.Row (class Union)
import Prim.Row (class Union)
import URI.Query (Query)
import URI.Query (Query)
import Gargantext.Prelude (class Read)
import Gargantext.Prelude (class Read
, read
)
type ID = Int
type ID = Int
type Name = String
type Name = String
...
@@ -178,30 +178,28 @@ instance showNodeType :: Show NodeType where
...
@@ -178,30 +178,28 @@ instance showNodeType :: Show NodeType where
show NodeList = "NodeList"
show NodeList = "NodeList"
show Texts = "NodeTexts"
show Texts = "NodeTexts"
readNodeType :: String -> NodeType
instance readNodeType :: Read NodeType where
readNodeType "NodeUser" = NodeUser
read "NodeUser" = Just NodeUser
read "NodeFolder" = Just Folder
readNodeType "NodeFolder" = Folder
read "NodeFolderPrivate" = Just FolderPrivate
readNodeType "NodeFolderPrivate" = FolderPrivate
read "NodeFolderShared" = Just FolderShared
readNodeType "NodeFolderShared" = FolderShared
read "NodeFolderPublic" = Just FolderPublic
readNodeType "NodeFolderPublic" = FolderPublic
read "NodeAnnuaire" = Just Annuaire
read "NodeDashboard" = Just Dashboard
readNodeType "NodeAnnuaire" = Annuaire
read "Document" = Just Url_Document
readNodeType "NodeDashboard" = Dashboard
read "NodeGraph" = Just Graph
readNodeType "Document" = Url_Document
read "NodePhylo" = Just Phylo
readNodeType "NodeGraph" = Graph
read "Individu" = Just Individu
readNodeType "NodePhylo" = Phylo
read "Node" = Just Node
readNodeType "Individu" = Individu
read "Nodes" = Just Nodes
readNodeType "Node" = Node
read "NodeCorpus" = Just Corpus
readNodeType "Nodes" = Nodes
read "NodeContact" = Just NodeContact
readNodeType "NodeCorpus" = Corpus
read "Tree" = Just Tree
readNodeType "NodeContact" = NodeContact
read "NodeTeam" = Just Team
readNodeType "Tree" = Tree
read "NodeList" = Just NodeList
readNodeType "NodeTeam" = Team
read "NodeTexts" = Just Texts
readNodeType "NodeList" = NodeList
read "Annuaire" = Just Annuaire
readNodeType "NodeTexts" = Texts
read _ = Nothing
readNodeType "Annuaire" = Annuaire
readNodeType _ = Error
fldr :: NodeType -> Boolean -> String
fldr :: NodeType -> Boolean -> String
...
@@ -256,7 +254,7 @@ instance eqNodeType :: Eq NodeType where
...
@@ -256,7 +254,7 @@ instance eqNodeType :: Eq NodeType where
instance decodeJsonNodeType :: DecodeJson NodeType where
instance decodeJsonNodeType :: DecodeJson NodeType where
decodeJson json = do
decodeJson json = do
obj <- decodeJson json
obj <- decodeJson json
pure $
readNodeType
obj
pure $
fromMaybe Error $ read
obj
instance encodeJsonNodeType :: EncodeJson NodeType where
instance encodeJsonNodeType :: EncodeJson NodeType where
encodeJson nodeType = encodeJson $ show nodeType
encodeJson nodeType = encodeJson $ show nodeType
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment