Tree.purs 6.24 KB
Newer Older
1 2
module Gargantext.Components.Forest.Tree where

3 4 5
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Prelude

6
import DOM.Simple.Console (log2)
7
import Data.Array as A
8
import Data.Maybe (Maybe)
9 10 11
import Data.Set (Set)
import Data.Set as Set
import Data.Tuple (Tuple(..), fst, snd)
12
import Data.Tuple.Nested ((/\))
13
import Effect.Aff (Aff)
14
import Effect.Class (liftEffect)
15 16
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan)
17
import Gargantext.Components.Loader (loader)
18 19
import Gargantext.Components.Login.Types (TreeId)
import Gargantext.Ends (Frontends)
20 21
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session)
22
import Gargantext.Types (AsyncTask(..))
23 24 25
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
26

27
------------------------------------------------------------------------
28
type Props = ( root          :: ID
29
             , mCurrentRoute :: Maybe AppRoute
30 31
             , session       :: Session
             , frontends     :: Frontends
32
             )
33

34 35 36 37 38 39
treeView :: Record Props -> R.Element
treeView props = R.createElement treeViewCpt props []

treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
  where
40
    cpt { root, mCurrentRoute, session, frontends } _children = do
41 42
      -- NOTE: this is a hack to reload the tree view on demand
      reload <- R.useState' (0 :: Reload)
43 44 45 46 47 48 49 50 51 52 53 54
      openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: Set TreeId)
      pure $ treeLoadView reload
        { root, mCurrentRoute, session, frontends, openNodes }

type Props' = ( root          :: ID
              , mCurrentRoute :: Maybe AppRoute
              , session       :: Session
              , frontends     :: Frontends
              , openNodes     :: R.State (Set TreeId)
              )

treeLoadView :: R.State Reload -> Record Props' -> R.Element
55 56
treeLoadView reload p = R.createElement el p []
  where
57
    el = R.staticComponent "TreeLoadView" cpt
58
    cpt {root, mCurrentRoute, session, frontends, openNodes} _ = do
59
      loader root (loadNode session) $ \loaded ->
60
        loadedTreeView reload {tree: loaded, mCurrentRoute, session, frontends, openNodes}
61

62 63 64 65
type TreeViewProps = ( tree          :: FTree
                     , mCurrentRoute :: Maybe AppRoute
                     , frontends     :: Frontends
                     , session       :: Session 
66
                     , openNodes     :: R.State (Set TreeId)
67 68
                     )

69 70 71 72
loadedTreeView :: R.State Reload -> Record TreeViewProps -> R.Element
loadedTreeView reload p = R.createElement el p []
  where
    el = R.hooksComponent "LoadedTreeView" cpt
73
    cpt {tree, mCurrentRoute, session, frontends, openNodes} _ = do
74
      treeState <- R.useState' {tree, asyncTasks: []}
75 76

      pure $ H.div {className: "tree"}
77
        [ toHtml reload treeState session frontends mCurrentRoute openNodes ]
78

79
------------------------------------------------------------------------
80 81 82 83 84
toHtml :: R.State Reload
       -> R.State Tree
       -> Session
       -> Frontends
       -> Maybe AppRoute
85
       -> R.State (Set TreeId)
86
       -> R.Element
87
toHtml reload treeState@(ts@{tree: (NTree (LNode {id, name, nodeType}) ary), asyncTasks} /\ setTreeState) session frontends mCurrentRoute openNodes = R.createElement el {} []
88 89 90
  where
    el = R.hooksComponent "NodeView" cpt
    pAction = performAction session reload treeState
91

92
    cpt props _ = do
93 94 95 96
      let folderIsOpen = Set.member id (fst openNodes)
      let setFn = if folderIsOpen then Set.delete else Set.insert
      let toggleFolderIsOpen _ = (snd openNodes) (setFn id)
      let folderOpen = Tuple folderIsOpen toggleFolderIsOpen
97 98 99 100 101

      let withId (NTree (LNode {id: id'}) _) = id'

      pure $ H.ul {}
        [ H.li {}
102 103 104 105 106 107 108
          ( [ nodeMainSpan pAction { id
                                   , asyncTasks
                                   , mCurrentRoute
                                   , name
                                   , nodeType
                                   , onAsyncTaskFinish
                                   } folderOpen session frontends ]
109
            <> childNodes session frontends reload folderOpen mCurrentRoute openNodes ary
110 111 112
          )
        ]

113 114 115 116
    onAsyncTaskFinish (AsyncTask {id}) = setTreeState $ const $ ts { asyncTasks = newAsyncTasks }
      where
        newAsyncTasks = A.filter (\(AsyncTask {id: id'}) -> id /= id') asyncTasks

117

118 119 120 121 122
childNodes :: Session
           -> Frontends
           -> R.State Reload
           -> R.State Boolean
           -> Maybe AppRoute
123
           -> R.State (Set TreeId)
124 125
           -> Array FTree
           -> Array R.Element
126 127 128
childNodes _ _ _ _ _ _ [] = []
childNodes _ _ _ (false /\ _) _ _ _ = []
childNodes session frontends reload (true /\ _) mCurrentRoute openNodes ary =
129
  map (\ctree -> childNode {tree: ctree, asyncTasks: []}) $ sorted ary
130
    where
131
      sorted :: Array FTree -> Array FTree
132
      sorted = A.sortWith (\(NTree (LNode {id}) _) -> id)
133 134 135
      childNode :: Tree -> R.Element
      childNode props = R.createElement el props []
      el = R.hooksComponent "ChildNodeView" cpt
136 137
      cpt {tree, asyncTasks} _ = do
        treeState <- R.useState' {tree, asyncTasks}
138
        pure $ toHtml reload treeState session frontends mCurrentRoute openNodes
139

140 141 142 143 144
performAction :: Session
              -> R.State Int
              -> R.State Tree
              -> Action
              -> Aff Unit
145 146 147
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) DeleteNode = do
  void $ deleteNode session id
  liftEffect $ setReload (_ + 1)
148

149 150 151
performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (Submit name)  = do
  void $ renameNode session id $ RenameValue {name}
  liftEffect $ setTree $ \s@{tree: NTree (LNode node) arr} -> s {tree = NTree (LNode node {name = name}) arr}
152

153 154 155
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do
  void $ createNode session id $ CreateValue {name, nodeType}
  liftEffect $ setReload (_ + 1)
156

157 158 159 160
performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (UploadFile fileType contents) = do
  task <- uploadFile session id fileType contents
  liftEffect $ setTree $ \t@{asyncTasks} -> t { asyncTasks = A.cons task asyncTasks }
  liftEffect $ log2 "uploaded, task:" task