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
f844290a
Commit
f844290a
authored
Jun 29, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev' into dev-doc-table-optimization
parents
c86fd7e8
1a198895
Changes
34
Hide whitespace changes
Inline
Side-by-side
Showing
34 changed files
with
491 additions
and
282 deletions
+491
-282
Login.css
dist/styles/Login.css
+1
-0
Login.sass
dist/styles/Login.sass
+1
-0
package.json
package.json
+1
-1
Menu.purs
src/Gargantext/Components/Annotation/Menu.purs
+1
-1
Utils.purs
src/Gargantext/Components/Annotation/Utils.purs
+2
-2
Series.purs
src/Gargantext/Components/Charts/Options/Series.purs
+8
-9
FacetsTable.purs
src/Gargantext/Components/FacetsTable.purs
+1
-1
Tree.purs
src/Gargantext/Components/Forest/Tree.purs
+19
-11
Node.purs
src/Gargantext/Components/Forest/Tree/Node.purs
+1
-22
Action.purs
src/Gargantext/Components/Forest/Tree/Node/Action.purs
+38
-28
Link.purs
src/Gargantext/Components/Forest/Tree/Node/Action/Link.purs
+12
-10
Merge.purs
src/Gargantext/Components/Forest/Tree/Node/Action/Merge.purs
+25
-12
Move.purs
src/Gargantext/Components/Forest/Tree/Node/Action/Move.purs
+12
-11
Box.purs
src/Gargantext/Components/Forest/Tree/Node/Box.purs
+40
-21
Settings.purs
src/Gargantext/Components/Forest/Tree/Node/Settings.purs
+1
-16
Status.purs
src/Gargantext/Components/Forest/Tree/Node/Status.purs
+21
-0
Tools.purs
src/Gargantext/Components/Forest/Tree/Node/Tools.purs
+65
-4
SubTree.purs
...Gargantext/Components/Forest/Tree/Node/Tools/SubTree.purs
+46
-37
Types.purs
...text/Components/Forest/Tree/Node/Tools/SubTree/Types.purs
+25
-0
Sidebar.purs
src/Gargantext/Components/GraphExplorer/Sidebar.purs
+1
-1
Login.purs
src/Gargantext/Components/Login.purs
+2
-10
NgramsTable.purs
src/Gargantext/Components/NgramsTable.purs
+1
-1
Components.purs
src/Gargantext/Components/NgramsTable/Components.purs
+4
-4
Core.purs
src/Gargantext/Components/NgramsTable/Core.purs
+1
-1
Common.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Common.purs
+13
-9
Histo.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Histo.purs
+13
-7
Metrics.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Metrics.purs
+16
-9
Pie.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Pie.purs
+16
-10
Predefined.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Predefined.purs
+0
-2
Tree.purs
src/Gargantext/Components/Nodes/Corpus/Chart/Tree.purs
+11
-7
Ends.purs
src/Gargantext/Ends.purs
+13
-2
Loader.purs
src/Gargantext/Hooks/Loader.purs
+69
-24
Routes.purs
src/Gargantext/Routes.purs
+2
-0
Types.purs
src/Gargantext/Types.purs
+9
-9
No files found.
dist/styles/Login.css
View file @
f844290a
...
@@ -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
;
...
...
dist/styles/Login.sass
View file @
f844290a
...
@@ -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
...
...
package.json
View file @
f844290a
{
{
"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"
,
...
...
src/Gargantext/Components/Annotation/Menu.purs
View file @
f844290a
...
@@ -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) [
Graph
Term, CandidateTerm, StopTerm ]
children props = A.mapMaybe (addToList props) [
Map
Term, 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
...
...
src/Gargantext/Components/Annotation/Utils.purs
View file @
f844290a
...
@@ -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
Graph
Term = "graph-term"
termClass
Map
Term = "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
Graph
Term = "success"
termBootstrapClass
Map
Term = "success"
termBootstrapClass StopTerm = "danger"
termBootstrapClass StopTerm = "danger"
termBootstrapClass CandidateTerm = "warning"
termBootstrapClass CandidateTerm = "warning"
src/Gargantext/Components/Charts/Options/Series.purs
View file @
f844290a
...
@@ -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
...
...
src/Gargantext/Components/FacetsTable.purs
View file @
f844290a
...
@@ -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" } }
...
...
src/Gargantext/Components/Forest/Tree.purs
View file @
f844290a
...
@@ -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
...
...
src/Gargantext/Components/Forest/Tree/Node.purs
View file @
f844290a
...
@@ -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 =
...
...
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @
f844290a
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"
-----------------------------------------------------------------------
-----------------------------------------------------------------------
src/Gargantext/Components/Forest/Tree/Node/Action/Link.purs
View file @
f844290a
...
@@ -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
src/Gargantext/Components/Forest/Tree/Node/Action/Merge.purs
View file @
f844290a
...
@@ -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
src/Gargantext/Components/Forest/Tree/Node/Action/Move.purs
View file @
f844290a
...
@@ -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
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @
f844290a
...
@@ -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
...
...
src/Gargantext/Components/Forest/Tree/Node/Settings.purs
View file @
f844290a
...
@@ -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
...
...
src/Gargantext/Components/Forest/Tree/Node/Status.purs
0 → 100644
View file @
f844290a
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
src/Gargantext/Components/Forest/Tree/Node/Tools.purs
View file @
f844290a
...
@@ -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-1
0" }
[ H.div { className: "col-md-1
2" } 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"} []
src/Gargantext/Components/Forest/Tree/Node/Tools/SubTree.purs
View file @
f844290a
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:
source
Id
, tree: NTree (LNode { id:
target
Id
, 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 })) a
ry
children = map (\c
tree -> subTreeTreeView (p { tree = ctree })) sortedA
ry
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}))
--------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------
src/Gargantext/Components/Forest/Tree/Node/Tools/SubTree/Types.purs
0 → 100644
View file @
f844290a
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
------------------------------------------------------------------------
src/Gargantext/Components/GraphExplorer/Sidebar.purs
View file @
f844290a
...
@@ -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:
Graph
Term }
patch_list = NTC.Replace { new: termList, old:
Map
Term }
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
...
...
src/Gargantext/Components/Login.purs
View file @
f844290a
...
@@ -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"}
[
termsC
heckbox setBox
[
c
heckbox 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" ]
...
...
src/Gargantext/Components/NgramsTable.purs
View file @
f844290a
...
@@ -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
Graph
Term }
, on: { click: const $ setSelection
Map
Term }
} [ 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 }
...
...
src/Gargantext/Components/NgramsTable/Components.purs
View file @
f844290a
...
@@ -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.
Graph
Term
, checkbox T.
Map
Term
, 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.
Graph
Term opacity = DOM.style { color: "green", opacity }
termStyle T.
Map
Term 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.
Graph
Term = T.StopTerm
nextTermList T.
Map
Term = T.StopTerm
nextTermList T.StopTerm = T.CandidateTerm
nextTermList T.StopTerm = T.CandidateTerm
nextTermList T.CandidateTerm = T.
Graph
Term
nextTermList T.CandidateTerm = T.
Map
Term
src/Gargantext/Components/NgramsTable/Core.purs
View file @
f844290a
...
@@ -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
Graph
Term
, termListFilter: Just
Map
Term
, searchQuery: ""
, searchQuery: ""
, scoreType: Occurrences
, scoreType: Occurrences
, session
, session
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Common.purs
View file @
f844290a
...
@@ -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 (Metrics
WithCache
LoadViewProps 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 (Metrics
WithCache
LoadViewProps 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)
src/Gargantext/Components/Nodes/Corpus/Chart/Histo.purs
View file @
f844290a
...
@@ -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 =
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Metrics.purs
View file @
f844290a
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
Graph
Term -> green
Map
Term -> 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
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Pie.purs
View file @
f844290a
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
Graph
Term"
, subTitle : "Count of
Map
Term"
, 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
Graph
Term"
, subTitle : "Distribution by
Map
Term"
, 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 =
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Predefined.purs
View file @
f844290a
...
@@ -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 =
...
...
src/Gargantext/Components/Nodes/Corpus/Chart/Tree.purs
View file @
f844290a
...
@@ -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 =
...
...
src/Gargantext/Ends.purs
View file @
f844290a
...
@@ -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=
Graph
Term"
sessionPath (R.RecomputeListChart ChartTree nt nId lId) = "node/" <> (show nId) <> "/tree?list=" <> (show lId) <> "&ngramsType=" <> (show nt) <> "&listType=
Map
Term"
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=
Graph
Term" -- <> show listId
<> "&listType=
Map
Term" -- <> 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
...
...
src/Gargantext/Hooks/Loader.purs
View file @
f844290a
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)
src/Gargantext/Routes.purs
View file @
f844290a
...
@@ -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"
...
...
src/Gargantext/Types.purs
View file @
f844290a
...
@@ -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 =
Graph
Term | StopTerm | CandidateTerm
data TermList =
Map
Term | 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 "Graph
Term"
encodeJson
MapTerm = encodeJson "Map
Term"
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 Graph
Term
"
MapTerm" -> pure Map
Term
"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
Graph
Term = 1
listTypeId
Map
Term = 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 = "Graph
Term"
show
MapTerm = "Map
Term"
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
Graph
Term = "Map List"
termListName
Map
Term = "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 Graph
Term
read "
MapTerm" = Just Map
Term
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
Graph
Term }
, { desc: "Map terms", mval: Just
Map
Term }
, { desc: "Stop terms", mval: Just StopTerm }
, { desc: "Stop terms", mval: Just StopTerm }
, { desc: "Candidate terms", mval: Just CandidateTerm }
, { desc: "Candidate terms", mval: Just CandidateTerm }
]
]
...
...
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