Commit f844290a authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-doc-table-optimization

parents c86fd7e8 1a198895
...@@ -204,6 +204,7 @@ a:focus, a:hover { ...@@ -204,6 +204,7 @@ a:focus, a:hover {
.copy-from-corpus .tree .node { .copy-from-corpus .tree .node {
padding-left: 10px; padding-left: 10px;
margin-top: 5px;
} }
.copy-from-corpus .tree .node .name.clickable { .copy-from-corpus .tree .node .name.clickable {
color: #337ab7; color: #337ab7;
......
...@@ -192,6 +192,7 @@ a:focus, a:hover ...@@ -192,6 +192,7 @@ a:focus, a:hover
.tree .tree
.node .node
padding-left: 10px padding-left: 10px
margin-top: 5px
.name .name
&.clickable &.clickable
color: #337ab7 color: #337ab7
......
{ {
"name": "Gargantext", "name": "Gargantext",
"version": "0.0.1.6.2", "version": "0.0.1.6.3",
"scripts": { "scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall", "rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall", "rebuild-set": "spago psc-package-insdhall",
......
...@@ -38,7 +38,7 @@ annotationMenuCpt :: R.Component Props ...@@ -38,7 +38,7 @@ annotationMenuCpt :: R.Component Props
annotationMenuCpt = R.hooksComponent "Annotation.Menu" cpt annotationMenuCpt = R.hooksComponent "Annotation.Menu" cpt
where where
cpt props _ = pure $ R.fragment $ children props cpt props _ = pure $ R.fragment $ children props
children props = A.mapMaybe (addToList props) [ GraphTerm, CandidateTerm, StopTerm ] children props = A.mapMaybe (addToList props) [ MapTerm, CandidateTerm, StopTerm ]
-- | Given the TermList to render the item for zand the Maybe TermList the item may belong to, possibly render the menuItem -- | Given the TermList to render the item for zand the Maybe TermList the item may belong to, possibly render the menuItem
addToList :: Record Props -> TermList -> Maybe R.Element addToList :: Record Props -> TermList -> Maybe R.Element
......
...@@ -3,11 +3,11 @@ module Gargantext.Components.Annotation.Utils where ...@@ -3,11 +3,11 @@ module Gargantext.Components.Annotation.Utils where
import Gargantext.Types ( TermList(..) ) import Gargantext.Types ( TermList(..) )
termClass :: TermList -> String termClass :: TermList -> String
termClass GraphTerm = "graph-term" termClass MapTerm = "graph-term"
termClass StopTerm = "stop-term" termClass StopTerm = "stop-term"
termClass CandidateTerm = "candidate-term" termClass CandidateTerm = "candidate-term"
termBootstrapClass :: TermList -> String termBootstrapClass :: TermList -> String
termBootstrapClass GraphTerm = "success" termBootstrapClass MapTerm = "success"
termBootstrapClass StopTerm = "danger" termBootstrapClass StopTerm = "danger"
termBootstrapClass CandidateTerm = "warning" termBootstrapClass CandidateTerm = "warning"
...@@ -185,24 +185,23 @@ toJsTree maybeSurname (TreeNode x) = ...@@ -185,24 +185,23 @@ toJsTree maybeSurname (TreeNode x) =
where where
name = maybe "" (\x' -> x' <> ">") maybeSurname <> x.name name = maybe "" (\x' -> x' <> ">") maybeSurname <> x.name
data TreeNode = TreeNode { name :: String data TreeNode = TreeNode {
, value :: Int name :: String
, children :: Array TreeNode , value :: Int
} , children :: Array TreeNode
}
instance decodeTreeNode :: DecodeJson TreeNode where instance decodeTreeNode :: DecodeJson TreeNode where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
children <- obj .: "children"
name <- obj .: "label" name <- obj .: "label"
value <- obj .: "value" value <- obj .: "value"
children <- obj .: "children" pure $ TreeNode { children, name, value }
pure $ TreeNode {name, value, children}
instance encodeTreeNode :: EncodeJson TreeNode where instance encodeTreeNode :: EncodeJson TreeNode where
encodeJson (TreeNode { children, name, value }) = encodeJson (TreeNode { children, name, value }) =
"children" := encodeJson children "children" := encodeJson children
~> "name" := encodeJson name ~> "label" := encodeJson name
~> "value" := encodeJson value ~> "value" := encodeJson value
~> jsonEmptyObject ~> jsonEmptyObject
......
...@@ -348,7 +348,7 @@ pageCpt = R.hooksComponent "G.C.FacetsTable.Page" cpt ...@@ -348,7 +348,7 @@ pageCpt = R.hooksComponent "G.C.FacetsTable.Page" cpt
] ]
, delete: true } , delete: true }
where where
markClick _ = markCategory session nodeId category [id] markClick _ = markCategory session nodeId category [id]
toggleClick _ = togglePendingDeletion deletions id toggleClick _ = togglePendingDeletion deletions id
maybeStricken delete maybeStricken delete
| delete = H.div { style: { textDecoration: "line-through" } } | delete = H.div { style: { textDecoration: "line-through" } }
......
...@@ -10,6 +10,7 @@ import Effect.Aff (Aff) ...@@ -10,6 +10,7 @@ import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node (nodeMainSpan) import Gargantext.Components.Forest.Tree.Node (nodeMainSpan)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode) import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode) import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode)
...@@ -104,8 +105,6 @@ getNodeTree :: Session -> GT.ID -> Aff FTree ...@@ -104,8 +105,6 @@ getNodeTree :: Session -> GT.ID -> Aff FTree
getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) "" getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
-------------- --------------
type TreeViewProps = ( asyncTasks :: R.State GAT.Storage type TreeViewProps = ( asyncTasks :: R.State GAT.Storage
, tree :: FTree , tree :: FTree
, tasks :: Record Tasks , tasks :: Record Tasks
...@@ -306,17 +305,26 @@ performAction (UploadFile nodeType fileType mName contents) { session ...@@ -306,17 +305,26 @@ performAction (UploadFile nodeType fileType mName contents) { session
performAction DownloadNode _ = do performAction DownloadNode _ = do
liftEffect $ log "[performAction] DownloadNode" liftEffect $ log "[performAction] DownloadNode"
------- -------
performAction (MoveNode n1 n2) p@{session} = do performAction (MoveNode {params}) p@{session} =
void $ moveNodeReq session n1 n2 case params of
performAction RefreshTree p Nothing -> performAction NoAction p
Just (SubTreeOut {in:in',out}) -> do
void $ moveNodeReq session in' out
performAction RefreshTree p
performAction (MergeNode n1 n2) p@{session} = do performAction (MergeNode {params}) p@{session} =
void $ mergeNodeReq session n1 n2 case params of
performAction RefreshTree p Nothing -> performAction NoAction p
Just (SubTreeOut {in:in',out}) -> do
void $ mergeNodeReq session in' out
performAction RefreshTree p
performAction (LinkNode n1 n2) p@{session} = do performAction (LinkNode {params}) p@{session} =
void $ linkNodeReq session n1 n2 case params of
performAction RefreshTree p Nothing -> performAction NoAction p
Just (SubTreeOut {in:in',out}) -> do
void $ linkNodeReq session in' out
performAction RefreshTree p
------- -------
performAction RefreshTree { reload: (_ /\ setReload) } = do performAction RefreshTree { reload: (_ /\ setReload) } = do
......
...@@ -14,6 +14,7 @@ import Gargantext.Components.Forest.Tree.Node.Box.Types (CommonProps) ...@@ -14,6 +14,7 @@ import Gargantext.Components.Forest.Tree.Node.Box.Types (CommonProps)
import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (asyncProgressBar, BarType(..)) import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (asyncProgressBar, BarType(..))
import Gargantext.Components.Forest.Tree.Node.Tools.Task (Tasks) import Gargantext.Components.Forest.Tree.Node.Tools.Task (Tasks)
import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, nodeActionsNodeList) import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, nodeActionsNodeList)
import Gargantext.Components.Forest.Tree.Node.Tools (nodeText)
import Gargantext.Components.GraphExplorer.API as GraphAPI import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Components.Lang (Lang(EN)) import Gargantext.Components.Lang (Lang(EN))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild) import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
...@@ -166,28 +167,6 @@ fldr nt open = if open ...@@ -166,28 +167,6 @@ fldr nt open = if open
-} -}
-- START node text
type NodeTextProps =
( isSelected :: Boolean
, name :: Name
)
nodeText :: Record NodeTextProps -> R.Element
nodeText p = R.createElement nodeTextCpt p []
nodeTextCpt :: R.Component NodeTextProps
nodeTextCpt = R.hooksComponent "G.C.F.T.N.B.nodeText" cpt
where
cpt { isSelected: true, name } _ = do
pure $ H.u {} [
H.b {} [
H.text ("| " <> name <> " | ")
]
]
cpt {isSelected: false, name} _ = do
pure $ H.text (name <> " ")
-- END node text
-- START nodeActions -- START nodeActions
type NodeActionsProps = type NodeActionsProps =
......
module Gargantext.Components.Forest.Tree.Node.Action where module Gargantext.Components.Forest.Tree.Node.Action where
import Data.Maybe (Maybe) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Prelude (class Show, Unit) import Gargantext.Prelude (class Show, Unit)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), glyphiconNodeAction, SubTreeParams(..)) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut, SubTreeParams(..))
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), glyphiconNodeAction)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileContents) import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileContents)
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (UpdateNodeParams) import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (UpdateNodeParams)
{-
type UpdateNodeProps = type Props =
( id :: GT.ID ( dispatch :: Action -> Aff Unit
, dispatch :: Action -> Aff Unit , id :: Int
, name :: GT.Name , nodeType :: GT.NodeType
, nodeType :: NodeType , session :: Session
, params :: UpdateNodeParams
) )
-}
data Action = AddNode String GT.NodeType data Action = AddNode String GT.NodeType
| DeleteNode | DeleteNode
...@@ -28,11 +28,27 @@ data Action = AddNode String GT.NodeType ...@@ -28,11 +28,27 @@ data Action = AddNode String GT.NodeType
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents | UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
| DownloadNode | DownloadNode
| RefreshTree | RefreshTree
| MoveNode GT.NodeID GT.NodeID
| MergeNode GT.NodeID GT.NodeID | MoveNode {params :: Maybe SubTreeOut}
| LinkNode GT.NodeID GT.NodeID | MergeNode {params :: Maybe SubTreeOut}
| LinkNode {params :: Maybe SubTreeOut}
| NoAction | NoAction
subTreeOut :: Action -> Maybe SubTreeOut
subTreeOut (MoveNode {params}) = params
subTreeOut (MergeNode {params}) = params
subTreeOut (LinkNode {params}) = params
subTreeOut _ = Nothing
setTreeOut :: Action -> Maybe SubTreeOut -> Action
setTreeOut (MoveNode {params:_}) p = MoveNode {params: p}
setTreeOut (MergeNode {params:_}) p = MergeNode {params: p}
setTreeOut (LinkNode {params:_}) p = LinkNode {params: p}
setTreeOut a _ = a
instance showShow :: Show Action where instance showShow :: Show Action where
show (AddNode _ _ )= "AddNode" show (AddNode _ _ )= "AddNode"
show DeleteNode = "DeleteNode" show DeleteNode = "DeleteNode"
...@@ -43,17 +59,11 @@ instance showShow :: Show Action where ...@@ -43,17 +59,11 @@ instance showShow :: Show Action where
show (UploadFile _ _ _ _)= "UploadFile" show (UploadFile _ _ _ _)= "UploadFile"
show RefreshTree = "RefreshTree" show RefreshTree = "RefreshTree"
show DownloadNode = "Download" show DownloadNode = "Download"
show (MoveNode _ _) = "MoveNode" show (MoveNode _ ) = "MoveNode"
show (MergeNode _ _) = "MergeNode" show (MergeNode _ ) = "MergeNode"
show (LinkNode _ _) = "LinkNode" show (LinkNode _ ) = "LinkNode"
show NoAction = "NoAction" show NoAction = "NoAction"
type Props =
( dispatch :: Action -> Aff Unit
, id :: Int
, nodeType :: GT.NodeType
, session :: Session
)
----------------------------------------------------------------------- -----------------------------------------------------------------------
icon :: Action -> String icon :: Action -> String
icon (AddNode _ _) = glyphiconNodeAction (Add []) icon (AddNode _ _) = glyphiconNodeAction (Add [])
...@@ -65,9 +75,9 @@ icon (DoSearch _) = glyphiconNodeAction SearchBox ...@@ -65,9 +75,9 @@ icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh icon RefreshTree = glyphiconNodeAction Refresh
icon DownloadNode = glyphiconNodeAction Download icon DownloadNode = glyphiconNodeAction Download
icon (MoveNode _ _) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }}) icon (MoveNode _ ) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (MergeNode _ _) = glyphiconNodeAction (Merge { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }}) icon (MergeNode _ ) = glyphiconNodeAction (Merge { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (LinkNode _ _) = glyphiconNodeAction (Link { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }}) icon (LinkNode _ ) = glyphiconNodeAction (Link { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon NoAction = "hand-o-right" icon NoAction = "hand-o-right"
...@@ -83,8 +93,8 @@ text (DoSearch _ )= "Launch search !" ...@@ -83,8 +93,8 @@ text (DoSearch _ )= "Launch search !"
text (UploadFile _ _ _ _)= "Upload File !" text (UploadFile _ _ _ _)= "Upload File !"
text RefreshTree = "Refresh Tree !" text RefreshTree = "Refresh Tree !"
text DownloadNode = "Download !" text DownloadNode = "Download !"
text (MoveNode _ _ ) = "Move !" text (MoveNode _ ) = "Move !"
text (MergeNode _ _ ) = "Merge !" text (MergeNode _ ) = "Merge !"
text (LinkNode _ _ ) = "Link !" text (LinkNode _ ) = "Link !"
text NoAction = "No Action" text NoAction = "No Action"
----------------------------------------------------------------------- -----------------------------------------------------------------------
...@@ -6,7 +6,7 @@ import Data.Tuple.Nested ((/\)) ...@@ -6,7 +6,7 @@ import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel) import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (SubTreeParamsIn, subTreeView, SubTreeOut(..)) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_) import Gargantext.Sessions (Session, put_)
...@@ -20,19 +20,21 @@ linkNodeReq session fromId toId = ...@@ -20,19 +20,21 @@ linkNodeReq session fromId toId =
linkNode :: Record SubTreeParamsIn -> R.Hooks R.Element linkNode :: Record SubTreeParamsIn -> R.Hooks R.Element
linkNode p@{dispatch, subTreeParams, id, nodeType, session} = do linkNode p@{dispatch, subTreeParams, id, nodeType, session} = do
subTreeOut@(subTreeOutParams /\ setSubTreeOut) :: R.State (Maybe SubTreeOut)
<- R.useState' Nothing action@(valAction /\ setAction) :: R.State Action <- R.useState' (LinkNode {params:Nothing})
let button = case subTreeOutParams of
Nothing -> H.div {} [] let button = case valAction of
Just sbto -> submitButton (LinkNode inId outId) dispatch LinkNode {params} -> case params of
where Just val -> submitButton (LinkNode {params: Just val}) dispatch
(SubTreeOut { in:inId, out:outId}) = sbto Nothing -> H.div {} []
pure $ panel [ subTreeView { subTreeOut _ -> H.div {} []
pure $ panel [ subTreeView { action
, dispatch , dispatch
, subTreeParams
, id , id
, nodeType , nodeType
, session , session
, subTreeParams
} }
] button ] button
...@@ -5,15 +5,15 @@ import Data.Maybe (Maybe(..)) ...@@ -5,15 +5,15 @@ import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel) import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel, checkbox, checkboxes, divider)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (SubTreeParamsIn, subTreeView, SubTreeOut(..)) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_) import Gargantext.Sessions (Session, put_)
import Gargantext.Types as GT import Gargantext.Types as GT
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Data.Set as Set
mergeNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Array GT.ID) mergeNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Array GT.ID)
mergeNodeReq session fromId toId = mergeNodeReq session fromId toId =
...@@ -21,19 +21,32 @@ mergeNodeReq session fromId toId = ...@@ -21,19 +21,32 @@ mergeNodeReq session fromId toId =
mergeNode :: Record SubTreeParamsIn -> R.Hooks R.Element mergeNode :: Record SubTreeParamsIn -> R.Hooks R.Element
mergeNode p@{dispatch, subTreeParams, id, nodeType, session} = do mergeNode p@{dispatch, subTreeParams, id, nodeType, session} = do
subTreeOut@(subTreeOutParams /\ setSubTreeOut) :: R.State (Maybe SubTreeOut) action@(valAction /\ setAction) :: R.State Action <- R.useState' (MergeNode {params:Nothing})
<- R.useState' Nothing
let button = case subTreeOutParams of merge <- R.useState' false
Nothing -> H.div {} [] options <- R.useState' (Set.singleton GT.MapTerm)
Just sbto -> submitButton (MergeNode inId outId) dispatch
where let button = case valAction of
(SubTreeOut { in:inId, out:outId}) = sbto MergeNode {params} -> case params of
pure $ panel [ subTreeView { subTreeOut Just val -> submitButton (MergeNode {params: Just val}) dispatch
Nothing -> H.div {} []
_ -> H.div {} []
pure $ panel [ subTreeView { action
, dispatch , dispatch
, subTreeParams
, id , id
, nodeType , nodeType
, session , session
, subTreeParams
} }
, H.div { className:"panel panel-primary"}
[ H.text "Merge which list?"
, checkboxes [GT.MapTerm, GT.CandidateTerm, GT.StopTerm] options
]
, H.div { className:"panel panel-primary"}
[ H.text "Title"
, H.div {className: "checkbox"}
[checkbox merge, H.text "Merge data?"]
]
] button ] button
...@@ -4,9 +4,9 @@ module Gargantext.Components.Forest.Tree.Node.Action.Move ...@@ -4,9 +4,9 @@ module Gargantext.Components.Forest.Tree.Node.Action.Move
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Props, Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel) import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (SubTreeParamsIn, subTreeView, SubTreeOut(..)) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_) import Gargantext.Sessions (Session, put_)
...@@ -20,19 +20,20 @@ moveNodeReq session fromId toId = ...@@ -20,19 +20,20 @@ moveNodeReq session fromId toId =
moveNode :: Record SubTreeParamsIn -> R.Hooks R.Element moveNode :: Record SubTreeParamsIn -> R.Hooks R.Element
moveNode p@{dispatch, subTreeParams, id, nodeType, session} = do moveNode p@{dispatch, subTreeParams, id, nodeType, session} = do
subTreeOut@(subTreeOutParams /\ setSubTreeOut) :: R.State (Maybe SubTreeOut) action@(valAction /\ setAction) :: R.State Action <- R.useState' (MoveNode {params: Nothing})
<- R.useState' Nothing
let button = case subTreeOutParams of let button = case valAction of
Nothing -> H.div {} [] MoveNode {params} -> case params of
Just sbto -> submitButton (MoveNode inId outId) dispatch Just val -> submitButton (MoveNode {params: Just val}) dispatch
where Nothing -> H.div {} []
(SubTreeOut { in:inId, out:outId}) = sbto _ -> H.div {} []
pure $ panel [ subTreeView { subTreeOut
pure $ panel [ subTreeView { action
, dispatch , dispatch
, subTreeParams
, id , id
, nodeType , nodeType
, session , session
, subTreeParams
} }
] button ] button
...@@ -26,6 +26,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Link (linkNode) ...@@ -26,6 +26,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Link (linkNode)
import Gargantext.Components.Forest.Tree.Node.Action.Merge (mergeNode) import Gargantext.Components.Forest.Tree.Node.Action.Merge (mergeNode)
import Gargantext.Components.Forest.Tree.Node.Box.Types (NodePopupProps, NodePopupS) import Gargantext.Components.Forest.Tree.Node.Box.Types (NodePopupProps, NodePopupS)
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox) import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
import Gargantext.Components.Forest.Tree.Node.Status (Status(..), hasStatus)
import Gargantext.Components.Forest.Tree.Node.Tools (textInputBox, fragmentPT) import Gargantext.Components.Forest.Tree.Node.Tools (textInputBox, fragmentPT)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (Name, ID) import Gargantext.Types (Name, ID)
...@@ -42,15 +43,6 @@ type CommonProps = ...@@ -42,15 +43,6 @@ type CommonProps =
-- | START Popup View -- | START Popup View
iconAStyle :: { color :: String
, paddingTop :: String
, paddingBottom :: String
}
iconAStyle = { color : "black"
, paddingTop : "6px"
, paddingBottom : "6px"
}
nodePopupView :: Record NodePopupProps -> R.Element nodePopupView :: Record NodePopupProps -> R.Element
nodePopupView p = R.createElement nodePopupCpt p [] nodePopupView p = R.createElement nodePopupCpt p []
...@@ -59,12 +51,17 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt ...@@ -59,12 +51,17 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt
where where
cpt p _ = do cpt p _ = do
isOpen <- R.useState' false isOpen <- R.useState' false
nodePopupState@(nodePopup /\ setNodePopup) <- R.useState' { action : Nothing
, id : p.id nodePopupState@(nodePopup /\ setNodePopup)
, name : p.name <- R.useState' { action : Nothing
, nodeType: p.nodeType , id : p.id
} , name : p.name
search <- R.useState' $ defaultSearch { node_id = Just p.id } , nodeType: p.nodeType
}
search <- R.useState'
$ defaultSearch { node_id = Just p.id }
pure $ H.div tooltipProps $ pure $ H.div tooltipProps $
[ H.div { className: "popup-container" } [ H.div { className: "popup-container" }
[ H.div { className: "panel panel-default" } [ H.div { className: "panel panel-default" }
...@@ -145,11 +142,13 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt ...@@ -145,11 +142,13 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt
, H.div { className: "flex-center"} , H.div { className: "flex-center"}
[ buttonClick { action: doc [ buttonClick { action: doc
, state: nodePopupState , state: nodePopupState
, nodeType
} }
] ]
, H.div {className: "flex-center"} , H.div {className: "flex-center"}
$ map (\t -> buttonClick { action: t $ map (\t -> buttonClick { action: t
, state : nodePopupState , state : nodePopupState
, nodeType
} }
) buttons ) buttons
] ]
...@@ -184,6 +183,7 @@ type ActionState = ...@@ -184,6 +183,7 @@ type ActionState =
type ButtonClickProps = type ButtonClickProps =
( action :: NodeAction ( action :: NodeAction
, state :: R.State (Record ActionState) , state :: R.State (Record ActionState)
, nodeType :: GT.NodeType
) )
buttonClick :: Record ButtonClickProps -> R.Element buttonClick :: Record ButtonClickProps -> R.Element
...@@ -192,16 +192,14 @@ buttonClick p = R.createElement buttonClickCpt p [] ...@@ -192,16 +192,14 @@ buttonClick p = R.createElement buttonClickCpt p []
buttonClickCpt :: R.Component ButtonClickProps buttonClickCpt :: R.Component ButtonClickProps
buttonClickCpt = R.hooksComponent "G.C.F.T.N.B.buttonClick" cpt buttonClickCpt = R.hooksComponent "G.C.F.T.N.B.buttonClick" cpt
where where
cpt {action: todo, state: (node@{action} /\ setNodePopup)} _ = do cpt {action: todo, state: (node@{action} /\ setNodePopup), nodeType} _ = do
pure $ H.div {className: "col-md-1"} pure $ H.div {className: "col-md-1"}
[ H.a { style: iconAStyle [ H.a { style: (iconAStyle nodeType todo)
, className: glyphiconActive (glyphiconNodeAction todo) , className: glyphiconActive (glyphiconNodeAction todo)
(action == (Just todo) ) (action == (Just todo) )
, id: show todo , id: show todo
, title: show todo , title: show todo
, onClick : mkEffectFn1 , onClick : mkEffectFn1 $ \_ -> undo *> doToDo
$ \_ -> setNodePopup
$ const (node { action = action' })
} }
[] []
] ]
...@@ -210,6 +208,27 @@ buttonClickCpt = R.hooksComponent "G.C.F.T.N.B.buttonClick" cpt ...@@ -210,6 +208,27 @@ buttonClickCpt = R.hooksComponent "G.C.F.T.N.B.buttonClick" cpt
then Nothing then Nothing
else (Just todo) else (Just todo)
undo = setNodePopup
$ const (node { action = Nothing })
doToDo = setNodePopup
$ const (node { action = action' })
iconAStyle :: GT.NodeType -> NodeAction -> { color :: String
, paddingTop :: String
, paddingBottom :: String
}
iconAStyle n a = { color : hasColor (hasStatus n a)
, paddingTop : "6px"
, paddingBottom : "6px"
}
where
hasColor :: Status -> String
hasColor Stable = "black"
hasColor Test = "orange"
hasColor Dev = "red"
-- END Popup View -- END Popup View
type NodeProps = type NodeProps =
( id :: ID ( id :: ID
......
...@@ -4,6 +4,7 @@ import Data.Generic.Rep (class Generic) ...@@ -4,6 +4,7 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Gargantext.Prelude (class Eq, class Show, show, (&&), (<>), (==)) import Gargantext.Prelude (class Eq, class Show, show, (&&), (<>), (==))
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..))
import Data.Array (foldl) import Data.Array (foldl)
import Gargantext.Types import Gargantext.Types
...@@ -14,10 +15,6 @@ import Gargantext.Types ...@@ -14,10 +15,6 @@ import Gargantext.Types
if user has access to node then he can do all his related actions if user has access to node then he can do all his related actions
-} -}
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------
-- Beta Status
data Status a = TODO a | WIP a | OnTest a | Beta a
data NodeAction = Documentation NodeType data NodeAction = Documentation NodeType
| SearchBox | SearchBox
| Download | Upload | Refresh | Config | Download | Upload | Refresh | Config
...@@ -30,18 +27,6 @@ data NodeAction = Documentation NodeType ...@@ -30,18 +27,6 @@ data NodeAction = Documentation NodeType
| Clone | Clone
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- TODO move elsewhere
data SubTreeParams = SubTreeParams { showtypes :: Array NodeType
, valitypes :: Array NodeType
}
derive instance eqSubTreeParams :: Eq SubTreeParams
derive instance genericSubTreeParams :: Generic SubTreeParams _
instance showSubTreeParams :: Show SubTreeParams where
show = genericShow
------------------------------------------------------------------------
instance eqNodeAction :: Eq NodeAction where instance eqNodeAction :: Eq NodeAction where
eq (Documentation x) (Documentation y) = true && (x == y) eq (Documentation x) (Documentation y) = true && (x == y)
eq SearchBox SearchBox = true eq SearchBox SearchBox = true
......
module Gargantext.Components.Forest.Tree.Node.Status where
import Gargantext.Types
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..))
------------------------------------------------------------------------
-- Beta Status
data Status = Stable | Test | Dev
hasStatus :: NodeType -> NodeAction -> Status
hasStatus _ SearchBox = Dev
hasStatus _ Refresh = Dev
hasStatus _ Config = Dev
hasStatus _ (Link _) = Dev
hasStatus _ (Merge _) = Dev
hasStatus _ (Move _) = Test
hasStatus _ (Documentation _) = Dev
hasStatus Annuaire Upload = Dev
hasStatus Texts Upload = Dev
hasStatus _ _ = Stable
...@@ -2,14 +2,18 @@ module Gargantext.Components.Forest.Tree.Node.Tools ...@@ -2,14 +2,18 @@ module Gargantext.Components.Forest.Tree.Node.Tools
where where
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Set (Set)
import Data.Set as Set
import Data.String as S import Data.String as S
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Gargantext.Types (Name)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import Gargantext.Components.Forest.Tree.Node.Action import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, ($), (<<<), (<>), read, map, class Read, class Show) import Gargantext.Prelude (Unit, bind, const, discard, pure, show, ($), (<<<), (<>), read, map, class Read, class Show, not, class Ord)
import Gargantext.Types (ID) import Gargantext.Types (ID)
import Gargantext.Utils (toggleSet)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -28,10 +32,9 @@ panel bodies submit = ...@@ -28,10 +32,9 @@ panel bodies submit =
[ H.div { className: "row" [ H.div { className: "row"
, style: {"margin":"10px"} , style: {"margin":"10px"}
} }
[ H.div { className: "col-md-10" } [ H.div { className: "col-md-12" } bs
-- TODO add type for text or form here -- TODO add type for text or form here
[ H.form {className: "form-horizontal"} bs -- [ H.form {className: "form-horizontal"} bs ]
]
] ]
] ]
footer sb = footer sb =
...@@ -201,7 +204,65 @@ submitButtonHref action href = ...@@ -201,7 +204,65 @@ submitButtonHref action href =
} }
[ H.text $ " " <> text action] [ H.text $ " " <> text action]
------------------------------------------------------------------------
-- | CheckBox tools
-- checkboxes: Array of poolean values (basic: without pending option)
-- checkbox : One boolean value only
checkbox :: R.State Boolean -> R.Element
checkbox ( val /\ set ) =
H.input { id: "checkbox-id"
, type: "checkbox"
, value: val
, className : "checkbox"
, on: { click: \_ -> set $ const $ not val}
}
data CheckBoxes = Multiple | Uniq
checkboxes :: forall a
. Ord a
=> Show a
=> Array a
-> R.State (Set a)
-> R.Element
checkboxes xs (val /\ set) =
H.fieldset {} $ map (\a -> H.div {} [ H.input { type: "checkbox"
, checked: Set.member a val
, on: { click: \_ -> set
$ const
$ toggleSet a val
}
}
, H.div {} [H.text $ show a]
]
) xs
-- START node text
type NodeTextProps =
( isSelected :: Boolean
, name :: Name
)
nodeText :: Record NodeTextProps -> R.Element
nodeText p = R.createElement nodeTextCpt p []
nodeTextCpt :: R.Component NodeTextProps
nodeTextCpt = R.hooksComponent "G.C.F.T.N.B.nodeText" cpt
where
cpt { isSelected: true, name } _ = do
pure $ H.u {} [
H.b {} [
H.text ("| " <> name <> " | ")
]
]
cpt {isSelected: false, name} _ = do
pure $ H.text (name <> " ")
-- END node text
------------------------------------------------------------------------
divider :: R.Element
divider = H.div {className:"divider"} []
module Gargantext.Components.Forest.Tree.Node.Tools.SubTree where module Gargantext.Components.Forest.Tree.Node.Tools.SubTree where
import DOM.Simple.Console (log2)
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Props, Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Props, Action, subTreeOut, setTreeOut)
import Gargantext.Components.Forest.Tree.Node.Settings (SubTreeParams(..)) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..), SubTreeOut(..))
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..)) import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Components.Forest.Tree.Node.Tools (nodeText)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (discard, map, pure, show, unit, ($), (&&), (/=), (<>), class Eq, const) import Gargantext.Prelude (map, pure, show, ($), (&&), (/=), (<>), const, (==){-, discard, bind, void-})
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), get) import Gargantext.Sessions (Session(..), get)
import Gargantext.Types as GT import Gargantext.Types as GT
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
type SubTreeParamsIn = type SubTreeParamsIn =
( subTreeParams :: SubTreeParams ( subTreeParams :: SubTreeParams
| Props | Props
) )
------------------------------------------------------------------------
data SubTreeOut = SubTreeOut { in :: GT.ID
, out :: GT.ID
}
------------------------------------------------------------------------ ------------------------------------------------------------------------
type SubTreeParamsProps = type SubTreeParamsProps =
( subTreeOut :: R.State (Maybe SubTreeOut) ( action :: R.State Action
| SubTreeParamsIn | SubTreeParamsIn
) )
...@@ -46,10 +39,13 @@ subTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeView" cpt ...@@ -46,10 +39,13 @@ subTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeView" cpt
, nodeType , nodeType
, session , session
, subTreeParams , subTreeParams
, subTreeOut , action
} _ = } _ =
do do
let SubTreeParams {showtypes} = subTreeParams let
SubTreeParams {showtypes} = subTreeParams
-- (valAction /\ setAction) = action
-- _ <- pure $ setAction (const $ setTreeOut valAction Nothing)
useLoader session (loadSubTree showtypes) $ useLoader session (loadSubTree showtypes) $
\tree -> \tree ->
...@@ -59,7 +55,7 @@ subTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeView" cpt ...@@ -59,7 +55,7 @@ subTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeView" cpt
, session , session
, tree , tree
, subTreeParams , subTreeParams
, subTreeOut , action
} }
loadSubTree :: Array GT.NodeType -> Session -> Aff FTree loadSubTree :: Array GT.NodeType -> Session -> Aff FTree
...@@ -85,9 +81,11 @@ subTreeViewLoadedCpt :: R.Component CorpusTreeProps ...@@ -85,9 +81,11 @@ subTreeViewLoadedCpt :: R.Component CorpusTreeProps
subTreeViewLoadedCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeViewLoadedCpt" cpt subTreeViewLoadedCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeViewLoadedCpt" cpt
where where
cpt p@{dispatch, id, nodeType, session, tree} _ = do cpt p@{dispatch, id, nodeType, session, tree} _ = do
pure $ H.div { className: "copy-from-corpus" } pure $ H.div {className:"panel panel-primary"}
[ H.div { className: "tree" } [H.div { className: "copy-from-corpus" }
[subTreeTreeView p] [ H.div { className: "tree" }
[subTreeTreeView p]
]
] ]
subTreeTreeView :: Record CorpusTreeProps -> R.Element subTreeTreeView :: Record CorpusTreeProps -> R.Element
...@@ -97,37 +95,48 @@ subTreeTreeViewCpt :: R.Component CorpusTreeProps ...@@ -97,37 +95,48 @@ subTreeTreeViewCpt :: R.Component CorpusTreeProps
subTreeTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeTreeViewCpt" cpt subTreeTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeTreeViewCpt" cpt
where where
cpt p@{ id cpt p@{ id
, tree: NTree (LNode { id: sourceId , tree: NTree (LNode { id: targetId
, name , name
, nodeType , nodeType
} }
) ary ) ary
, subTreeParams , subTreeParams
, dispatch , dispatch
, subTreeOut , action
} _ = do } _ = do
pure $ {- H.div {} [ H.h5 { className: GT.fldr nodeType true} [] pure $ H.div {} [ H.div { className: "node " <> GT.fldr nodeType true}
, -} H.div { className: "node" } ( [ H.span { className: "name " <> clickable
( [ H.span { className: "name " <> clickable , on: { click: onClick }
, on: { click: onClick } } [ nodeText { isSelected: isSelected targetId valAction
} [ H.text name ] , name: " " <> name
}
] <> children ]
)
-- ] ] <> children
)
]
where where
SubTreeParams { valitypes } = subTreeParams SubTreeParams { valitypes } = subTreeParams
sortedAry = A.sortWith (\(NTree (LNode {id:id'}) _) -> id') ary
children = map (\c -> subTreeTreeView (p { tree = c })) ary children = map (\ctree -> subTreeTreeView (p { tree = ctree })) sortedAry
validNodeType = (A.elem nodeType valitypes) && (id /= sourceId) validNodeType = (A.elem nodeType valitypes) && (id /= targetId)
clickable = if validNodeType then "clickable" else ""
( valAction /\ setAction) = action
isSelected n action' = case (subTreeOut action') of
Nothing -> false
(Just (SubTreeOut {out})) -> n == out
clickable = if validNodeType then "clickable" else ""
sbto@( subTreeOutParams /\ setSubTreeOut) = subTreeOut
onClick _ = mkEffectFn1 $ \_ -> case validNodeType of onClick _ = mkEffectFn1 $ \_ -> case validNodeType of
false -> setSubTreeOut (const Nothing) false -> setAction (const $ setTreeOut valAction Nothing)
true -> setSubTreeOut (const $ Just $ SubTreeOut { in: id, out:sourceId}) true -> setAction (const $ setTreeOut valAction (Just $ SubTreeOut { in: id, out:targetId}))
-------------------------------------------------------------------------------------------- --------------------------------------------------------------------------------------------
module Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types where
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Gargantext.Prelude (class Eq, class Show)
import Gargantext.Types as GT
import Reactix as R
data SubTreeOut = SubTreeOut { in :: GT.ID
, out :: GT.ID
}
------------------------------------------------------------------------
data SubTreeParams = SubTreeParams { showtypes :: Array GT.NodeType
, valitypes :: Array GT.NodeType
}
derive instance eqSubTreeParams :: Eq SubTreeParams
derive instance genericSubTreeParams :: Generic SubTreeParams _
instance showSubTreeParams :: Show SubTreeParams where
show = genericShow
------------------------------------------------------------------------
...@@ -187,7 +187,7 @@ deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches ...@@ -187,7 +187,7 @@ deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches
np :: NTC.NgramsPatches np :: NTC.NgramsPatches
np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list } np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list }
patch_list :: NTC.Replace TermList patch_list :: NTC.Replace TermList
patch_list = NTC.Replace { new: termList, old: GraphTerm } patch_list = NTC.Replace { new: termList, old: MapTerm }
query :: Frontends -> GET.MetaData -> Session -> SigmaxT.NodesMap -> R.State SigmaxT.NodeIds -> R.Element query :: Frontends -> GET.MetaData -> Session -> SigmaxT.NodesMap -> R.State SigmaxT.NodeIds -> R.Element
......
...@@ -19,6 +19,7 @@ import Reactix as R ...@@ -19,6 +19,7 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
------------------------------------------------------------------------ ------------------------------------------------------------------------
import Gargantext.Components.Forest.Tree.Node.Tools (checkbox)
import Gargantext.Components.Forms (clearfix, cardBlock, cardGroup, center, formGroup) import Gargantext.Components.Forms (clearfix, cardBlock, cardGroup, center, formGroup)
import Gargantext.Components.Login.Types (AuthRequest(..)) import Gargantext.Components.Login.Types (AuthRequest(..))
import Gargantext.Ends (Backend(..)) import Gargantext.Ends (Backend(..))
...@@ -178,7 +179,7 @@ formCpt = R.hooksComponent "G.C.Login.form" cpt where ...@@ -178,7 +179,7 @@ formCpt = R.hooksComponent "G.C.Login.form" cpt where
, center , center
[ H.label {} [ H.label {}
[ H.div {className: "checkbox"} [ H.div {className: "checkbox"}
[ termsCheckbox setBox [ checkbox setBox
, H.text "I hereby accept " , H.text "I hereby accept "
, H.a { target: "_blank" , H.a { target: "_blank"
, href: "http://gitlab.iscpif.fr/humanities/tofu/tree/master" , href: "http://gitlab.iscpif.fr/humanities/tofu/tree/master"
...@@ -213,15 +214,6 @@ csrfTokenInput _ = ...@@ -213,15 +214,6 @@ csrfTokenInput _ =
, value: csrfMiddlewareToken , value: csrfMiddlewareToken
} -- TODO hard-coded CSRF token } -- TODO hard-coded CSRF token
termsCheckbox :: R.State Boolean -> R.Element
termsCheckbox setCheckBox =
H.input { id: "terms-accept"
, type: "checkbox"
, value: fst setCheckBox
, className: "checkbox"
, on: { click: \_ -> (snd setCheckBox) $ const $ not (fst setCheckBox)}
}
termsLink :: {} -> R.Element termsLink :: {} -> R.Element
termsLink _ = termsLink _ =
H.a { target: "_blank", href: termsUrl } [ H.text "the terms of use" ] H.a { target: "_blank", href: termsUrl } [ H.text "the terms of use" ]
......
...@@ -257,7 +257,7 @@ tableContainerCpt { dispatch ...@@ -257,7 +257,7 @@ tableContainerCpt { dispatch
selectButtons true = selectButtons true =
H.div {} [ H.div {} [
H.button { className: "btn btn-primary" H.button { className: "btn btn-primary"
, on: { click: const $ setSelection GraphTerm } , on: { click: const $ setSelection MapTerm }
} [ H.text "Map" ] } [ H.text "Map" ]
, H.button { className: "btn btn-primary" , H.button { className: "btn btn-primary"
, on: { click: const $ setSelection StopTerm } , on: { click: const $ setSelection StopTerm }
......
...@@ -183,7 +183,7 @@ renderNgramsItemCpt = R.hooksComponent "G.C.NT.renderNgramsItem" cpt ...@@ -183,7 +183,7 @@ renderNgramsItemCpt = R.hooksComponent "G.C.NT.renderNgramsItem" cpt
, ngramsTable } _ = , ngramsTable } _ =
pure $ Tbl.makeRow [ pure $ Tbl.makeRow [
selected selected
, checkbox T.GraphTerm , checkbox T.MapTerm
, checkbox T.StopTerm , checkbox T.StopTerm
, if ngramsParent == Nothing , if ngramsParent == Nothing
then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit } then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }
...@@ -232,7 +232,7 @@ renderNgramsItemCpt = R.hooksComponent "G.C.NT.renderNgramsItem" cpt ...@@ -232,7 +232,7 @@ renderNgramsItemCpt = R.hooksComponent "G.C.NT.renderNgramsItem" cpt
termStyle :: T.TermList -> Number -> DOM.Props termStyle :: T.TermList -> Number -> DOM.Props
termStyle T.GraphTerm opacity = DOM.style { color: "green", opacity } termStyle T.MapTerm opacity = DOM.style { color: "green", opacity }
termStyle T.StopTerm opacity = DOM.style { color: "red", opacity termStyle T.StopTerm opacity = DOM.style { color: "red", opacity
, textDecoration: "line-through" } , textDecoration: "line-through" }
termStyle T.CandidateTerm opacity = DOM.style { color: "black", opacity } termStyle T.CandidateTerm opacity = DOM.style { color: "black", opacity }
...@@ -250,6 +250,6 @@ tablePatchHasNgrams ngramsTablePatch ngrams = ...@@ -250,6 +250,6 @@ tablePatchHasNgrams ngramsTablePatch ngrams =
nextTermList :: T.TermList -> T.TermList nextTermList :: T.TermList -> T.TermList
nextTermList T.GraphTerm = T.StopTerm nextTermList T.MapTerm = T.StopTerm
nextTermList T.StopTerm = T.CandidateTerm nextTermList T.StopTerm = T.CandidateTerm
nextTermList T.CandidateTerm = T.GraphTerm nextTermList T.CandidateTerm = T.MapTerm
...@@ -133,7 +133,7 @@ initialPageParams session nodeId listIds tabType = ...@@ -133,7 +133,7 @@ initialPageParams session nodeId listIds tabType =
, params , params
, tabType , tabType
, termSizeFilter: Nothing , termSizeFilter: Nothing
, termListFilter: Just GraphTerm , termListFilter: Just MapTerm
, searchQuery: "" , searchQuery: ""
, scoreType: Occurrences , scoreType: Occurrences
, session , session
......
...@@ -9,7 +9,7 @@ import Reactix as R ...@@ -9,7 +9,7 @@ import Reactix as R
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Types import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCache) import Gargantext.Hooks.Loader (HashedResponse, useLoader, useLoaderWithCache)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
type MetricsLoadViewProps a = ( type MetricsLoadViewProps a = (
...@@ -24,23 +24,27 @@ metricsLoadView p = R.createElement metricsLoadViewCpt p [] ...@@ -24,23 +24,27 @@ metricsLoadView p = R.createElement metricsLoadViewCpt p []
metricsLoadViewCpt :: forall a. R.Component (MetricsLoadViewProps a) metricsLoadViewCpt :: forall a. R.Component (MetricsLoadViewProps a)
metricsLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsLoadView" cpt metricsLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsLoadView" cpt
where where
cpt {getMetrics, loaded, path, reload, session} _ = do cpt { getMetrics, loaded, path, reload, session } _ = do
useLoader (fst reload /\ path) (getMetrics session) $ \l -> useLoader (fst reload /\ path) (getMetrics session) $ \l ->
loaded session path reload l loaded session path reload l
type MetricsWithCacheLoadViewProps a = ( type MetricsWithCacheLoadViewProps a = (
--keyFunc :: Record Path -> String keyFunc :: Tuple Reload (Record Path) -> String
| MetricsLoadViewProps a , getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse a)
, getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String
, loaded :: Session -> Record Path -> R.State Reload -> a -> R.Element
| MetricsProps
) )
metricsWithCacheLoadView :: forall a. DecodeJson a => EncodeJson a => metricsWithCacheLoadView :: forall a. DecodeJson a => EncodeJson a =>
Record (MetricsLoadViewProps a) -> R.Element Record (MetricsWithCacheLoadViewProps a) -> R.Element
metricsWithCacheLoadView p = R.createElement metricsWithCacheLoadViewCpt p [] metricsWithCacheLoadView p = R.createElement metricsWithCacheLoadViewCpt p []
metricsWithCacheLoadViewCpt :: forall a. DecodeJson a => EncodeJson a => R.Component (MetricsLoadViewProps a) metricsWithCacheLoadViewCpt :: forall a. DecodeJson a => EncodeJson a => R.Component (MetricsWithCacheLoadViewProps a)
metricsWithCacheLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsWithCacheLoadView" cpt metricsWithCacheLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsWithCacheLoadView" cpt
where where
cpt {getMetrics, loaded, path, reload, session} _ = do cpt { getMetrics, getMetricsMD5, keyFunc, loaded, path, reload, session } _ = do
useLoaderWithCache (fst reload /\ path) keyFunc (getMetrics session) $ \l -> useLoaderWithCache (fst reload /\ path) (metricsKeyFunc keyFunc) (getMetricsMD5 session) (getMetrics session) $ \l ->
loaded session path reload l loaded session path reload l
keyFunc (_ /\ { corpusId, listId, tabType }) = "metrics-" <> (show tabType) <> "-" <> (show corpusId) <> "-" <> (show listId) metricsKeyFunc keyFunc st@(_ /\ { corpusId, listId, tabType }) =
"metrics-" <> (show tabType) <> "-" <> (show corpusId) <> "-" <> (show listId) <> "--" <> (keyFunc st)
...@@ -19,16 +19,19 @@ import Gargantext.Components.Charts.Options.Data (dataSerie) ...@@ -19,16 +19,19 @@ import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType(..)) import Gargantext.Types (ChartType(..), TabType(..))
newtype ChartMetrics = ChartMetrics { "data" :: HistoMetrics } newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics
}
instance decodeChartMetrics :: DecodeJson ChartMetrics where instance decodeChartMetrics :: DecodeJson ChartMetrics where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
d <- obj .: "data" d <- obj .: "data"
pure $ ChartMetrics { "data": d } pure $ ChartMetrics { "data": d }
newtype HistoMetrics = HistoMetrics { dates :: Array String, count :: Array Number } newtype HistoMetrics = HistoMetrics { dates :: Array String, count :: Array Number }
...@@ -39,7 +42,6 @@ instance decodeHistoMetrics :: DecodeJson HistoMetrics where ...@@ -39,7 +42,6 @@ instance decodeHistoMetrics :: DecodeJson HistoMetrics where
d <- obj .: "dates" d <- obj .: "dates"
c <- obj .: "count" c <- obj .: "count"
pure $ HistoMetrics { dates : d , count: c} pure $ HistoMetrics { dates : d , count: c}
instance encodeHistoMetrics :: EncodeJson HistoMetrics where instance encodeHistoMetrics :: EncodeJson HistoMetrics where
encodeJson (HistoMetrics { dates, count }) = encodeJson (HistoMetrics { dates, count }) =
"count" := encodeJson count "count" := encodeJson count
...@@ -59,13 +61,17 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -59,13 +61,17 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options
, series : [seriesBarD1 {name: "Number of publication / year"} $ , series : [seriesBarD1 {name: "Number of publication / year"} $
map (\n -> dataSerie {value: n, itemStyle : itemStyle {color:grey}}) count'] } map (\n -> dataSerie {value: n, itemStyle : itemStyle {color:grey}}) count'] }
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff HistoMetrics getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse HistoMetrics)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
ChartMetrics ms <- get session chart HashedResponse { md5, value: ChartMetrics ms } <- get session chart
pure ms."data" pure $ HashedResponse { md5, value: ms."data" }
where where
chart = Chart {chartType: Histo, listId, tabType, limit} (Just corpusId) chart = Chart {chartType: Histo, listId, tabType, limit} (Just corpusId)
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartMD5 { chartType: Histo, listId, tabType } (Just corpusId)
histo :: Record Props -> R.Element histo :: Record Props -> R.Element
histo props = R.createElement histoCpt props [] histo props = R.createElement histoCpt props []
...@@ -75,7 +81,7 @@ histoCpt = R.hooksComponent "G.C.N.C.C.H.histo" cpt ...@@ -75,7 +81,7 @@ histoCpt = R.hooksComponent "G.C.N.C.C.H.histo" cpt
cpt {path, session} _ = do cpt {path, session} _ = do
reload <- R.useState' 0 reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded, path, reload, session} --pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView {getMetrics, loaded, path, reload, session} pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "histo", loaded, path, reload, session }
loaded :: Session -> Record Path -> R.State Reload -> HistoMetrics -> R.Element loaded :: Session -> Record Path -> R.State Reload -> HistoMetrics -> R.Element
loaded session path reload loaded = loaded session path reload loaded =
......
module Gargantext.Components.Nodes.Corpus.Chart.Metrics where module Gargantext.Components.Nodes.Corpus.Chart.Metrics where
import Prelude (bind, negate, pure, ($), (<$>), (<>))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject) import Data.Argonaut.Core (jsonEmptyObject)
import Data.Map as Map import Data.Map as Map
...@@ -8,10 +7,12 @@ import Data.Map (Map) ...@@ -8,10 +7,12 @@ import Data.Map (Map)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff, launchAff_)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, yAxis')
import Gargantext.Components.Charts.Options.Type (xAxis) import Gargantext.Components.Charts.Options.Type (xAxis)
import Gargantext.Components.Charts.Options.Series (Series, seriesScatterD2) import Gargantext.Components.Charts.Options.Series (Series, seriesScatterD2)
...@@ -21,6 +22,7 @@ import Gargantext.Components.Charts.Options.Data (dataSerie) ...@@ -21,6 +22,7 @@ import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType, TermList(..)) import Gargantext.Types (ChartType(..), TabType, TermList(..))
...@@ -49,8 +51,8 @@ instance encodeMetric :: EncodeJson Metric where ...@@ -49,8 +51,8 @@ instance encodeMetric :: EncodeJson Metric where
~> "cat" := encodeJson cat ~> "cat" := encodeJson cat
~> jsonEmptyObject ~> jsonEmptyObject
newtype Metrics = Metrics newtype Metrics = Metrics {
{ "data" :: Array Metric "data" :: Array Metric
} }
instance decodeMetrics :: DecodeJson Metrics where instance decodeMetrics :: DecodeJson Metrics where
...@@ -86,7 +88,7 @@ scatterOptions metrics' = Options ...@@ -86,7 +88,7 @@ scatterOptions metrics' = Options
color = color =
case k of case k of
StopTerm -> red StopTerm -> red
GraphTerm -> green MapTerm -> green
CandidateTerm -> grey CandidateTerm -> grey
toSerie color' (Metric {label,x,y}) = toSerie color' (Metric {label,x,y}) =
dataSerie { name: label, itemStyle: itemStyle {color: color'} dataSerie { name: label, itemStyle: itemStyle {color: color'}
...@@ -95,13 +97,17 @@ scatterOptions metrics' = Options ...@@ -95,13 +97,17 @@ scatterOptions metrics' = Options
} }
--} --}
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff Loaded getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse Loaded)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
Metrics ms <- get session metrics' HashedResponse { md5, value: Metrics ms } <- get session metrics'
pure ms."data" pure $ HashedResponse { md5, value: ms."data" }
where where
metrics' = CorpusMetrics {limit, listId, tabType} (Just corpusId) metrics' = CorpusMetrics {limit, listId, tabType} (Just corpusId)
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, listId, tabType }) =
get session $ CorpusMetricsMD5 { listId, tabType } (Just corpusId)
metrics :: Record Props -> R.Element metrics :: Record Props -> R.Element
metrics props = R.createElement metricsCpt props [] metrics props = R.createElement metricsCpt props []
...@@ -111,7 +117,8 @@ metricsCpt = R.hooksComponent "G.C.N.C.C.M.metrics" cpt ...@@ -111,7 +117,8 @@ metricsCpt = R.hooksComponent "G.C.N.C.C.M.metrics" cpt
cpt {path, session} _ = do cpt {path, session} _ = do
reload <- R.useState' 0 reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded, path, reload, session} --pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "metrics", loaded, path, reload, session }
loaded :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element loaded :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element
......
module Gargantext.Components.Nodes.Corpus.Chart.Pie where module Gargantext.Components.Nodes.Corpus.Chart.Pie where
import Prelude (bind, map, pure, ($), (>))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject) import Data.Argonaut.Core (jsonEmptyObject)
import Data.Array (zip, filter) import Data.Array (zip, filter)
...@@ -13,6 +12,8 @@ import Effect.Aff (Aff) ...@@ -13,6 +12,8 @@ import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Series (seriesBarD1, seriesPieD1) import Gargantext.Components.Charts.Options.Series (seriesBarD1, seriesPieD1)
import Gargantext.Components.Charts.Options.Color (blue) import Gargantext.Components.Charts.Options.Color (blue)
...@@ -21,12 +22,13 @@ import Gargantext.Components.Charts.Options.Data (dataSerie) ...@@ -21,12 +22,13 @@ import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType) import Gargantext.Types (ChartType(..), TabType)
newtype ChartMetrics = ChartMetrics newtype ChartMetrics = ChartMetrics {
{ "data" :: HistoMetrics "data" :: HistoMetrics
} }
instance decodeChartMetrics :: DecodeJson ChartMetrics where instance decodeChartMetrics :: DecodeJson ChartMetrics where
...@@ -58,7 +60,7 @@ type Loaded = HistoMetrics ...@@ -58,7 +60,7 @@ type Loaded = HistoMetrics
chartOptionsBar :: HistoMetrics -> Options chartOptionsBar :: HistoMetrics -> Options
chartOptionsBar (HistoMetrics { dates: dates', count: count'}) = Options chartOptionsBar (HistoMetrics { dates: dates', count: count'}) = Options
{ mainTitle : "Bar" { mainTitle : "Bar"
, subTitle : "Count of GraphTerm" , subTitle : "Count of MapTerm"
, xAxis : xAxis' $ map (\t -> joinWith " " $ map (take 3) $ A.take 3 $ filter (\s -> length s > 3) $ split (Pattern " ") t) dates' , xAxis : xAxis' $ map (\t -> joinWith " " $ map (take 3) $ A.take 3 $ filter (\s -> length s > 3) $ split (Pattern " ") t) dates'
, yAxis : yAxis' { position: "left", show: true, min:0} , yAxis : yAxis' { position: "left", show: true, min:0}
, series : [seriesBarD1 {name: "Number of publication / year"} $ map (\n -> dataSerie {name: "", itemStyle: itemStyle {color:blue}, value: n }) count'] , series : [seriesBarD1 {name: "Number of publication / year"} $ map (\n -> dataSerie {name: "", itemStyle: itemStyle {color:blue}, value: n }) count']
...@@ -69,7 +71,7 @@ chartOptionsBar (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -69,7 +71,7 @@ chartOptionsBar (HistoMetrics { dates: dates', count: count'}) = Options
chartOptionsPie :: HistoMetrics -> Options chartOptionsPie :: HistoMetrics -> Options
chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
{ mainTitle : "Pie" { mainTitle : "Pie"
, subTitle : "Distribution by GraphTerm" , subTitle : "Distribution by MapTerm"
, xAxis : xAxis' [] , xAxis : xAxis' []
, yAxis : yAxis' { position: "", show: false, min:0} , yAxis : yAxis' { position: "", show: false, min:0}
, series : [seriesPieD1 {name: "Data"} $ map (\(Tuple n v) -> dataSerie {name: n, value:v}) $ zip dates' count'] , series : [seriesPieD1 {name: "Data"} $ map (\(Tuple n v) -> dataSerie {name: n, value:v}) $ zip dates' count']
...@@ -79,12 +81,16 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -79,12 +81,16 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
} }
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff HistoMetrics getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse HistoMetrics)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
ChartMetrics ms <- get session chart HashedResponse { md5, value: ChartMetrics ms } <- get session chart
pure ms."data" pure $ HashedResponse { md5, value: ms."data" }
where chart = Chart {chartType: ChartPie, limit, listId, tabType} (Just corpusId) where chart = Chart {chartType: ChartPie, limit, listId, tabType} (Just corpusId)
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartMD5 { chartType: ChartPie, listId, tabType } (Just corpusId)
pie :: Record Props -> R.Element pie :: Record Props -> R.Element
pie props = R.createElement pieCpt props [] pie props = R.createElement pieCpt props []
...@@ -94,7 +100,7 @@ pieCpt = R.hooksComponent "G.C.N.C.C.P.pie" cpt ...@@ -94,7 +100,7 @@ pieCpt = R.hooksComponent "G.C.N.C.C.P.pie" cpt
cpt {path,session} _ = do cpt {path,session} _ = do
reload <- R.useState' 0 reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded: loadedPie, path, reload, session} --pure $ metricsLoadView {getMetrics, loaded: loadedPie, path, reload, session}
pure $ metricsWithCacheLoadView {getMetrics, loaded: loadedPie, path, reload, session} pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "pie", loaded: loadedPie, path, reload, session }
loadedPie :: Session -> Record Path -> R.State Reload -> HistoMetrics -> R.Element loadedPie :: Session -> Record Path -> R.State Reload -> HistoMetrics -> R.Element
loadedPie session path reload loaded = loadedPie session path reload loaded =
...@@ -114,7 +120,7 @@ barCpt = R.hooksComponent "LoadedMetricsBar" cpt ...@@ -114,7 +120,7 @@ barCpt = R.hooksComponent "LoadedMetricsBar" cpt
cpt {path, session} _ = do cpt {path, session} _ = do
reload <- R.useState' 0 reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded: loadedBar, path, reload, session} --pure $ metricsLoadView {getMetrics, loaded: loadedBar, path, reload, session}
pure $ metricsWithCacheLoadView {getMetrics, loaded: loadedBar, path, reload, session} pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "bar", loaded: loadedBar, path, reload, session }
loadedBar :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element loadedBar :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element
loadedBar session path reload loaded = loadedBar session path reload loaded =
......
...@@ -12,10 +12,8 @@ import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo) ...@@ -12,10 +12,8 @@ import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics) import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie) import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree) import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Prelude
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (NodeID, Mode(..), TabSubType(..), TabType(..), modeTabType) import Gargantext.Types (NodeID, Mode(..), TabSubType(..), TabType(..), modeTabType)
import Reactix as R
data PredefinedChart = data PredefinedChart =
......
...@@ -17,12 +17,13 @@ import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter) ...@@ -17,12 +17,13 @@ import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType) import Gargantext.Types (ChartType(..), TabType)
newtype Metrics = Metrics newtype Metrics = Metrics {
{ "data" :: Array TreeNode "data" :: Array TreeNode
} }
instance decodeMetrics :: DecodeJson Metrics where instance decodeMetrics :: DecodeJson Metrics where
...@@ -30,7 +31,6 @@ instance decodeMetrics :: DecodeJson Metrics where ...@@ -30,7 +31,6 @@ instance decodeMetrics :: DecodeJson Metrics where
obj <- decodeJson json obj <- decodeJson json
d <- obj .: "data" d <- obj .: "data"
pure $ Metrics { "data": d } pure $ Metrics { "data": d }
instance encodeMetrics :: EncodeJson Metrics where instance encodeMetrics :: EncodeJson Metrics where
encodeJson (Metrics { "data": d }) = encodeJson (Metrics { "data": d }) =
"data" := encodeJson d "data" := encodeJson d
...@@ -52,13 +52,17 @@ scatterOptions nodes = Options ...@@ -52,13 +52,17 @@ scatterOptions nodes = Options
} }
getMetrics :: Session -> Tuple Reload (Record Path) -> Aff Loaded getMetrics :: Session -> Tuple Reload (Record Path) -> Aff (HashedResponse Loaded)
getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do getMetrics session (_ /\ { corpusId, limit, listId, tabType }) = do
Metrics ms <- get session chart HashedResponse { md5, value: Metrics ms } <- get session chart
pure ms."data" pure $ HashedResponse { md5, value: ms."data" }
where where
chart = Chart {chartType : ChartTree, limit, listId, tabType} (Just corpusId) chart = Chart {chartType : ChartTree, limit, listId, tabType} (Just corpusId)
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartMD5 { chartType: ChartTree, listId, tabType } (Just corpusId)
tree :: Record Props -> R.Element tree :: Record Props -> R.Element
tree props = R.createElement treeCpt props [] tree props = R.createElement treeCpt props []
...@@ -68,7 +72,7 @@ treeCpt = R.hooksComponent "G.C.N.C.C.T.tree" cpt ...@@ -68,7 +72,7 @@ treeCpt = R.hooksComponent "G.C.N.C.C.T.tree" cpt
cpt {path, session} _ = do cpt {path, session} _ = do
reload <- R.useState' 0 reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded, path, reload, session} --pure $ metricsLoadView {getMetrics, loaded, path, reload, session}
pure $ metricsWithCacheLoadView {getMetrics, loaded, path, reload, session} pure $ metricsWithCacheLoadView { getMetrics, getMetricsMD5, keyFunc: const "tree", loaded, path, reload, session }
loaded :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element loaded :: Session -> Record Path -> R.State Reload -> Loaded -> R.Element
loaded session path reload loaded = loaded session path reload loaded =
......
...@@ -120,7 +120,7 @@ sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ fromMaybe ...@@ -120,7 +120,7 @@ sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ fromMaybe
sessionPath (R.RecomputeNgrams nt nId lId) = "node/" <> (show nId) <> "/ngrams/recompute?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeNgrams nt nId lId) = "node/" <> (show nId) <> "/ngrams/recompute?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartBar nt nId lId) = "node/" <> (show nId) <> "/pie?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeListChart ChartBar nt nId lId) = "node/" <> (show nId) <> "/pie?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartPie nt nId lId) = "node/" <> (show nId) <> "/pie?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeListChart ChartPie nt nId lId) = "node/" <> (show nId) <> "/pie?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartTree nt nId lId) = "node/" <> (show nId) <> "/tree?list=" <> (show lId) <> "&ngramsType=" <> (show nt) <> "&listType=GraphTerm" sessionPath (R.RecomputeListChart ChartTree nt nId lId) = "node/" <> (show nId) <> "/tree?list=" <> (show lId) <> "&ngramsType=" <> (show nt) <> "&listType=MapTerm"
sessionPath (R.RecomputeListChart Histo nt nId lId) = "node/" <> (show nId) <> "/chart?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeListChart Histo nt nId lId) = "node/" <> (show nId) <> "/chart?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart Scatter nt nId lId) = "node/" <> (show nId) <> "/metrics?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeListChart Scatter nt nId lId) = "node/" <> (show nId) <> "/metrics?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart _ nt nId lId) = "node/" <> (show nId) <> "/recompute-chart?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeListChart _ nt nId lId) = "node/" <> (show nId) <> "/recompute-chart?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
...@@ -185,18 +185,29 @@ sessionPath (R.CorpusMetrics { listId, limit, tabType} i) = ...@@ -185,18 +185,29 @@ sessionPath (R.CorpusMetrics { listId, limit, tabType} i) =
<> "?ngrams=" <> show listId <> "?ngrams=" <> show listId
<> "&ngramsType=" <> showTabType' tabType <> "&ngramsType=" <> showTabType' tabType
<> maybe "" limitUrl limit <> maybe "" limitUrl limit
sessionPath (R.CorpusMetricsMD5 { listId, tabType} i) =
sessionPath $ R.NodeAPI Corpus i
$ "metrics/md5"
<> "?ngrams=" <> show listId
<> "&ngramsType=" <> showTabType' tabType
-- TODO fix this url path -- TODO fix this url path
sessionPath (R.Chart {chartType, listId, limit, tabType} i) = sessionPath (R.Chart {chartType, listId, limit, tabType} i) =
sessionPath $ R.NodeAPI Corpus i sessionPath $ R.NodeAPI Corpus i
$ show chartType $ show chartType
<> "?ngramsType=" <> showTabType' tabType <> "?ngramsType=" <> showTabType' tabType
<> "&listType=GraphTerm" -- <> show listId <> "&listType=MapTerm" -- <> show listId
<> "&listId=" <> show listId <> "&listId=" <> show listId
where where
limitPath = case limit of limitPath = case limit of
Just li -> "&limit=" <> show li Just li -> "&limit=" <> show li
Nothing -> "" Nothing -> ""
-- <> maybe "" limitUrl limit -- <> maybe "" limitUrl limit
sessionPath (R.ChartMD5 { chartType, listId, tabType } i) =
sessionPath $ R.NodeAPI Corpus i
$ show chartType
<> "/md5?ngramsType=" <> showTabType' tabType
<> "&listType=GraphTerm" -- <> show listId
<> "&listId=" <> show listId
-- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i -- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i
------- misc routing stuff ------- misc routing stuff
......
module Gargantext.Hooks.Loader where module Gargantext.Hooks.Loader where
import Gargantext.Prelude import Gargantext.Prelude
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Argonaut.Core (stringify) import Data.Argonaut.Core (stringify)
import Data.Argonaut.Parser (jsonParser) import Data.Argonaut.Parser (jsonParser)
import Data.Either (Either(..)) import Data.Either (Either(..))
...@@ -9,7 +9,7 @@ import Data.Maybe (Maybe(..), isJust, maybe) ...@@ -9,7 +9,7 @@ import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Tuple (fst) import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import Effect.Aff (Aff) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Reactix as R import Reactix as R
import Web.Storage.Storage as WSS import Web.Storage.Storage as WSS
...@@ -44,48 +44,93 @@ useLoaderEffect path state@(state' /\ setState) loader = do ...@@ -44,48 +44,93 @@ useLoaderEffect path state@(state' /\ setState) loader = do
liftEffect $ setState $ const $ Just l liftEffect $ setState $ const $ Just l
newtype HashedResponse a = HashedResponse {
md5 :: String
, value :: a
}
instance decodeHashedResponse :: DecodeJson a => DecodeJson (HashedResponse a) where
decodeJson json = do
obj <- decodeJson json
md5 <- obj .: "md5"
value <- obj .: "value"
pure $ HashedResponse { md5, value }
instance encodeHashedResponse :: EncodeJson a => EncodeJson (HashedResponse a) where
encodeJson (HashedResponse { md5, value }) = do
"md5" := encodeJson md5
~> "value" := encodeJson value
~> jsonEmptyObject
useLoaderWithCache :: forall path st. Eq path => DecodeJson st => EncodeJson st => useLoaderWithCache :: forall path st. Eq path => DecodeJson st => EncodeJson st =>
path path
-> (path -> String) -> (path -> String)
-> (path -> Aff st) -> (path -> Aff String)
-> (path -> Aff (HashedResponse st))
-> (st -> R.Element) -> R.Hooks R.Element -> (st -> R.Element) -> R.Hooks R.Element
useLoaderWithCache path keyFunc loader render = do useLoaderWithCache path keyFunc md5Endpoint loader render = do
state <- R.useState' Nothing state <- R.useState' Nothing
useCachedLoaderEffect path keyFunc state loader useCachedLoaderEffect path keyFunc md5Endpoint state loader
pure $ maybe (loadingSpinner {}) render (fst state) pure $ maybe (loadingSpinner {}) render (fst state)
useCachedLoaderEffect :: forall path st. Eq path => DecodeJson st => EncodeJson st => useCachedLoaderEffect :: forall path st. Eq path => DecodeJson st => EncodeJson st =>
path path
-> (path -> String) -> (path -> String)
-> (path -> Aff String)
-> R.State (Maybe st) -> R.State (Maybe st)
-> (path -> Aff st) -> (path -> Aff (HashedResponse st))
-> R.Hooks Unit -> R.Hooks Unit
useCachedLoaderEffect path keyFunc state@(state' /\ setState) loader = do useCachedLoaderEffect path keyFunc md5Endpoint state@(state' /\ setState) loader = do
oPath <- R.useRef path oPath <- R.useRef path
R.useEffect' $ do R.useEffect' $ do
if (R.readRef oPath == path) && (isJust state') then if (R.readRef oPath == path) && (isJust state') then
pure $ pure unit pure unit
else do else do
R.setRef oPath path R.setRef oPath path
let key = keyFunc path let key = "loader--" <> (keyFunc path)
-- log2 "[useCachedLoader] key" key
let keyMD5 = key <> "-md5"
localStorage <- R2.getls localStorage <- R2.getls
mState <- WSS.getItem key localStorage mState <- WSS.getItem key localStorage
case mState of mMD5 <- WSS.getItem keyMD5 localStorage
Nothing -> pure unit -- log2 "[useCachedLoader] mState" mState
Just stStr -> launchAff_ $ do
case (parse stStr >>= decode) of case mState of
Left err -> pure unit Nothing -> loadRealData key keyMD5 localStorage
Right st -> setState $ const $ Just st Just stStr -> do
let parsed = parse stStr >>= decode
R2.affEffect "G.H.Loader.useCachedLoaderEffect" $ do case parsed of
l <- loader path Left err -> do
liftEffect $ do -- liftEffect $ log2 "[useCachedLoader] err" err
let value = stringify $ encodeJson l loadRealData key keyMD5 localStorage
WSS.setItem key value localStorage Right (st :: st) -> do
setState $ const $ Just l md5Real <- md5Endpoint path
-- liftEffect $ log2 "[useCachedLoader] md5Real" md5Real
case mMD5 of
Nothing -> do
-- liftEffect $ log2 "[useCachedLoader] no stored md5" Nothing
loadRealData key keyMD5 localStorage
Just md5 -> do
-- liftEffect $ log2 "[useCachedLoader] stored md5" md5
if md5 == md5Real then
-- yay! cache hit!
liftEffect $ setState $ const $ Just st
else
loadRealData key keyMD5 localStorage
where where
parse s = GU.mapLeft (log2 "Error parsing serialised sessions:") (jsonParser s) loadRealData :: String -> String -> WSS.Storage -> Aff Unit
decode j = GU.mapLeft (log2 "Error decoding serialised sessions:") (decodeJson j) loadRealData key keyMD5 localStorage = do
--R2.affEffect "G.H.Loader.useCachedLoaderEffect" $ do
HashedResponse { md5, value: l } <- loader path
liftEffect $ do
let value = stringify $ encodeJson l
WSS.setItem key value localStorage
WSS.setItem keyMD5 md5 localStorage
setState $ const $ Just l
pure unit
parse s = GU.mapLeft (\err -> "Error parsing serialised sessions:" <> show err) (jsonParser s)
decode j = GU.mapLeft (\err -> "Error decoding serialised sessions:" <> show err) (decodeJson j)
...@@ -44,7 +44,9 @@ data SessionRoute ...@@ -44,7 +44,9 @@ data SessionRoute
| ListDocument (Maybe ListId) (Maybe Id) | ListDocument (Maybe ListId) (Maybe Id)
| Search SearchOpts (Maybe Id) | Search SearchOpts (Maybe Id)
| CorpusMetrics CorpusMetricOpts (Maybe Id) | CorpusMetrics CorpusMetricOpts (Maybe Id)
| CorpusMetricsMD5 { listId :: ListId, tabType :: TabType } (Maybe Id)
| Chart ChartOpts (Maybe Id) | Chart ChartOpts (Maybe Id)
| ChartMD5 { chartType :: ChartType, listId :: ListId, tabType :: TabType } (Maybe Id)
instance showAppRoute :: Show AppRoute where instance showAppRoute :: Show AppRoute where
show Home = "Home" show Home = "Home"
......
...@@ -10,7 +10,7 @@ import Data.Generic.Rep.Show (genericShow) ...@@ -10,7 +10,7 @@ import Data.Generic.Rep.Show (genericShow)
import Data.Int (toNumber) import Data.Int (toNumber)
import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Prelude (class Read, read) import Gargantext.Prelude (class Read, read, class Show, show)
import Prelude import Prelude
import Prim.Row (class Union) import Prim.Row (class Union)
import URI.Query (Query) import URI.Query (Query)
...@@ -56,14 +56,14 @@ termSizes = [ { desc: "All types", mval: Nothing } ...@@ -56,14 +56,14 @@ termSizes = [ { desc: "All types", mval: Nothing }
, { desc: "Multi-word terms", mval: Just MultiTerm } , { desc: "Multi-word terms", mval: Just MultiTerm }
] ]
data TermList = GraphTerm | StopTerm | CandidateTerm data TermList = MapTerm | StopTerm | CandidateTerm
-- TODO use generic JSON instance -- TODO use generic JSON instance
derive instance eqTermList :: Eq TermList derive instance eqTermList :: Eq TermList
derive instance ordTermList :: Ord TermList derive instance ordTermList :: Ord TermList
instance encodeJsonTermList :: EncodeJson TermList where instance encodeJsonTermList :: EncodeJson TermList where
encodeJson GraphTerm = encodeJson "GraphTerm" encodeJson MapTerm = encodeJson "MapTerm"
encodeJson StopTerm = encodeJson "StopTerm" encodeJson StopTerm = encodeJson "StopTerm"
encodeJson CandidateTerm = encodeJson "CandidateTerm" encodeJson CandidateTerm = encodeJson "CandidateTerm"
...@@ -71,7 +71,7 @@ instance decodeJsonTermList :: DecodeJson TermList where ...@@ -71,7 +71,7 @@ instance decodeJsonTermList :: DecodeJson TermList where
decodeJson json = do decodeJson json = do
s <- decodeJson json s <- decodeJson json
case s of case s of
"GraphTerm" -> pure GraphTerm "MapTerm" -> pure MapTerm
"StopTerm" -> pure StopTerm "StopTerm" -> pure StopTerm
"CandidateTerm" -> pure CandidateTerm "CandidateTerm" -> pure CandidateTerm
_ -> Left "Unexpected list name" _ -> Left "Unexpected list name"
...@@ -79,31 +79,31 @@ instance decodeJsonTermList :: DecodeJson TermList where ...@@ -79,31 +79,31 @@ instance decodeJsonTermList :: DecodeJson TermList where
type ListTypeId = Int type ListTypeId = Int
listTypeId :: TermList -> ListTypeId listTypeId :: TermList -> ListTypeId
listTypeId GraphTerm = 1 listTypeId MapTerm = 1
listTypeId StopTerm = 2 listTypeId StopTerm = 2
listTypeId CandidateTerm = 3 listTypeId CandidateTerm = 3
instance showTermList :: Show TermList where instance showTermList :: Show TermList where
show GraphTerm = "GraphTerm" show MapTerm = "MapTerm"
show StopTerm = "StopTerm" show StopTerm = "StopTerm"
show CandidateTerm = "CandidateTerm" show CandidateTerm = "CandidateTerm"
-- TODO: Can we replace the show instance above with this? -- TODO: Can we replace the show instance above with this?
termListName :: TermList -> String termListName :: TermList -> String
termListName GraphTerm = "Map List" termListName MapTerm = "Map List"
termListName StopTerm = "Stop List" termListName StopTerm = "Stop List"
termListName CandidateTerm = "Candidate List" termListName CandidateTerm = "Candidate List"
instance readTermList :: Read TermList where instance readTermList :: Read TermList where
read :: String -> Maybe TermList read :: String -> Maybe TermList
read "GraphTerm" = Just GraphTerm read "MapTerm" = Just MapTerm
read "StopTerm" = Just StopTerm read "StopTerm" = Just StopTerm
read "CandidateTerm" = Just CandidateTerm read "CandidateTerm" = Just CandidateTerm
read _ = Nothing read _ = Nothing
termLists :: Array { desc :: String, mval :: Maybe TermList } termLists :: Array { desc :: String, mval :: Maybe TermList }
termLists = [ { desc: "All terms", mval: Nothing } termLists = [ { desc: "All terms", mval: Nothing }
, { desc: "Map terms", mval: Just GraphTerm } , { desc: "Map terms", mval: Just MapTerm }
, { desc: "Stop terms", mval: Just StopTerm } , { desc: "Stop terms", mval: Just StopTerm }
, { desc: "Candidate terms", mval: Just CandidateTerm } , { desc: "Candidate terms", mval: Just CandidateTerm }
] ]
......
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