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

import DOM.Simple.Console (log2)
4
import Data.Array as A
5
import Data.Maybe (Maybe)
6 7
import Data.Set as Set
import Data.Tuple (Tuple(..), fst, snd)
8
import Data.Tuple.Nested ((/\))
9
import Effect.Aff (Aff)
10
import Effect.Class (liftEffect)
11
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), CreateValue(..), FTree, ID, LNode(..), NTree(..), Reload, RenameValue(..), Tree, createNode, deleteNode, loadNode, renameNode)
12 13
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan)
14
import Gargantext.Ends (Frontends)
15
import Gargantext.Hooks.Loader (useLoader)
16
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, void, ($), (+), (/=), (<>))
17
import Gargantext.Routes (AppRoute)
18
import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
19
import Gargantext.Types as GT
20 21
import Reactix as R
import Reactix.DOM.HTML as H
22

23
------------------------------------------------------------------------
24
type Props = ( root          :: ID
25
             , mCurrentRoute :: Maybe AppRoute
26 27
             , session       :: Session
             , frontends     :: Frontends
28
             , openNodes     :: R.State OpenNodes
29
             , reload        :: R.State Reload
30
             )
31

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

treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
  where
38
    cpt { root, mCurrentRoute, session, frontends, openNodes, reload } _children = do
39 40
      pure $ treeLoadView
        { root, mCurrentRoute, session, frontends, openNodes, reload }
41 42 43 44 45

type Props' = ( root          :: ID
              , mCurrentRoute :: Maybe AppRoute
              , session       :: Session
              , frontends     :: Frontends
46
              , openNodes     :: R.State OpenNodes
Alexandre Delanoë's avatar
Alexandre Delanoë committed
47
              , reload        :: R.State Reload
48 49
              )

50 51 52 53
treeLoadView :: Record Props' -> R.Element
treeLoadView p = R.createElement treeLoadView' p []

treeLoadView' :: R.Component Props'
54
treeLoadView' = R.hooksComponent "TreeLoadView" cpt
55
  where
56
    cpt {root, mCurrentRoute, session, frontends, openNodes, reload} _ = do
57 58 59
      let fetch _ = loadNode session root
      let paint loaded = loadedTreeView {tree: loaded, mCurrentRoute, session, frontends, openNodes, reload}
      useLoader {root, counter: fst reload} fetch paint
60

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

69 70 71 72 73 74

loadedTreeView :: Record TreeViewProps -> R.Element
loadedTreeView p = R.createElement loadedTreeView' p []

loadedTreeView' :: R.Component TreeViewProps
loadedTreeView' = R.hooksComponent "LoadedTreeView" cpt
75
  where
76
    cpt {tree, mCurrentRoute, session, frontends, openNodes, reload} _ = do
77
      tasks <- R.useState' []
78 79

      pure $ H.div {className: "tree"}
80
        [ toHtml reload tree tasks session frontends mCurrentRoute openNodes ]
81

82
------------------------------------------------------------------------
83
toHtml :: R.State Reload
84 85
       -> FTree
       -> R.State (Array GT.AsyncTaskWithType)
86 87 88
       -> Session
       -> Frontends
       -> Maybe AppRoute
89
       -> R.State OpenNodes
90
       -> R.Element
91
toHtml reload@(_ /\ setReload) tree@(NTree (LNode {id, name, nodeType}) ary) tasks@(asyncTasks /\ setAsyncTasks) session frontends mCurrentRoute openNodes = R.createElement el {} []
92 93
  where
    el = R.hooksComponent "NodeView" cpt
94
    pAction = performAction session tree reload openNodes tasks
95

96
    cpt props _ = do
97 98
      let nodeId = mkNodeId session id
      let folderIsOpen = Set.member nodeId (fst openNodes)
99
      let setFn = if folderIsOpen then Set.delete else Set.insert
100
      let toggleFolderIsOpen _ = (snd openNodes) (setFn nodeId)
101
      let folderOpen = Tuple folderIsOpen toggleFolderIsOpen
102 103 104 105 106

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

      pure $ H.ul {}
        [ H.li {}
107 108 109 110 111 112 113
          ( [ nodeMainSpan pAction { id
                                   , asyncTasks
                                   , mCurrentRoute
                                   , name
                                   , nodeType
                                   , onAsyncTaskFinish
                                   } folderOpen session frontends ]
114
            <> childNodes session frontends reload folderOpen mCurrentRoute openNodes ary
115 116 117
          )
        ]

118 119 120
    onAsyncTaskFinish (GT.AsyncTaskWithType {task: GT.AsyncTask {id: id'}}) = do
      setAsyncTasks $ const newAsyncTasks
      setReload (_ + 1)
121
      where
122
        newAsyncTasks = A.filter (\(GT.AsyncTaskWithType {task: GT.AsyncTask {id: id''}}) -> id' /= id'') asyncTasks
123

124

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

147
performAction :: Session
148
              -> FTree
149
              -> R.State Int
150
              -> R.State OpenNodes
151
              -> R.State (Array GT.AsyncTaskWithType)
152 153
              -> Action
              -> Aff Unit
154
performAction session (NTree (LNode {id}) _) (_ /\ setReload) (_ /\ setOpenNodes) _ DeleteNode = do
155
  void $ deleteNode session id
156
  liftEffect do
157
    setOpenNodes (Set.delete (mkNodeId session id))
158
    setReload (_ + 1)
159

160 161
performAction session (NTree (LNode {id}) _) (_ /\ setReload) _ (_ /\ setAsyncTasks) (SearchQuery task) = do
  liftEffect $ setAsyncTasks $ A.cons task
162
  liftEffect $ log2 "[performAction] SearchQuery task:" task
Alexandre Delanoë's avatar
Alexandre Delanoë committed
163
  liftEffect $ setReload (_ + 1)
164

165
performAction session (NTree (LNode {id}) _) (_ /\ setReload) _ _ (Submit name)  = do
166
  void $ renameNode session id $ RenameValue {name}
167 168
  liftEffect do
    setReload (_ + 1)
169

170
performAction session (NTree (LNode {id}) _) (_ /\ setReload) (_ /\ setOpenNodes) _ (CreateSubmit name nodeType) = do
171
  void $ createNode session id $ CreateValue {name, nodeType}
172
  liftEffect do
173
    setOpenNodes (Set.insert (mkNodeId session id))
174
    setReload (_ + 1)
175

176 177
performAction session (NTree (LNode {id}) _) _ _ (_ /\ setAsyncTasks) (UploadFile nodeType fileType contents) = do
  task <- uploadFile session nodeType id fileType contents
178
  liftEffect $ setAsyncTasks $ A.cons task
179
  liftEffect $ log2 "uploaded, task:" task