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
, reload
, root: treeId
, session: s
}
} []
plus :: Handed -> R.Setter Boolean -> R.State (Maybe Backend) -> R.Element
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
import Record as Record
import Record.Extra as RecordE
import Gargantext.Prelude
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.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
......@@ -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.Upload (uploadFile, uploadArbitraryFile)
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.Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>), (==), (<<<), not)
import Gargantext.Routes (AppRoute)
import Gargantext.Routes as GR
import Gargantext.Sessions (OpenNodes, Session, mkNodeId, get)
......@@ -58,63 +59,75 @@ type Props = (
| CommonProps
)
treeView :: Record Props -> R.Element
treeView props = R.createElement treeViewCpt props []
treeView :: R2.Component Props
treeView = R.createElement elCpt
where
treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponentWithModule thisModule "treeView" cpt
where
cpt { asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload
, root
, session
} _children = do
pure $ treeLoadView { asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload
, root
, session
}
treeLoadView :: Record Props -> R.Element
treeLoadView p = R.createElement treeLoadViewCpt p []
elCpt :: R.Component Props
elCpt = R.hooksComponentWithModule thisModule "treeView" cpt
cpt { asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload
, root
, session
} _children = do
pure $ treeLoadView { asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload
, root
, session
} []
treeLoadView :: R2.Component Props
treeLoadView = R.createElement elCpt
where
treeLoadViewCpt :: R.Component Props
treeLoadViewCpt = R.hooksComponentWithModule thisModule "treeLoadView" cpt
where
cpt { asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload
, root
, session
} _children = do
let fetch _ = getNodeTree session root
let paint loaded = loadedTreeView { asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload
, session
-- , tasks: tasksStruct root asyncTasks reload
, tree: loaded
}
useLoader { root, counter: fst reload } fetch paint
elCpt :: R.Component Props
elCpt = R.hooksComponentWithModule thisModule "treeLoadView" cpt
cpt { asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload
, root
, session
} _children = do
let fetch _ = getNodeTree session root
-- let paint loaded = loadedTreeView { asyncTasks
-- , frontends
-- , handed
-- , mCurrentRoute
-- , openNodes
-- , reload
-- , session
-- -- , tasks: tasksStruct root asyncTasks reload
-- , tree: loaded
-- } []
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 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 = (
asyncTasks :: GAT.Reductor
......@@ -122,36 +135,67 @@ type TreeViewProps = (
| CommonProps
)
loadedTreeView :: Record TreeViewProps -> R.Element
loadedTreeView p = R.createElement loadedTreeViewCpt p []
loadedTreeView :: R2.Component TreeViewProps
loadedTreeView = R.createElement elCpt
where
loadedTreeViewCpt :: R.Component TreeViewProps
loadedTreeViewCpt = R.hooksComponentWithModule thisModule "loadedTreeView" cpt
where
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" } [
toHtml { asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload
, session
-- , tasks
, tree
}
]
elCpt :: R.Component TreeViewProps
elCpt = R.hooksComponentWithModule thisModule "loadedTreeView" 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" } [
toHtml { asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload
, session
-- , tasks
, 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 = (
| CommonProps
)
toHtml :: Record ToHtmlProps -> R.Element
toHtml p = R.createElement toHtmlCpt p []
toHtmlCpt :: R.Component ToHtmlProps
toHtmlCpt = R.hooksComponentWithModule thisModule "nodeView" cpt
where
cpt p@{ asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload: reload@(_ /\ setReload)
, session
, tree: tree@(NTree (LNode { id
, name
, nodeType
}
) ary
)
} _ = do
let commonProps = RecordE.pick p :: Record CommonProps
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" } $
[ nodeMainSpan { appReload: reload
, asyncTasks
, dispatch: pAction
, folderOpen
, frontends
, handed
, id
, isLeaf: A.null ary
, mCurrentRoute
, name
, nodeType
, session
-- , tasks
} ]
<> childNodes ( Record.merge commonProps
toHtml :: R2.Component ToHtmlProps
toHtml = R.createElement elCpt
where
elCpt :: R.Component ToHtmlProps
elCpt = R.hooksComponentWithModule thisModule "toHtml" cpt
cpt p@{ asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload: reload@(_ /\ setReload)
, session
, tree: tree@(NTree (LNode { id
, name
, nodeType
}
) ary
)
} _ = do
let commonProps = RecordE.pick p :: Record CommonProps
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'
let publicizedChildren = if isPublic nodeType
then map (\t -> map (\(LNode n@{ nodeType: nt } )
-> (LNode (n { nodeType = publicize nt }))
) t) ary
else ary
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
}
(
childNodes ( 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
, children: publicizedChildren
, folderOpen
, 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 =
......@@ -239,13 +369,79 @@ childNodes props@{ asyncTasks, children, reload, handed } =
-- , tasks: tasksStruct id asyncTasks reload
, tree: ctree
}
)]
) []
]
) $ sorted children
where
commonProps = RecordE.pick props :: Record CommonProps
sorted :: Array FTree -> Array FTree
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 =
( asyncTasks :: GAT.Reductor
, openNodes :: R.State OpenNodes
......
src/Gargantext/Components/Forest/Tree/Node.purs
View file @ 76d88cea
......@@ -56,9 +56,17 @@ type NodeMainSpanProps = (
type IsLeaf = Boolean
nodeMainSpan :: Record NodeMainSpanProps
-> R.Element
nodeMainSpan p = R.createElement nodeMainSpanCpt p []
nodeSpan :: R2.Component NodeMainSpanProps
nodeSpan = R.createElement nodeSpanCpt
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.hooksComponentWithModule thisModule "nodeMainSpan" cpt
......@@ -155,20 +163,17 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
, session
}
chevronIcon isLeaf handed' nodeType (open /\ setOpen) =
if isLeaf
then H.div {} []
else
H.a { className: "chevron-icon"
, on: { click: \_ -> setOpen $ not }
}
[ H.i {
className: if open
then "fa fa-chevron-down"
else if handed' == GT.RightHanded
then "fa fa-chevron-right"
else "fa fa-chevron-left"
} [] ]
chevronIcon true handed' nodeType (open /\ setOpen) = H.div {} []
chevronIcon false handed' nodeType (open /\ setOpen) =
H.a { className: "chevron-icon"
, on: { click: \_ -> setOpen $ not }
}
[ H.i { className: if open
then "fa fa-chevron-down"
else if handed' == GT.RightHanded
then "fa fa-chevron-right"
else "fa fa-chevron-left"
} [] ]
folderIcon nodeType (open /\ setOpen) =
H.a { className: "folder-icon"
......
src/Gargantext/Ends.purs
View file @ 76d88cea
......@@ -172,6 +172,8 @@ sessionPath (R.PostNgramsChartsAsync i) =
sessionPath (R.NodeAPI nt i p) = nodeTypePath nt
<> (maybe "" (\i' -> "/" <> show i') i)
<> (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.NodeAPI Corpus Nothing
$ "search?list_id=" <> show listId
......
src/Gargantext/Routes.purs
View file @ 76d88cea
......@@ -50,6 +50,7 @@ data SessionRoute
| RecomputeNgrams (TabSubType CTabNgramType) Id ListId
| RecomputeListChart ChartType CTabNgramType Id ListId
| NodeAPI NodeType (Maybe Id) String
| TreeFirstLevel (Maybe Id) String
| GraphAPI Id String
| ListsRoute ListId
| 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