Commit fed2ce30 authored by James Laver's avatar James Laver

fix tree errors, but forest i'm not sure i understood with the ratchet reloader setup

parent 3e5bb00b
module Gargantext.Components.Forest
( forest, forestLayout, forestLayoutWithTopBar
, forestLayoutMain, forestLayoutRaw, mainLayout
, forestLayoutMain, forestLayoutRaw
) where
import Data.Array as A
......@@ -10,16 +10,17 @@ import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
import Record.Extra as RX
import Toestand as T
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree (treeView)
import Gargantext.Components.Forest.Tree (treeLoader)
import Gargantext.Components.TopBar (topBar)
import Gargantext.Ends (Frontends, Backend)
import Gargantext.Prelude
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions)
import Gargantext.Types (Handed(..), reverseHanded)
import Gargantext.Types (Handed(..), reverseHanded, switchHanded)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
import Gargantext.Utils.Toestand as T2
......@@ -27,28 +28,37 @@ import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest"
type Props =
-- Shared by components here with Tree
type Common =
( tasks :: R.Ref (Maybe GAT.Reductor)
, route :: AppRoute
, frontends :: Frontends
, backend :: T.Cursor Backend
, handed :: T.Cursor Handed
, reloadRoot :: T.Cursor T2.Reload
)
type LayoutProps =
( backend :: T.Cursor Backend
, sessions :: T.Cursor Session
, showLogin :: T.Cursor Boolean
, forestOpen :: T.Cursor OpenNodes
, reloadForest :: T.Cursor T2.Reload
, reloadRoot :: T.Cursor T2.Reload
| Common
)
type Props = ( forestOpen :: T.Cursor OpenNodes | LayoutProps )
type TreeExtra =
( session :: Session, forestOpen :: T.Cursor OpenNodes )
forest :: R2.Component Props
forest = R.createElement forestCpt
forestCpt :: R.Component Props
forestCpt = here.component "forest" cpt where
cpt { reloadRoot, tasks, backend, route, frontends, handed
cpt props@{ reloadRoot, tasks, backend, route, frontends, handed
, sessions, showLogin, reloadForest } _ = do
-- NOTE: this is a hack to reload the forest on demand
tasks' <- GAT.useTasks reloadRoot reload
tasks' <- GAT.useTasks reloadRoot reloadForest
handed' <- T.useLive T.unequal handed
reloadForest' <- T.useLive T.unequal reloadForest
reloadRoot' <- T.useLive T.unequal reloadRoot
......@@ -59,13 +69,14 @@ forestCpt = here.component "forest" cpt where
R2.useCache
( frontends /\ route /\ sessions /\ handed' /\ fst forestOpen
/\ reloadForest /\ reloadRoot /\ (fst tasks).storage )
cp where
cp _ =
(cp handed') where
common = RX.pick props :: Record Common
cp handed' _ =
pure $ H.div { className: "forest" }
(A.cons (plus handed' showLogin backend) trees)
trees = tree <$> unSessions sessions
tree s@(Session {treeId}) =
treeView { reloadRoot, tasks, route, frontends, handed
treeLoader { reloadRoot, tasks, route, frontends, handed
, forestOpen, reload, root: treeId, session: s } []
plus :: Handed -> R.Setter Boolean -> R.State (Maybe Backend) -> R.Element
......@@ -84,17 +95,6 @@ plus handed showLogin backend = H.div { className: "row" }
buttonClass =
"btn btn-primary col-5 " <> switchHanded "ml-1 mr-auto" "mr-1 ml-auto"
type LayoutProps =
( tasks :: R.Ref (Maybe GAT.Reductor)
, route :: AppRoute
, frontends :: Frontends
, backend :: T.Cursor Backend
, sessions :: T.Cursor Session
, handed :: T.Cursor Handed
, showLogin :: T.Cursor Boolean
, reloadForest :: T.Cursor T2.Reload
, reloadRoot :: T.Cursor T2.Reload
)
forestLayout :: R2.Component LayoutProps
forestLayout props = R.createElement forestLayoutCpt props
......@@ -102,7 +102,8 @@ forestLayout props = R.createElement forestLayoutCpt props
forestLayoutCpt :: R.Component LayoutProps
forestLayoutCpt = here.component "forestLayout" cpt where
cpt props@{ handed } children =
pure $ R.fragment [ topBar { handed } [], forestLayoutMain props children ]
pure $ R.fragment
[ topBar { handed } [], forestLayoutMain props children ]
-- Renders its first child component in the top bar and the rest in
-- the main view.
......@@ -135,8 +136,8 @@ forestLayoutRawCpt = here.component "forestLayoutRaw" cpt where
handed <- T.useLive T.unequal p.handed
pure $ R2.row $ reverseHanded
[ H.div { className: "col-md-2", style: { paddingTop: "60px" } }
(A.cons forest' children) ] where
forest' =
(A.cons (forest' handed) children) ] where
forest' handed =
forest
{ reloadRoot, tasks, backend, route, frontends
, handed, sessions, showLogin, reloadForest } []
......
......@@ -4,11 +4,9 @@ import Gargantext.Prelude
import DOM.Simple.Console (log, log2)
import Data.Array as A
import Data.Maybe (Maybe(..))
import Data.Monoid (guard)
import Data.Set as Set
import Data.Traversable (traverse_, traverse)
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import Data.Tuple (snd)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
......@@ -17,7 +15,6 @@ import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
import Toestand as T
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node (nodeSpan)
......@@ -35,16 +32,15 @@ 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(..), fTreeID )
import Gargantext.Ends (Frontends, toUrl)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (AppRoute)
import Gargantext.Routes as GR
import Gargantext.Sessions (OpenNodes, Session, mkNodeId, get)
import Gargantext.Types (Handed, ID, NodeType, isPublic, publicize, switchHanded)
import Gargantext.Types (Handed, ID, isPublic, publicize, switchHanded)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Gargantext.Utils.Reload as GUR
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree"
......@@ -65,7 +61,7 @@ type Global =
type Common =
( forestOpen :: T.Cursor OpenNodes, reload :: T.Cursor T2.Reload | Global )
type LoaderProps = ( session :: R.Context Session, root :: ID | Common )
type LoaderProps = ( session :: Session, root :: ID | Common )
-- | Loads and renders the tree starting at the given root node id.
treeLoader :: R2.Component LoaderProps
......@@ -73,13 +69,12 @@ treeLoader = R.createElement treeLoaderCpt
treeLoaderCpt :: R.Component LoaderProps
treeLoaderCpt = here.component "treeLoader" cpt where
cpt p@{ root } _ = do
session <- R.useContext p.session
cpt p@{ root, session } _ = do
app <- T.useLive T.unequal p.reloadRoot
reload <- T.useLive T.unequal p.reload
let fetch _ = getNodeTree session root
useLoader { app, root } fetch (loaded session) where
loaded session tree' = tree props [] where
useLoader { app, root } fetch loaded where
loaded tree' = tree props where
props = Record.merge common extra where
common = RecordE.pick p :: Record Common
extra = { tree: tree', reloadTree: p.reload, session }
......@@ -92,8 +87,6 @@ getNodeTreeFirstLevel session nodeId = get session $ GR.TreeFirstLevel (Just nod
type NodeProps = ( reloadTree :: T.Cursor T2.Reload, session :: Session | Common )
nodeProps = RecordE.pick
type TreeProps = ( tree :: FTree | NodeProps )
tree :: R2.Leaf TreeProps
......@@ -108,24 +101,26 @@ treeCpt = here.component "tree" cpt where
pure $ H.ul { className: ulClass }
[ H.div { className: divClass } -- TODO: naughty div should not be in a ul
[ H.li { className: childrenClass children }
[ nodeSpan (nsprops p { folderOpen, name, id, nodeType, setPopoverRef })
[ nodeSpan (nsprops { folderOpen, name, id, nodeType, setPopoverRef, isLeaf })
(renderChildren open) ]]]
where
isLeaf = A.null children
nodeId = mkNodeId session id
ulClass = switchHanded "ml" "mr" p.handed <> "-auto tree"
divClass = switchHanded "left" "right" p.handed <> "handed"
children' = A.sortWith fTreeID (map pub $ guard (isPublic nodeType) children)
children' = A.sortWith fTreeID pubChildren
pubChildren = if isPublic nodeType then map (map pub) children else children
renderChildren false = []
renderChildren true = map renderChild children' where
renderChild (NTree (LNode {id: cId}) _) = childLoader props [] where
props = Record.merge (nodeProps p) { id: cId, render: tree }
nsprops extra = Record.merge common extra where
props = Record.merge nodeProps { id: cId, render: tree }
nodeProps = RecordE.pick p :: Record NodeProps
nsprops extra = Record.merge common extra' where
common = RecordE.pick p :: Record NSCommon
extra' = Record.merge extra { dispatch } where
dispatch a = performAction a (Record.merge common' extra'') where
dispatch a = performAction a (Record.merge common' spr) where
common' = RecordE.pick p :: Record PACommon
extra'' = { isLeaf, setPopoverRef: extra.setPopoverRef }
spr = { setPopoverRef: extra.setPopoverRef }
pub (LNode n@{ nodeType: t }) = LNode (n { nodeType = publicize t })
childrenClass [] = "no-children"
childrenClass _ = "with-children"
......@@ -133,7 +128,7 @@ treeCpt = here.component "tree" cpt where
--- The properties tree shares in common with performAction
type PACommon =
( forestOpen :: T.Cursor OpenNodes
, reloadForest :: T.Cursor T2.Reload
, reloadTree :: T.Cursor T2.Reload
, session :: Session
, tree :: FTree
| Universal )
......@@ -158,9 +153,10 @@ childLoaderCpt = here.component "childLoader" cpt where
useLoader cache fetch (paint reload)
where
fetch _ = getNodeTreeFirstLevel p.session p.id
paint reload tree' = render (Record.merge base extra) [] where
base = (nodeProps p) { reload = reload }
extra = { reloadTree: p.reload }
paint reload tree' = render (Record.merge base extra) where
base = nodeProps { reload = reload }
extra = { tree: tree' }
nodeProps = RecordE.pick p :: Record NodeProps
type PerformActionProps =
( setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit)) | PACommon )
......@@ -228,7 +224,7 @@ performAction (LinkNode { nodeType, params }) p = traverse_ f params where
void $ linkNodeReq p.session nodeType in' out
performAction RefreshTree p
performAction RefreshTree p = do
liftEffect $ T2.reload p.reloadForest
liftEffect $ T2.reload p.reloadTree
performAction ClosePopover p
performAction NoAction _ = liftEffect $ log "[performAction] NoAction"
performAction ClosePopover { setPopoverRef } =
......
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