Skip to content

P
purescript-gargantext
Commit 76d88cea authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[tree] first-level endpoint implemented

parent 11dea9a2
Hide whitespace changes
Inline Side-by-side
Showing with 357 additions and 153 deletions
src/Gargantext/Components/Forest.purs
View file @ 76d88cea
...@@ -85,7 +85,7 @@ forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where ...@@ -85,7 +85,7 @@ forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where
, reload , reload
, root: treeId , root: treeId
, session: s , session: s
} } []
plus :: Handed -> R.Setter Boolean -> R.State (Maybe Backend) -> R.Element plus :: Handed -> R.Setter Boolean -> R.State (Maybe Backend) -> R.Element
plus handed showLogin backend = H.div { className: handedClass } [ plus handed showLogin backend = H.div { className: handedClass } [
......
src/Gargantext/Components/Forest/Tree.purs
View file @ 76d88cea
...@@ -13,8 +13,10 @@ import Reactix.DOM.HTML as H ...@@ -13,8 +13,10 @@ import Reactix.DOM.HTML as H
import Record as Record import Record as Record
import Record.Extra as RecordE import Record.Extra as RecordE
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node (nodeMainSpan) import Gargantext.Components.Forest.Tree.Node (nodeSpan)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..)) 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)
...@@ -28,9 +30,8 @@ import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact ...@@ -28,9 +30,8 @@ import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest) import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile) import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..)) import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends, toUrl)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>), (==), (<<<), not)
import Gargantext.Routes (AppRoute) import Gargantext.Routes (AppRoute)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (OpenNodes, Session, mkNodeId, get) import Gargantext.Sessions (OpenNodes, Session, mkNodeId, get)
...@@ -58,63 +59,75 @@ type Props = ( ...@@ -58,63 +59,75 @@ type Props = (
| CommonProps | CommonProps
) )
treeView :: Record Props -> R.Element treeView :: R2.Component Props
treeView props = R.createElement treeViewCpt props [] treeView = R.createElement elCpt
where where
treeViewCpt :: R.Component Props elCpt :: R.Component Props
treeViewCpt = R.hooksComponentWithModule thisModule "treeView" cpt elCpt = R.hooksComponentWithModule thisModule "treeView" cpt
where
cpt { asyncTasks cpt { asyncTasks
, frontends , frontends
, handed , handed
, mCurrentRoute , mCurrentRoute
, openNodes , openNodes
, reload , reload
, root , root
, session , session
} _children = do } _children = do
pure $ treeLoadView { asyncTasks pure $ treeLoadView { asyncTasks
, frontends , frontends
, handed , handed
, mCurrentRoute , mCurrentRoute
, openNodes , openNodes
, reload , reload
, root , root
, session , session
} } []
treeLoadView :: Record Props -> R.Element treeLoadView :: R2.Component Props
treeLoadView p = R.createElement treeLoadViewCpt p [] treeLoadView = R.createElement elCpt
where where
treeLoadViewCpt :: R.Component Props elCpt :: R.Component Props
treeLoadViewCpt = R.hooksComponentWithModule thisModule "treeLoadView" cpt elCpt = R.hooksComponentWithModule thisModule "treeLoadView" cpt
where
cpt { asyncTasks cpt { asyncTasks
, frontends , frontends
, handed , handed
, mCurrentRoute , mCurrentRoute
, openNodes , openNodes
, reload , reload
, root , root
, session , session
} _children = do } _children = do
let fetch _ = getNodeTree session root let fetch _ = getNodeTree session root
let paint loaded = loadedTreeView { asyncTasks -- let paint loaded = loadedTreeView { asyncTasks
, frontends -- , frontends
, handed -- , handed
, mCurrentRoute -- , mCurrentRoute
, openNodes -- , openNodes
, reload -- , reload
, session -- , session
-- , tasks: tasksStruct root asyncTasks reload -- -- , tasks: tasksStruct root asyncTasks reload
, tree: loaded -- , tree: loaded
} -- } []
useLoader { root, counter: fst reload } fetch paint let paint loaded = loadedTreeViewFirstLevel { asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload
, session
-- , tasks: tasksStruct root asyncTasks reload
, tree: loaded
} []
useLoader { root, counter: fst reload } fetch paint
-------------- --------------
getNodeTree :: Session -> GT.ID -> Aff FTree 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) ""
--------------
getNodeTreeFirstLevel :: Session -> GT.ID -> Aff FTree
getNodeTreeFirstLevel session nodeId = get session $ GR.TreeFirstLevel (Just nodeId) ""
-------------- --------------
type TreeViewProps = ( type TreeViewProps = (
asyncTasks :: GAT.Reductor asyncTasks :: GAT.Reductor
...@@ -122,36 +135,67 @@ type TreeViewProps = ( ...@@ -122,36 +135,67 @@ type TreeViewProps = (
| CommonProps | CommonProps
) )
loadedTreeView :: Record TreeViewProps -> R.Element loadedTreeView :: R2.Component TreeViewProps
loadedTreeView p = R.createElement loadedTreeViewCpt p [] loadedTreeView = R.createElement elCpt
where where
loadedTreeViewCpt :: R.Component TreeViewProps elCpt :: R.Component TreeViewProps
loadedTreeViewCpt = R.hooksComponentWithModule thisModule "loadedTreeView" cpt elCpt = R.hooksComponentWithModule thisModule "loadedTreeView" cpt
where
cpt { asyncTasks cpt { asyncTasks
, frontends , frontends
, handed , handed
, mCurrentRoute , mCurrentRoute
, openNodes , openNodes
, reload , reload
, session , session
-- , tasks -- , tasks
, tree , tree
} _ = do } _ = do
pure $ H.ul { className: "tree" } [ pure $ H.ul { className: "tree" } [
H.div { className: if handed == GT.RightHanded then "righthanded" else "lefthanded" } [ H.div { className: if handed == GT.RightHanded then "righthanded" else "lefthanded" } [
toHtml { asyncTasks toHtml { asyncTasks
, frontends , frontends
, handed , handed
, mCurrentRoute , mCurrentRoute
, openNodes , openNodes
, reload , reload
, session , session
-- , tasks -- , tasks
, tree , tree
} } []
] ]
]
loadedTreeViewFirstLevel :: R2.Component TreeViewProps
loadedTreeViewFirstLevel = R.createElement elCpt
where
elCpt :: R.Component TreeViewProps
elCpt = R.hooksComponentWithModule thisModule "loadedTreeViewFirstLevel" cpt
cpt { asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload
, session
-- , tasks
, tree
} _ = do
pure $ H.ul { className: "tree" } [
H.div { className: if handed == GT.RightHanded then "righthanded" else "lefthanded" } [
toHtmlFirstLevel { asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload
, session
-- , tasks
, tree
} []
] ]
]
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -163,63 +207,149 @@ type ToHtmlProps = ( ...@@ -163,63 +207,149 @@ type ToHtmlProps = (
| CommonProps | CommonProps
) )
toHtml :: Record ToHtmlProps -> R.Element toHtml :: R2.Component ToHtmlProps
toHtml p = R.createElement toHtmlCpt p [] toHtml = R.createElement elCpt
where
toHtmlCpt :: R.Component ToHtmlProps elCpt :: R.Component ToHtmlProps
toHtmlCpt = R.hooksComponentWithModule thisModule "nodeView" cpt elCpt = R.hooksComponentWithModule thisModule "toHtml" cpt
where
cpt p@{ asyncTasks cpt p@{ asyncTasks
, frontends , frontends
, handed , handed
, mCurrentRoute , mCurrentRoute
, openNodes , openNodes
, reload: reload@(_ /\ setReload) , reload: reload@(_ /\ setReload)
, session , session
, tree: tree@(NTree (LNode { id , tree: tree@(NTree (LNode { id
, name , name
, nodeType , nodeType
} }
) ary ) ary
) )
} _ = do } _ = do
let commonProps = RecordE.pick p :: Record CommonProps let commonProps = RecordE.pick p :: Record CommonProps
let pAction a = performAction a (RecordE.pick p :: Record PerformActionProps) let pAction a = performAction a (RecordE.pick p :: Record PerformActionProps)
let nodeId = mkNodeId session id let nodeId = mkNodeId session id
let folderIsOpen = Set.member nodeId (fst openNodes) let folderIsOpen = Set.member nodeId (fst openNodes)
let setFn = if folderIsOpen then Set.delete else Set.insert let setFn = if folderIsOpen then Set.delete else Set.insert
let toggleFolderIsOpen _ = (snd openNodes) (setFn nodeId) let toggleFolderIsOpen _ = (snd openNodes) (setFn nodeId)
let folderOpen = Tuple folderIsOpen toggleFolderIsOpen let folderOpen = Tuple folderIsOpen toggleFolderIsOpen
let withId (NTree (LNode {id: id'}) _) = id' let withId (NTree (LNode {id: id'}) _) = id'
pure $ H.li { className: if A.null ary then "no-children" else "with-children" } $ let publicizedChildren = if isPublic nodeType
[ nodeMainSpan { appReload: reload then map (\t -> map (\(LNode n@{ nodeType: nt } )
, asyncTasks -> (LNode (n { nodeType = publicize nt }))
, dispatch: pAction ) t) ary
, folderOpen else ary
, frontends
, handed pure $ H.li { className: if A.null ary then "no-children" else "with-children" }
, id [ nodeSpan { appReload: reload
, isLeaf: A.null ary , asyncTasks
, mCurrentRoute , dispatch: pAction
, name , folderOpen
, nodeType , frontends
, session , handed
-- , tasks , id
} ] , isLeaf: A.null ary
<> childNodes ( Record.merge commonProps , mCurrentRoute
, name
, nodeType
, session
-- , tasks
}
(
childNodes ( Record.merge commonProps
{ asyncTasks { asyncTasks
, children: if isPublic nodeType , children: publicizedChildren
then map (\t -> map (\(LNode n@{ nodeType:nt } )
-> (LNode (n { nodeType= publicize nt }))
) t) ary
else ary
, folderOpen , folderOpen
, handed , handed
} }
) )
)
]
toHtmlFirstLevel :: R2.Component ToHtmlProps
toHtmlFirstLevel = R.createElement elCpt
where
elCpt :: R.Component ToHtmlProps
elCpt = R.hooksComponentWithModule thisModule "toHtmlFirstLevel" cpt
cpt p@{ asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload: reload@(_ /\ setReload)
, session
, tree: tree@(NTree (LNode { id
, name
, nodeType
}
) ary
)
} _ = do
let pAction a = performAction a (RecordE.pick p :: Record PerformActionProps)
let nodeId = mkNodeId session id
let folderIsOpen = Set.member nodeId (fst openNodes)
let setFn = if folderIsOpen then Set.delete else Set.insert
let toggleFolderIsOpen _ = (snd openNodes) (setFn nodeId)
let folderOpen = Tuple folderIsOpen toggleFolderIsOpen
let withId (NTree (LNode {id: id'}) _) = id'
pure $ H.li { className: if A.null ary then "no-children" else "with-children" } $
[ nodeSpan { appReload: reload
, asyncTasks
, dispatch: pAction
, folderOpen
, frontends
, handed
, id
, isLeaf: A.null ary
, mCurrentRoute
, name
, nodeType
, session
-- , tasks
}
$ renderChildren folderOpen publicizedChildren
]
where
commonProps = RecordE.pick p :: Record CommonProps
publicizedChildren = if isPublic nodeType
then map (\t -> map (\(LNode n@{ nodeType:nt } )
-> (LNode (n { nodeType = publicize nt }))
) t) ary
else ary
renderChildren (false /\ _) _ = []
renderChildren folderOpen@(true /\ _) cs =
(
map (\t@(NTree (LNode {id: cId}) _) ->
childNodeFirstLevel ( Record.merge commonProps
{ asyncTasks
, folderOpen
, handed
, id: cId
}
) []
) publicizedChildren
)
-- childNodesFirstLevel ( Record.merge commonProps
-- { asyncTasks
-- , children: if isPublic nodeType
-- then map (\t -> map (\(LNode n@{ nodeType:nt } )
-- -> (LNode (n { nodeType= publicize nt }))
-- ) t) ary
-- else ary
-- , folderOpen
-- , handed
-- }
-- )
type ChildNodesProps = type ChildNodesProps =
...@@ -239,13 +369,79 @@ childNodes props@{ asyncTasks, children, reload, handed } = ...@@ -239,13 +369,79 @@ childNodes props@{ asyncTasks, children, reload, handed } =
-- , tasks: tasksStruct id asyncTasks reload -- , tasks: tasksStruct id asyncTasks reload
, tree: ctree , tree: ctree
} }
)] ) []
]
) $ sorted children ) $ sorted children
where where
commonProps = RecordE.pick props :: Record CommonProps commonProps = RecordE.pick props :: Record CommonProps
sorted :: Array FTree -> Array FTree sorted :: Array FTree -> Array FTree
sorted = A.sortWith (\(NTree (LNode {id}) _) -> id) sorted = A.sortWith (\(NTree (LNode {id}) _) -> id)
type ChildNodeFirstLevelProps = (
asyncTasks :: GAT.Reductor
, folderOpen :: R.State Boolean
, id :: ID
| CommonProps
)
childNodeFirstLevel :: R2.Component ChildNodeFirstLevelProps
childNodeFirstLevel = R.createElement elCpt
where
elCpt :: R.Component ChildNodeFirstLevelProps
elCpt = R.hooksComponentWithModule thisModule "childNodeFirstLevel" cpt
cpt props@{ asyncTasks, folderOpen, id, frontends, handed, mCurrentRoute, openNodes, reload, session } _ = do
cptReload <- R.useState' 0
let fetch _ = getNodeTreeFirstLevel session id
let paint loaded = childNodeFirstLevelPaint { asyncTasks
, folderOpen
, frontends
, handed
, mCurrentRoute
, openNodes
, reload: cptReload
, session
, tree: loaded } []
useLoader { counter: fst cptReload, root: id } fetch paint
type ChildNodeFirstLevelPaintProps = (
asyncTasks :: GAT.Reductor
, folderOpen :: R.State Boolean
, tree :: FTree
| CommonProps
)
childNodeFirstLevelPaint :: R2.Component ChildNodeFirstLevelPaintProps
childNodeFirstLevelPaint = R.createElement elCpt
where
elCpt :: R.Component ChildNodeFirstLevelPaintProps
elCpt = R.hooksComponentWithModule thisModule "childNodeFirstLevelPaint" cpt
cpt props@{ asyncTasks, handed, folderOpen: (false /\ _), reload, tree: ctree@(NTree (LNode { id }) _) } _ = do
pure $ H.ul {} [
toHtmlFirstLevel (Record.merge commonProps { asyncTasks
, handed
, tree: ctree }
) []
]
-- pure $ H.div { } [ H.text $ "[closed] Node id " <> show id ]
where
commonProps = RecordE.pick props :: Record CommonProps
cpt props@{ asyncTasks, handed, folderOpen: (true /\ _), reload, tree: ctree@(NTree (LNode { id }) _) } _ = do
pure $ H.ul {} [
toHtmlFirstLevel (Record.merge commonProps { asyncTasks
, handed
, tree: ctree }
) []
]
-- pure $ H.div { } [ H.text $ "[opened] Node id " <> show id ]
where
commonProps = RecordE.pick props :: Record CommonProps
type PerformActionProps = type PerformActionProps =
( asyncTasks :: GAT.Reductor ( asyncTasks :: GAT.Reductor
, openNodes :: R.State OpenNodes , openNodes :: R.State OpenNodes
......
src/Gargantext/Components/Forest/Tree/Node.purs
View file @ 76d88cea
...@@ -56,9 +56,17 @@ type NodeMainSpanProps = ( ...@@ -56,9 +56,17 @@ type NodeMainSpanProps = (
type IsLeaf = Boolean type IsLeaf = Boolean
nodeMainSpan :: Record NodeMainSpanProps nodeSpan :: R2.Component NodeMainSpanProps
-> R.Element nodeSpan = R.createElement nodeSpanCpt
nodeMainSpan p = R.createElement nodeMainSpanCpt p []
nodeSpanCpt :: R.Component NodeMainSpanProps
nodeSpanCpt = R.hooksComponentWithModule thisModule "nodeSpan" cpt
where
cpt props children = do
pure $ H.div {} ([ nodeMainSpan props [] ] <> children)
nodeMainSpan :: R2.Component NodeMainSpanProps
nodeMainSpan = R.createElement nodeMainSpanCpt
nodeMainSpanCpt :: R.Component NodeMainSpanProps nodeMainSpanCpt :: R.Component NodeMainSpanProps
nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
...@@ -155,20 +163,17 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt ...@@ -155,20 +163,17 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
, session , session
} }
chevronIcon isLeaf handed' nodeType (open /\ setOpen) = chevronIcon true handed' nodeType (open /\ setOpen) = H.div {} []
if isLeaf chevronIcon false handed' nodeType (open /\ setOpen) =
then H.div {} [] H.a { className: "chevron-icon"
else , on: { click: \_ -> setOpen $ not }
H.a { className: "chevron-icon" }
, on: { click: \_ -> setOpen $ not } [ H.i { className: if open
} then "fa fa-chevron-down"
[ H.i { else if handed' == GT.RightHanded
className: if open then "fa fa-chevron-right"
then "fa fa-chevron-down" else "fa fa-chevron-left"
else if handed' == GT.RightHanded } [] ]
then "fa fa-chevron-right"
else "fa fa-chevron-left"
} [] ]
folderIcon nodeType (open /\ setOpen) = folderIcon nodeType (open /\ setOpen) =
H.a { className: "folder-icon" H.a { className: "folder-icon"
......
src/Gargantext/Ends.purs
View file @ 76d88cea
...@@ -172,6 +172,8 @@ sessionPath (R.PostNgramsChartsAsync i) = ...@@ -172,6 +172,8 @@ sessionPath (R.PostNgramsChartsAsync i) =
sessionPath (R.NodeAPI nt i p) = nodeTypePath nt sessionPath (R.NodeAPI nt i p) = nodeTypePath nt
<> (maybe "" (\i' -> "/" <> show i') i) <> (maybe "" (\i' -> "/" <> show i') i)
<> (if p == "" then "" else "/" <> p) <> (if p == "" then "" else "/" <> p)
sessionPath (R.TreeFirstLevel nId p) = nodeTypePath Tree
<> (maybe "" (\nId' -> "/" <> show nId') nId) <> "/first-level" <> p
sessionPath (R.Search {listId, limit, offset, orderBy} Nothing) = sessionPath (R.Search {listId, limit, offset, orderBy} Nothing) =
sessionPath $ R.NodeAPI Corpus Nothing sessionPath $ R.NodeAPI Corpus Nothing
$ "search?list_id=" <> show listId $ "search?list_id=" <> show listId
......
src/Gargantext/Routes.purs
View file @ 76d88cea
...@@ -50,6 +50,7 @@ data SessionRoute ...@@ -50,6 +50,7 @@ data SessionRoute
| RecomputeNgrams (TabSubType CTabNgramType) Id ListId | RecomputeNgrams (TabSubType CTabNgramType) Id ListId
| RecomputeListChart ChartType CTabNgramType Id ListId | RecomputeListChart ChartType CTabNgramType Id ListId
| NodeAPI NodeType (Maybe Id) String | NodeAPI NodeType (Maybe Id) String
| TreeFirstLevel (Maybe Id) String
| GraphAPI Id String | GraphAPI Id String
| ListsRoute ListId | ListsRoute ListId
| ListDocument (Maybe ListId) (Maybe Id) | ListDocument (Maybe ListId) (Maybe Id)
......
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