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

3
import DOM.Simple.Console (log, 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 12 13 14 15
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE

16
import Gargantext.AsyncTasks as GAT
17
import Gargantext.Components.Forest.Tree.Node (nodeMainSpan)
18
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
19
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
Alexandre Delanoë's avatar
Alexandre Delanoë committed
20
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
21
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode, unpublishNode)
22
import Gargantext.Components.Forest.Tree.Node.Action.Move   (moveNodeReq)
23 24
import Gargantext.Components.Forest.Tree.Node.Action.Merge  (mergeNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Link   (linkNodeReq)
25
import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename)
26 27
import Gargantext.Components.Forest.Tree.Node.Action.Share   as Share
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
28
import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
29
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile)
30
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
31
import Gargantext.Components.Forest.Tree.Node.Tools.Task (Tasks, tasksStruct)
32
import Gargantext.Ends (Frontends)
33
import Gargantext.Hooks.Loader (useLoader)
34
import Gargantext.Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>), (==), (<<<), not)
35
import Gargantext.Routes (AppRoute)
36
import Gargantext.Routes as GR
37
import Gargantext.Sessions (OpenNodes, Session, mkNodeId, get)
38
import Gargantext.Types (ID, Reload, isPublic, publicize)
39
import Gargantext.Types as GT
40 41 42
import Gargantext.Utils.Reactix as R2

thisModule = "Gargantext.Components.Forest.Tree"
43

44
------------------------------------------------------------------------
45
type CommonProps =
46 47 48 49 50
  ( frontends     :: Frontends
  , mCurrentRoute :: Maybe AppRoute
  , openNodes     :: R.State OpenNodes
  , reload        :: R.State Reload
  , session       :: Session
51
  , handed        :: GT.Handed
52 53
  )

54
------------------------------------------------------------------------
55 56
type Props = ( root       :: ID
             , asyncTasks :: R.State GAT.Storage
57
             | CommonProps
58
             )
59

60 61 62
treeView :: Record Props -> R.Element
treeView props = R.createElement treeViewCpt props []
  where
63
    treeViewCpt :: R.Component Props
64
    treeViewCpt = R2.hooksComponent thisModule "treeView" cpt
65
      where
Alexandre Delanoë's avatar
Alexandre Delanoë committed
66
        cpt { root
67
            , asyncTasks
Alexandre Delanoë's avatar
Alexandre Delanoë committed
68
            , frontends
69
            , handed
70
            , mCurrentRoute
Alexandre Delanoë's avatar
Alexandre Delanoë committed
71 72
            , openNodes
            , reload
73
            , session
74 75
            } _children = pure
                        $ treeLoadView { root
76
                                       , asyncTasks
77
                                       , frontends
78
                                       , handed
79
                                       , mCurrentRoute
80 81
                                       , openNodes
                                       , reload
82
                                       , session
83
                                       }
84

85
treeLoadView :: Record Props -> R.Element
86
treeLoadView p = R.createElement treeLoadViewCpt p []
87
  where
88
    treeLoadViewCpt :: R.Component Props
89
    treeLoadViewCpt = R2.hooksComponent thisModule "treeLoadView" cpt
90
      where
Alexandre Delanoë's avatar
Alexandre Delanoë committed
91 92 93
        cpt { root
            , asyncTasks
            , frontends
94
            , handed
95
            , mCurrentRoute
Alexandre Delanoë's avatar
Alexandre Delanoë committed
96 97
            , openNodes
            , reload
98
            , session
Alexandre Delanoë's avatar
Alexandre Delanoë committed
99
            } _children = do
100
          let fetch _ = getNodeTree session root
101
          let paint loaded = loadedTreeView { asyncTasks
Alexandre Delanoë's avatar
Alexandre Delanoë committed
102
                                            , frontends
103
                                            , handed
104
                                            , mCurrentRoute
Alexandre Delanoë's avatar
Alexandre Delanoë committed
105 106
                                            , openNodes
                                            , reload
107
                                            , session
Alexandre Delanoë's avatar
Alexandre Delanoë committed
108 109
                                            , tasks: tasksStruct root asyncTasks reload
                                            , tree: loaded
110
                                            }
Alexandre Delanoë's avatar
Alexandre Delanoë committed
111
          useLoader { root, counter: fst reload } fetch paint
112

113 114 115 116 117
--------------
getNodeTree :: Session -> GT.ID -> Aff FTree
getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""

--------------
118 119 120
type TreeViewProps = ( asyncTasks :: R.State GAT.Storage
                     , tree       :: FTree
                     , tasks      :: Record Tasks
121
                     | CommonProps
122 123
                     )

124
loadedTreeView :: Record TreeViewProps -> R.Element
125
loadedTreeView p = R.createElement loadedTreeViewCpt p []
126
  where
127
    loadedTreeViewCpt :: R.Component TreeViewProps
128
    loadedTreeViewCpt = R2.hooksComponent thisModule "loadedTreeView" cpt
129
      where
Alexandre Delanoë's avatar
Alexandre Delanoë committed
130 131
        cpt { asyncTasks
            , frontends
132
            , handed
Alexandre Delanoë's avatar
Alexandre Delanoë committed
133 134 135
            , mCurrentRoute
            , openNodes
            , reload
136
            , session
Alexandre Delanoë's avatar
Alexandre Delanoë committed
137 138
            , tasks
            , tree
139 140
          } _ = pure $ H.ul { className: "tree"
                            }
141 142 143 144 145 146 147 148 149 150 151 152 153 154 155
                             [ H.div { className: if handed == GT.RightHanded
                                                    then "righthanded"
                                                    else "lefthanded"
                                     }
                                     [ toHtml { asyncTasks
                                              , frontends
                                              , handed
                                              , mCurrentRoute
                                              , openNodes
                                              , reload
                                              , session
                                              , tasks
                                              , tree
                                              }
                                     ]
Alexandre Delanoë's avatar
Alexandre Delanoë committed
156
                             ]
157

158
------------------------------------------------------------------------
159 160


161
type ToHtmlProps =
162
  ( asyncTasks :: R.State GAT.Storage
163 164
  , tasks      :: Record Tasks
  , tree       :: FTree
165
  | CommonProps
166 167 168
  )

toHtml :: Record ToHtmlProps -> R.Element
169 170
toHtml p@{ asyncTasks
         , frontends
171 172 173 174
         , mCurrentRoute
         , openNodes
         , reload: reload@(_ /\ setReload)
         , session
Alexandre Delanoë's avatar
Alexandre Delanoë committed
175 176 177 178 179 180 181 182 183
         , tasks: tasks@{ onTaskAdd
                        , onTaskFinish
                        , tasks: tasks'
                        }
         , tree: tree@(NTree (LNode { id
                                    , name
                                    , nodeType
                                    }
                              ) ary
184 185
                      )
         , handed
Alexandre Delanoë's avatar
Alexandre Delanoë committed
186 187 188
         } =
  R.createElement el {} []
    where
189
      el          = R2.hooksComponent thisModule "nodeView" cpt
Alexandre Delanoë's avatar
Alexandre Delanoë committed
190 191 192 193 194 195 196 197 198 199 200 201
      commonProps = RecordE.pick p :: Record CommonProps
      pAction a   = performAction a (RecordE.pick p :: Record PerformActionProps)

      cpt _ _ = do
        let nodeId               = mkNodeId session id
        let folderIsOpen         = Set.member nodeId (fst openNodes)
        let setFn                = if folderIsOpen then Set.delete else Set.insert
        let toggleFolderIsOpen _ = (snd openNodes) (setFn nodeId)
        let folderOpen           = Tuple folderIsOpen toggleFolderIsOpen

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

202
        pure $ H.li { className: if A.null ary then "no-children" else "with-children" } $
203
          [ nodeMainSpan (A.null ary) 
204
                         { id
205 206 207
                         , dispatch: pAction
                         , folderOpen
                         , frontends
208
                         , handed
209 210 211 212 213 214 215 216
                         , mCurrentRoute
                         , name
                         , nodeType
                         , session
                         , tasks
                         } ]
          <> childNodes ( Record.merge commonProps
                          { asyncTasks
217
                          , children: if isPublic nodeType
218 219 220
                                         then map (\t -> map (\(LNode n@{ nodeType:nt } )
                                                               -> (LNode (n { nodeType= publicize nt }))
                                                            ) t) ary
221
                                         else ary
222
                          , folderOpen
223
                          , handed
224 225
                          }
                        )
226

227

228
type ChildNodesProps =
Alexandre Delanoë's avatar
Alexandre Delanoë committed
229
  ( asyncTasks :: R.State GAT.Storage
230
  , children   :: Array FTree
231 232
  , folderOpen :: R.State Boolean
  | CommonProps
233 234 235
  )

childNodes :: Record ChildNodesProps -> Array R.Element
236 237
childNodes { children: []                       } = []
childNodes { folderOpen: (false /\ _)           } = []
238
childNodes props@{ asyncTasks, children, reload, handed } =
239
  map (\ctree@(NTree (LNode {id}) _) -> H.ul {} [
Alexandre Delanoë's avatar
Alexandre Delanoë committed
240
        toHtml (Record.merge commonProps { asyncTasks
241
                                         , handed
Alexandre Delanoë's avatar
Alexandre Delanoë committed
242 243 244
                                         , tasks: tasksStruct id asyncTasks reload
                                         , tree: ctree
                                         }
245
               )]
Alexandre Delanoë's avatar
Alexandre Delanoë committed
246
      ) $ sorted children
247 248 249 250
  where
    commonProps = RecordE.pick props :: Record CommonProps
    sorted :: Array FTree -> Array FTree
    sorted = A.sortWith (\(NTree (LNode {id}) _) -> id)
251 252 253

type PerformActionProps =
  ( openNodes :: R.State OpenNodes
254 255
  , reload    :: R.State Reload
  , session   :: Session
256
  , tasks     :: Record Tasks
257
  , tree      :: FTree
258
  )
259

Alexandre Delanoë's avatar
Alexandre Delanoë committed
260
-------
261 262
performAction :: Action
              -> Record PerformActionProps
263
              -> Aff Unit
264
performAction (DeleteNode nt) p@{ openNodes: (_ /\ setOpenNodes)
265 266
                           , reload: (_ /\ setReload)
                           , session
267
                           , tree: (NTree (LNode {id, parent_id}) _)
268 269
                           } =
  do
270 271 272 273 274
    case nt of
         GT.NodePublic GT.FolderPublic -> void $ deleteNode session nt id
         GT.NodePublic _               -> void $ unpublishNode session parent_id id
         _                             -> void $ deleteNode session nt id

275
    liftEffect $ setOpenNodes (Set.delete (mkNodeId session id))
276 277
    performAction RefreshTree p

Alexandre Delanoë's avatar
Alexandre Delanoë committed
278
-------
279 280 281 282 283 284 285 286 287
performAction (DoSearch task) { reload: (_ /\ setReload)
                              , session
                              , tasks: { onTaskAdd }
                              , tree: (NTree (LNode {id}) _)
                              }  =
  do
    liftEffect $ onTaskAdd task
    liftEffect $ log2 "[performAction] DoSearch task:" task

Alexandre Delanoë's avatar
Alexandre Delanoë committed
288
-------
289
performAction (UpdateNode params) { reload: (_ /\ setReload)
290 291 292 293 294
                                , session
                                , tasks: {onTaskAdd}
                                , tree: (NTree (LNode {id}) _)
                                } =
  do
295
    task <- updateRequest params session id
296 297 298
    liftEffect $ onTaskAdd task
    liftEffect $ log2 "[performAction] UpdateNode task:" task

Alexandre Delanoë's avatar
Alexandre Delanoë committed
299 300

-------
301
performAction (RenameNode name) p@{ reload: (_ /\ setReload)
302 303 304
                                  , session
                                  , tree: (NTree (LNode {id}) _)
                                  } =
305 306 307 308
  do
    void $ rename session id $ RenameValue {text:name}
    performAction RefreshTree p

Alexandre Delanoë's avatar
Alexandre Delanoë committed
309
-------
310
performAction (ShareTeam username) p@{ reload: (_ /\ setReload)
311 312 313 314
                                     , session
                                     , tree: (NTree (LNode {id}) _)
                                     } =
  do
315
    void $ Share.shareReq session id $ Share.ShareTeamParams {username}
316

317

318 319 320
performAction (SharePublic {params}) p@{ session
                                       , openNodes: (_ /\ setOpenNodes)
                                       } =
321 322 323 324
  case params of
    Nothing -> performAction NoAction p
    Just (SubTreeOut {in:inId,out}) -> do
      void $ Share.shareReq session inId $ Share.SharePublicParams {node_id:out}
325
      liftEffect $ setOpenNodes (Set.insert (mkNodeId session out))
326
      performAction RefreshTree p
327

328 329 330 331 332 333 334 335 336

performAction (AddContact params) p@{ reload: (_ /\ setReload)
                                     , session
                                     , tree: (NTree (LNode {id}) _)
                                     } =
    void $ Contact.contactReq session id params



Alexandre Delanoë's avatar
Alexandre Delanoë committed
337
-------
338 339 340 341 342 343 344
performAction (AddNode name nodeType) p@{ openNodes: (_ /\ setOpenNodes)
                                        , reload:    (_ /\ setReload)
                                        , session
                                        , tree: (NTree (LNode {id}) _)
                                        } =
  do
    task <- addNode session id $ AddNodeValue {name, nodeType}
345
    liftEffect $ setOpenNodes (Set.insert (mkNodeId session id))
346 347
    performAction RefreshTree p

Alexandre Delanoë's avatar
Alexandre Delanoë committed
348
-------
349 350 351 352
performAction (UploadFile nodeType fileType mName blob) { session
                                                        , tasks: { onTaskAdd }
                                                        , tree: (NTree (LNode {id}) _)
                                                        } =
353
  do
354
    task <- uploadFile session nodeType id fileType {mName, blob}
355
    liftEffect $ onTaskAdd task
356
    liftEffect $ log2 "Uploaded, task:" task
357

358 359 360 361
performAction (UploadArbitraryFile mName blob) { session
                                               , tasks: { onTaskAdd }
                                               , tree: (NTree (LNode {id}) _)
                                               } =
362
  do
363
    task <- uploadArbitraryFile session id { blob, mName }
364
    liftEffect $ onTaskAdd task
365
    liftEffect $ log2 "Uploaded, task:" task
366

Alexandre Delanoë's avatar
Alexandre Delanoë committed
367
-------
368 369 370
performAction DownloadNode _ = do
    liftEffect $ log "[performAction] DownloadNode"
-------
371 372 373 374 375 376
performAction (MoveNode {params}) p@{session} =
  case params of
    Nothing -> performAction NoAction p
    Just (SubTreeOut {in:in',out}) -> do
      void $ moveNodeReq session in' out
      performAction RefreshTree p
377

378 379 380 381 382 383
performAction (MergeNode {params}) p@{session} =
  case params of
    Nothing -> performAction NoAction p
    Just (SubTreeOut {in:in',out}) -> do
      void $ mergeNodeReq session in' out
      performAction RefreshTree p
384

385
performAction (LinkNode {nodeType, params}) p@{session} = do
386 387 388
  case params of
    Nothing -> performAction NoAction p
    Just (SubTreeOut {in:in',out}) -> do
389
      void $ linkNodeReq session nodeType in' out
390
      performAction RefreshTree p
391

392
-------
393
performAction RefreshTree { reload: (_ /\ setReload) } = do
394
  liftEffect $ setReload (_ + 1)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
395
-------
396 397 398
performAction NoAction _ = do
    liftEffect $ log "[performAction] NoAction"