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