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)
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
...
...
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