Tree.purs 14.6 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, ($), (+), (<>), (==))
35
import Gargantext.Routes (AppRoute)
36
import Gargantext.Sessions (OpenNodes, Session, mkNodeId, get)
37
import Gargantext.Types (ID, Reload, isPublic, publicize)
38 39
import Gargantext.Types as GT
import Gargantext.Routes as GR
40

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

51
------------------------------------------------------------------------
52 53
type Props = ( root       :: ID
             , asyncTasks :: R.State GAT.Storage
54
             | CommonProps
55
             )
56

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

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

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

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

121
loadedTreeView :: Record TreeViewProps -> R.Element
122
loadedTreeView p = R.createElement loadedTreeViewCpt p []
123
  where
124 125 126
    loadedTreeViewCpt :: R.Component TreeViewProps
    loadedTreeViewCpt = R.hooksComponent "LoadedTreeView" cpt
      where
Alexandre Delanoë's avatar
Alexandre Delanoë committed
127 128
        cpt { asyncTasks
            , frontends
129
            , handed
Alexandre Delanoë's avatar
Alexandre Delanoë committed
130 131 132
            , mCurrentRoute
            , openNodes
            , reload
133
            , session
Alexandre Delanoë's avatar
Alexandre Delanoë committed
134 135
            , tasks
            , tree
136 137
          } _ = pure $ H.ul { className: "tree"
                            }
138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
                             [ 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
153
                             ]
154

155
------------------------------------------------------------------------
156 157


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

toHtml :: Record ToHtmlProps -> R.Element
166 167
toHtml p@{ asyncTasks
         , frontends
168 169 170 171
         , mCurrentRoute
         , openNodes
         , reload: reload@(_ /\ setReload)
         , session
Alexandre Delanoë's avatar
Alexandre Delanoë committed
172 173 174 175 176 177 178 179 180
         , tasks: tasks@{ onTaskAdd
                        , onTaskFinish
                        , tasks: tasks'
                        }
         , tree: tree@(NTree (LNode { id
                                    , name
                                    , nodeType
                                    }
                              ) ary
181 182
                      )
         , handed
Alexandre Delanoë's avatar
Alexandre Delanoë committed
183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
         } =
  R.createElement el {} []
    where
      el          = R.hooksComponent "NodeView" cpt
      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'

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

223
type ChildNodesProps =
Alexandre Delanoë's avatar
Alexandre Delanoë committed
224
  ( asyncTasks :: R.State GAT.Storage
225
  , children   :: Array FTree
226 227
  , folderOpen :: R.State Boolean
  | CommonProps
228 229 230
  )

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

type PerformActionProps =
  ( openNodes :: R.State OpenNodes
249 250
  , reload    :: R.State Reload
  , session   :: Session
251
  , tasks     :: Record Tasks
252
  , tree      :: FTree
253
  )
254

Alexandre Delanoë's avatar
Alexandre Delanoë committed
255
-------
256 257
performAction :: Action
              -> Record PerformActionProps
258
              -> Aff Unit
259
performAction (DeleteNode nt) p@{ openNodes: (_ /\ setOpenNodes)
260 261
                           , reload: (_ /\ setReload)
                           , session
262
                           , tree: (NTree (LNode {id, parent_id}) _)
263 264
                           } =
  do
265 266 267 268 269
    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

270
    liftEffect $ setOpenNodes (Set.delete (mkNodeId session id))
271 272
    performAction RefreshTree p

Alexandre Delanoë's avatar
Alexandre Delanoë committed
273
-------
274 275 276 277 278 279 280 281 282
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
283
-------
284
performAction (UpdateNode params) { reload: (_ /\ setReload)
285 286 287 288 289
                                , session
                                , tasks: {onTaskAdd}
                                , tree: (NTree (LNode {id}) _)
                                } =
  do
290
    task <- updateRequest params session id
291 292 293
    liftEffect $ onTaskAdd task
    liftEffect $ log2 "[performAction] UpdateNode task:" task

Alexandre Delanoë's avatar
Alexandre Delanoë committed
294 295

-------
296
performAction (RenameNode name) p@{ reload: (_ /\ setReload)
297 298 299
                                  , session
                                  , tree: (NTree (LNode {id}) _)
                                  } =
300 301 302 303
  do
    void $ rename session id $ RenameValue {text:name}
    performAction RefreshTree p

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

312

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

323 324 325 326 327 328 329 330 331

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



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

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

353 354 355 356
performAction (UploadArbitraryFile mName blob) { session
                                               , tasks: { onTaskAdd }
                                               , tree: (NTree (LNode {id}) _)
                                               } =
357
  do
358
    task <- uploadArbitraryFile session id { blob, mName }
359
    liftEffect $ onTaskAdd task
360
    liftEffect $ log2 "Uploaded, task:" task
361

Alexandre Delanoë's avatar
Alexandre Delanoë committed
362
-------
363 364 365
performAction DownloadNode _ = do
    liftEffect $ log "[performAction] DownloadNode"
-------
366 367 368 369 370 371
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
372

373 374 375 376 377 378
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
379

380
performAction (LinkNode {nodeType, params}) p@{session} = do
381 382 383
  case params of
    Nothing -> performAction NoAction p
    Just (SubTreeOut {in:in',out}) -> do
384
      void $ linkNodeReq session nodeType in' out
385
      performAction RefreshTree p
386

387
-------
388
performAction RefreshTree { reload: (_ /\ setReload) } = do
389
  liftEffect $ setReload (_ + 1)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
390
-------
391 392 393
performAction NoAction _ = do
    liftEffect $ log "[performAction] NoAction"