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

3
import Data.Array as A
4 5
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe)
6 7
import Data.Set as Set
import Data.Tuple (Tuple(..), fst, snd)
8
import Data.Tuple.Nested ((/\))
9 10
import DOM.Simple.Console (log2)
import Effect (Effect)
11
import Effect.Aff (Aff)
12
import Effect.Class (liftEffect)
13 14 15 16 17
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE

18
import Gargantext.AsyncTasks as GAT
19 20
import Gargantext.Components.Forest.Tree.Node.Action (Action(..),deleteNode)
import Gargantext.Components.Forest.Tree.Node.Action.CopyFrom (loadNode)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
21
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
22
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
23
import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename)
24
import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan, Tasks, tasksStruct)
25
import Gargantext.Components.Forest.Tree.Node.FTree (FTree, LNode(..), NTree(..), Tree)
26
import Gargantext.Ends (Frontends)
27
import Gargantext.Hooks.Loader (useLoader)
28
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, void, ($), (+), (/=), (<>), identity)
29
import Gargantext.Routes (AppRoute)
30
import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
31
import Gargantext.Types as GT
32
import Gargantext.Types (ID, Reload)
33

34 35
------------------------------------------------------------------------

36
type CommonProps =
37 38 39 40 41
  ( frontends     :: Frontends
  , mCurrentRoute :: Maybe AppRoute
  , openNodes     :: R.State OpenNodes
  , reload        :: R.State Reload
  , session       :: Session
42 43
  )

44
------------------------------------------------------------------------
45
type Props = ( root          :: ID
46
             , asyncTasks    :: R.State GAT.Storage
47
             | CommonProps
48
             )
49

50 51 52
treeView :: Record Props -> R.Element
treeView props = R.createElement treeViewCpt props []
  where
53 54 55
    treeViewCpt :: R.Component Props
    treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
      where
56
        cpt { root, mCurrentRoute, session, frontends, openNodes, reload, asyncTasks} _children = do
57
          pure $ treeLoadView
58
            { root, mCurrentRoute, session, frontends, openNodes, reload, asyncTasks}
59

60
treeLoadView :: Record Props -> R.Element
61
treeLoadView p = R.createElement treeLoadViewCpt p []
62
  where
63 64 65
    treeLoadViewCpt :: R.Component Props
    treeLoadViewCpt = R.hooksComponent "TreeLoadView" cpt
      where
Alexandre Delanoë's avatar
Alexandre Delanoë committed
66
        cpt { root, asyncTasks, mCurrentRoute, session, frontends, openNodes, reload } _children = do
67
          let fetch _ = loadNode session root
Alexandre Delanoë's avatar
Alexandre Delanoë committed
68 69 70
          let paint loaded = loadedTreeView {
                                              asyncTasks
                                            , frontends
71
                                            , mCurrentRoute
Alexandre Delanoë's avatar
Alexandre Delanoë committed
72 73
                                            , openNodes
                                            , reload
74
                                            , session
Alexandre Delanoë's avatar
Alexandre Delanoë committed
75 76
                                            , tasks: tasksStruct root asyncTasks reload
                                            , tree: loaded
77
                                            }
Alexandre Delanoë's avatar
Alexandre Delanoë committed
78
          useLoader { root, counter: fst reload } fetch paint
79

80 81 82
type TreeViewProps = ( asyncTasks    :: R.State GAT.Storage
                     , tree          :: FTree
                     , tasks         :: Record Tasks
83
                     | CommonProps
84 85
                     )

86
loadedTreeView :: Record TreeViewProps -> R.Element
87
loadedTreeView p = R.createElement loadedTreeViewCpt p []
88
  where
89 90 91
    loadedTreeViewCpt :: R.Component TreeViewProps
    loadedTreeViewCpt = R.hooksComponent "LoadedTreeView" cpt
      where
Alexandre Delanoë's avatar
Alexandre Delanoë committed
92
        cpt { asyncTasks, frontends, mCurrentRoute, openNodes, reload, tasks, tree, session } _ = do
93
          pure $ H.div {className: "tree"}
Alexandre Delanoë's avatar
Alexandre Delanoë committed
94
            [ toHtml { asyncTasks, frontends, mCurrentRoute, openNodes, reload, session, tasks, tree } ]
95

96
------------------------------------------------------------------------
97 98
type ToHtmlProps =
  (
99 100
    asyncTasks :: R.State GAT.Storage
  , tasks :: Record Tasks
101
  , tree :: FTree
102
  | CommonProps
103 104 105
  )

toHtml :: Record ToHtmlProps -> R.Element
106 107
toHtml p@{ asyncTasks
         , frontends
108 109 110 111
         , mCurrentRoute
         , openNodes
         , reload: reload@(_ /\ setReload)
         , session
112
         , tasks: tasks@{ onTaskAdd, onTaskFinish, tasks: tasks' }
113
         , tree: tree@(NTree (LNode {id, name, nodeType}) ary) } = R.createElement el {} []
114
  where
115
    el          = R.hooksComponent "NodeView" cpt
116
    commonProps = RecordE.pick p :: Record CommonProps
117
    pAction     = performAction (RecordE.pick p :: Record PerformActionProps)
118

119
    cpt _ _ = do
120 121 122
      let nodeId               = mkNodeId session id
      let folderIsOpen         = Set.member nodeId (fst openNodes)
      let setFn                = if folderIsOpen then Set.delete else Set.insert
123
      let toggleFolderIsOpen _ = (snd openNodes) (setFn nodeId)
124
      let folderOpen           = Tuple folderIsOpen toggleFolderIsOpen
125 126 127 128 129

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

      pure $ H.ul {}
        [ H.li {}
130 131 132 133 134 135 136 137
          ( [ nodeMainSpan { id
                           , dispatch: pAction
                           , folderOpen
                           , frontends
                           , mCurrentRoute
                           , name
                           , nodeType
                           , session
138
                           , tasks
139
                           } ]
140
            <> childNodes (Record.merge commonProps
141 142
                                        { asyncTasks
                                        , children: ary
143
                                        , folderOpen })
144 145 146
          )
        ]

147

148
type ChildNodesProps =
Alexandre Delanoë's avatar
Alexandre Delanoë committed
149 150
  ( asyncTasks :: R.State GAT.Storage
  , children :: Array FTree
151 152
  , folderOpen :: R.State Boolean
  | CommonProps
153 154 155 156 157
  )

childNodes :: Record ChildNodesProps -> Array R.Element
childNodes { children: [] } = []
childNodes { folderOpen: (false /\ _) } = []
158 159 160 161 162 163 164 165 166 167 168
childNodes props@{ asyncTasks, children, reload } =
  map (\ctree@(NTree (LNode {id}) _) ->
        toHtml (Record.merge commonProps {
                     asyncTasks
                   , 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)
169 170 171

type PerformActionProps =
  ( openNodes :: R.State OpenNodes
172 173
  , reload    :: R.State Reload
  , session   :: Session
174
  , tasks     :: Record Tasks
175
  , tree      :: FTree
176
  )
177

178
performAction :: Record PerformActionProps
179 180
              -> Action
              -> Aff Unit
181 182 183 184
performAction p@{ openNodes: (_ /\ setOpenNodes)
                , reload: (_ /\ setReload)
                , session
                , tree: (NTree (LNode {id}) _) } DeleteNode = do
185
  void $ deleteNode session id
186
  liftEffect do
187
    setOpenNodes (Set.delete (mkNodeId session id))
188
  performAction p RefreshTree
189

190 191
performAction { reload: (_ /\ setReload)
              , session
192
              , tasks: { onTaskAdd }
193
              , tree: (NTree (LNode {id}) _) } (SearchQuery task) = do
194
  liftEffect $ onTaskAdd task
195
  liftEffect $ log2 "[performAction] SearchQuery task:" task
196

197 198
performAction { reload: (_ /\ setReload)
              , session
199
              , tasks: {onTaskAdd}
200
              , tree: (NTree (LNode {id}) _) } (UpdateNode task) = do
201
  liftEffect $ onTaskAdd task
202 203
  liftEffect $ log2 "[performAction] UpdateNode task:" task

204

205 206
performAction p@{ reload: (_ /\ setReload)
                , session
207
                , tree: (NTree (LNode {id}) _) } (RenameNode name)  = do
208
  void $ rename session id $ RenameValue {text:name}
209
  performAction p RefreshTree
210

211
performAction p@{ openNodes: (_ /\ setOpenNodes)
212
                , reload:    (_ /\ setReload)
213
                , session
214
                , tree: (NTree (LNode {id}) _) } (AddNode name nodeType) = do
215
  task <- addNode session id $ AddNodeValue {name, nodeType}
216
  liftEffect do
217
    setOpenNodes (Set.insert (mkNodeId session id))
218
  performAction p RefreshTree
219

220
performAction { session
221
              , tasks: { onTaskAdd }
222
              , tree: (NTree (LNode {id}) _) } (UploadFile nodeType fileType mName contents) = do
223
  task <- uploadFile session nodeType id fileType {mName, contents}
224
  liftEffect $ onTaskAdd task
225
  liftEffect $ log2 "uploaded, task:" task
226 227 228

performAction { reload: (_ /\ setReload) } RefreshTree = do
  liftEffect $ setReload (_ + 1)