Tree.purs 18.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 (Effect)
10
import Effect.Aff (Aff)
11
import Effect.Class (liftEffect)
12 13 14 15 16
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE

17 18
import Gargantext.Prelude

19
import Gargantext.AsyncTasks as GAT
20
import Gargantext.Components.Forest.Tree.Node (nodeSpan)
21
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
22
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
Alexandre Delanoë's avatar
Alexandre Delanoë committed
23
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
24
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode, unpublishNode)
25
import Gargantext.Components.Forest.Tree.Node.Action.Move   (moveNodeReq)
26 27
import Gargantext.Components.Forest.Tree.Node.Action.Merge  (mergeNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Link   (linkNodeReq)
28
import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename)
29 30
import Gargantext.Components.Forest.Tree.Node.Action.Share   as Share
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
31
import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
32
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile)
33
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
34
import Gargantext.Ends (Frontends, toUrl)
35
import Gargantext.Hooks.Loader (useLoader)
36
import Gargantext.Routes (AppRoute)
37
import Gargantext.Routes as GR
38
import Gargantext.Sessions (OpenNodes, Session, mkNodeId, get)
39
import Gargantext.Types (ID, isPublic, publicize)
40
import Gargantext.Types as GT
41
import Gargantext.Utils.Reactix as R2
42
import Gargantext.Utils.Reload as GUR
43

44
thisModule :: String
45
thisModule = "Gargantext.Components.Forest.Tree"
46

47
------------------------------------------------------------------------
48
type CommonProps = (
49
    appReload     :: GUR.ReloadS
50
  , currentRoute  :: AppRoute
51
  , frontends     :: Frontends
52
  , handed        :: GT.Handed
53
  , openNodes     :: R.State OpenNodes
54
  , reload        :: GUR.ReloadS
55
  , session       :: Session
56 57
  )

58
------------------------------------------------------------------------
59 60 61 62 63
type Props = (
    asyncTasks :: GAT.Reductor
  , root       :: ID
  | CommonProps
  )
64

65
treeView :: R2.Component Props
66
treeView = R.createElement treeViewCpt
67

68 69 70
treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponentWithModule thisModule "treeView" cpt
  where
71 72
    cpt { appReload
        , asyncTasks
73
        , currentRoute
74 75 76 77 78 79 80
        , frontends
        , handed
        , openNodes
        , reload
        , root
        , session
        } _children = do
81 82
      pure $ treeLoadView { appReload
                          , asyncTasks
83
                          , currentRoute
84 85 86 87 88 89 90 91 92
                          , frontends
                          , handed
                          , openNodes
                          , reload
                          , root
                          , session
                          } []

treeLoadView :: R2.Component Props
93
treeLoadView = R.createElement treeLoadViewCpt
94

95 96 97
treeLoadViewCpt :: R.Component Props
treeLoadViewCpt = R.hooksComponentWithModule thisModule "treeLoadView" cpt
  where
98 99
    cpt { appReload
        , asyncTasks
100
        , currentRoute
101 102 103 104 105 106 107 108
        , frontends
        , handed
        , openNodes
        , reload
        , root
        , session
        } _children = do
      let fetch _ = getNodeTree session root
109 110
      let paint loaded = loadedTreeViewFirstLevel { appReload
                                                  , asyncTasks
111
                                                  , currentRoute
112 113 114 115 116 117 118 119
                                                  , frontends
                                                  , handed
                                                  , openNodes
                                                  , reload
                                                  , session
                                                  -- , tasks: tasksStruct root asyncTasks reload
                                                  , tree: loaded
                                                  } []
120 121
      useLoader { appCounter: GUR.value appReload
                , counter: GUR.value reload
122
                , root } fetch paint
123

124 125 126
--------------
getNodeTree :: Session -> GT.ID -> Aff FTree
getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
127 128 129
--------------
getNodeTreeFirstLevel :: Session -> GT.ID -> Aff FTree
getNodeTreeFirstLevel session nodeId = get session $ GR.TreeFirstLevel (Just nodeId) ""
130
--------------
131 132 133 134 135
type TreeViewProps = (
    asyncTasks :: GAT.Reductor
  , tree       :: FTree
  | CommonProps
  )
136

137
loadedTreeViewFirstLevel :: R2.Component TreeViewProps
138
loadedTreeViewFirstLevel = R.createElement loadedTreeViewFirstLevelCpt
139

140 141 142
loadedTreeViewFirstLevelCpt :: R.Component TreeViewProps
loadedTreeViewFirstLevelCpt = R.hooksComponentWithModule thisModule "loadedTreeViewFirstLevel" cpt
  where
143 144
    cpt { appReload
        , asyncTasks
145
        , currentRoute
146 147 148 149 150 151 152 153
        , frontends
        , handed
        , openNodes
        , reload
        , session
        -- , tasks
        , tree
      } _ = do
154
      pure $ H.ul { className: "tree " <> if handed == GT.RightHanded then "mr-auto" else "ml-auto" } [
155
        H.div { className: if handed == GT.RightHanded then "righthanded" else "lefthanded" } [
156 157 158 159 160 161 162 163 164 165 166 167 168
          toHtmlFirstLevel (ToHtmlProps { appReload
                                        , asyncTasks
                                        , currentRoute
                                        , frontends
                                        , handed
                                        , openNodes
                                        , reload
                                        , reloadTree: reload
                                        , render: toHtmlFirstLevel
                                        , session
                                          -- , tasks
                                        , tree
                                        }) []
169 170
            ]
        ]
171

172
------------------------------------------------------------------------
173 174


175
newtype ToHtmlProps = ToHtmlProps {
176
    asyncTasks :: GAT.Reductor
177
  , reloadTree :: GUR.ReloadS
178
  , render       :: ToHtmlProps -> Array R.Element -> R.Element
179
  -- , tasks      :: Record Tasks
180
  , tree       :: FTree
181 182 183 184 185 186 187 188 189
  -- | CommonProps
  , appReload     :: GUR.ReloadS
  , currentRoute  :: AppRoute
  , frontends     :: Frontends
  , handed        :: GT.Handed
  , openNodes     :: R.State OpenNodes
  , reload        :: GUR.ReloadS
  , session       :: Session
  }
190

191 192 193 194 195
toHtmlFirstLevel :: ToHtmlProps -> Array R.Element -> R.Element
toHtmlFirstLevel = R2.ntCreateElement toHtmlFirstLevelCpt

toHtmlFirstLevelCpt :: R2.NTComponent ToHtmlProps
toHtmlFirstLevelCpt = R2.ntHooksComponentWithModule thisModule "toHtmlFirstLevel" cpt
196
  where
197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213
    cpt (ToHtmlProps p@{ appReload
                       , asyncTasks
                       , currentRoute
                       , frontends
                       , handed
                       , openNodes
                       , reload
                       , reloadTree
                       , render
                       , session
                       , tree: tree@(NTree (LNode { id
                                                  , name
                                                  , nodeType
                                                  }
                                           ) ary
                                    )
                       }) _ = do
214 215 216
      setPopoverRef <- R.useRef Nothing

      let pAction a   = performAction a (RecordE.pick (Record.merge p { setPopoverRef }) :: Record PerformActionProps)
217 218 219 220 221 222 223 224 225 226

      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'

      pure $ H.li { className: if A.null ary then "no-children" else "with-children" } $
227 228
        [ nodeSpan { appReload
                   , asyncTasks
229
                   , currentRoute
230 231 232 233 234 235 236 237 238 239 240 241
                   , dispatch: pAction
                   , folderOpen
                   , frontends
                   , handed
                   , id
                   , isLeaf: A.null ary
                   , name
                   , nodeType
                   , session
                   , setPopoverRef
                   -- , tasks
                   }
242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261
          $ renderChildren folderOpen publicizedChildren
        ]
      where
        commonProps = RecordE.pick p :: Record CommonProps

        publicizedChildren = if isPublic nodeType
                              then map (\t -> map (\(LNode n@{ nodeType:nt } )
                                                  -> (LNode (n { nodeType = publicize nt }))
                                                  ) t) ary
                              else ary

        renderChildren (false /\ _) _ = []
        renderChildren folderOpen@(true /\ _) cs =
          (
            map (\t@(NTree (LNode {id: cId}) _) ->
                  childNodeFirstLevel ( Record.merge commonProps
                                        { asyncTasks
                                        , folderOpen
                                        , handed
                                        , id: cId
262
                                        , reloadTree
263
                                        , render
264 265
                                        }
                                      ) []
266
                ) $ sorted publicizedChildren
267
          )
268

269 270 271
    sorted :: Array FTree -> Array FTree
    sorted = A.sortWith (\(NTree (LNode {id}) _) -> id)

272

273
type ChildNodeFirstLevelProps = (
274 275 276
    asyncTasks   :: GAT.Reductor
  , folderOpen   :: R.State Boolean
  , id           :: ID
277
  , reloadTree   :: GUR.ReloadS
278
  , render       :: ToHtmlProps -> Array R.Element -> R.Element
279 280 281 282
  | CommonProps
  )

childNodeFirstLevel :: R2.Component ChildNodeFirstLevelProps
283
childNodeFirstLevel = R.createElement childNodeFirstLevelCpt
284

285 286 287 288 289 290
-- TODO This shouldn't be here: make it a top-level function but be careful
-- about cyclic defines
-- https://discourse.purescript.org/t/strange-compiler-error-with-an-undefined-reference/2060/3
childNodeFirstLevelCpt :: R.Component ChildNodeFirstLevelProps
childNodeFirstLevelCpt = R.hooksComponentWithModule thisModule "childNodeFirstLevel" cpt
  where
291 292
    cpt props@{ appReload
              , asyncTasks
293
              , currentRoute
294 295 296 297 298 299 300
              , folderOpen
              , id
              , frontends
              , handed
              , openNodes
              , reload
              , reloadTree
301
              , render
302
              , session } _ = do
303
      cptReload <- GUR.new
304 305

      let fetch _ = getNodeTreeFirstLevel session id
306 307
      let paint loaded = childNodeFirstLevelPaint { appReload
                                                  , asyncTasks
308
                                                  , currentRoute
309 310 311 312 313
                                                  , folderOpen
                                                  , frontends
                                                  , handed
                                                  , openNodes
                                                  , reload: cptReload
314
                                                  , reloadTree
315
                                                  , render
316 317 318
                                                  , session
                                                  , tree: loaded } []

319 320 321
      useLoader { counter: GUR.value cptReload
                , root: id
                , treeCounter: GUR.value reloadTree } fetch paint
322 323 324


type ChildNodeFirstLevelPaintProps = (
325 326
    asyncTasks   :: GAT.Reductor
  , folderOpen   :: R.State Boolean
327
  , reloadTree   :: GUR.ReloadS
328
  , render       :: ToHtmlProps -> Array R.Element -> R.Element
329
  , tree         :: FTree
330 331 332 333
  | CommonProps
  )

childNodeFirstLevelPaint :: R2.Component ChildNodeFirstLevelPaintProps
334
childNodeFirstLevelPaint = R.createElement childNodeFirstLevelPaintCpt
335

336 337 338 339 340 341 342
-- TODO This shouldn't be here: make it a top-level function but be careful
-- about cyclic defines
-- https://discourse.purescript.org/t/strange-compiler-error-with-an-undefined-reference/2060/3
childNodeFirstLevelPaintCpt :: R.Component ChildNodeFirstLevelPaintProps
childNodeFirstLevelPaintCpt = R.hooksComponentWithModule thisModule "childNodeFirstLevelPaint" cpt
-- TODO folderOpen is unused
  where
343 344 345 346
    cpt props@{ asyncTasks
              , handed
              , reload
              , reloadTree
347
              , render
348
              , tree: ctree@(NTree (LNode { id }) _) } _ = do
349
      pure $ H.ul {} [
350 351 352 353 354
        render (ToHtmlProps (Record.merge commonProps { asyncTasks
                                                      , handed
                                                      , reloadTree
                                                      , render
                                                      , tree: ctree })
355 356 357 358 359 360 361
                        ) []
        ]
      -- pure $ H.div { } [ H.text $ "[closed] Node id " <> show id ]
      where
        commonProps = RecordE.pick props :: Record CommonProps


362
type PerformActionProps = (
363
    appReload    :: GUR.ReloadS
364 365
  , asyncTasks   :: GAT.Reductor
  , openNodes    :: R.State OpenNodes
366 367
  , reload       :: GUR.ReloadS
  , reloadTree   :: GUR.ReloadS
368 369
  , session      :: Session
  , setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
370
  -- , tasks     :: Record Tasks
371
  , tree         :: FTree
372
  )
373

Alexandre Delanoë's avatar
Alexandre Delanoë committed
374
-------
375 376
performAction :: Action
              -> Record PerformActionProps
377
              -> Aff Unit
378
performAction (DeleteNode nt) p@{ openNodes: (_ /\ setOpenNodes)
379 380 381
                                , session
                                , tree: (NTree (LNode {id, parent_id}) _)
                                } =
382
  do
383 384 385 386 387
    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

388
    liftEffect $ setOpenNodes (Set.delete (mkNodeId session id))
389 390
    performAction RefreshTree p

Alexandre Delanoë's avatar
Alexandre Delanoë committed
391
-------
392
performAction (DoSearch task) { asyncTasks: (_ /\ dispatch)
393 394 395 396
                              , session
                              , tree: (NTree (LNode {id}) _)
                              }  =
  do
397
    liftEffect $ dispatch $ GAT.Insert id task
398 399
    liftEffect $ log2 "[performAction] DoSearch task:" task

Alexandre Delanoë's avatar
Alexandre Delanoë committed
400
-------
401
performAction (UpdateNode params) { asyncTasks: (_ /\ dispatch)
402 403 404
                                  , session
                                  , tree: (NTree (LNode {id}) _)
                                  } =
405
  do
406
    task <- updateRequest params session id
407
    liftEffect $ dispatch $ GAT.Insert id task
408 409
    liftEffect $ log2 "[performAction] UpdateNode task:" task

Alexandre Delanoë's avatar
Alexandre Delanoë committed
410 411

-------
412
performAction (RenameNode name) p@{ session
413 414
                                  , tree: (NTree (LNode {id}) _)
                                  } =
415 416 417 418
  do
    void $ rename session id $ RenameValue {text:name}
    performAction RefreshTree p

Alexandre Delanoë's avatar
Alexandre Delanoë committed
419
-------
420
performAction (ShareTeam username) p@{ session
421 422 423
                                     , tree: (NTree (LNode {id}) _)
                                     } =
  do
424
    void $ Share.shareReq session id $ Share.ShareTeamParams {username}
425

426

427 428 429
performAction (SharePublic {params}) p@{ session
                                       , openNodes: (_ /\ setOpenNodes)
                                       } =
430 431 432 433
  case params of
    Nothing -> performAction NoAction p
    Just (SubTreeOut {in:inId,out}) -> do
      void $ Share.shareReq session inId $ Share.SharePublicParams {node_id:out}
434
      liftEffect $ setOpenNodes (Set.insert (mkNodeId session out))
435
      performAction RefreshTree p
436

437

438
performAction (AddContact params) p@{ session
439 440 441 442 443 444
                                     , tree: (NTree (LNode {id}) _)
                                     } =
    void $ Contact.contactReq session id params



Alexandre Delanoë's avatar
Alexandre Delanoë committed
445
-------
446 447 448 449 450 451
performAction (AddNode name nodeType) p@{ openNodes: (_ /\ setOpenNodes)
                                        , session
                                        , tree: (NTree (LNode {id}) _)
                                        } =
  do
    task <- addNode session id $ AddNodeValue {name, nodeType}
452
    liftEffect $ setOpenNodes (Set.insert (mkNodeId session id))
453 454
    performAction RefreshTree p

Alexandre Delanoë's avatar
Alexandre Delanoë committed
455
-------
456 457
performAction (UploadFile nodeType fileType mName blob) { asyncTasks: (_ /\ dispatch)
                                                        , session
458 459
                                                        , tree: (NTree (LNode {id}) _)
                                                        } =
460
  do
461
    task <- uploadFile session nodeType id fileType {mName, blob}
462 463 464
    liftEffect $ do
      dispatch $ GAT.Insert id task
      log2 "[performAction] UploadFile, uploaded, task:" task
465

466 467
performAction (UploadArbitraryFile mName blob) { asyncTasks: (_ /\ dispatch)
                                               , session
468 469
                                               , tree: (NTree (LNode {id}) _)
                                               } =
470
  do
471
    task <- uploadArbitraryFile session id { blob, mName }
472 473 474
    liftEffect $ do
      dispatch $ GAT.Insert id task
      log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
475

Alexandre Delanoë's avatar
Alexandre Delanoë committed
476
-------
477 478 479
performAction DownloadNode _ = do
    liftEffect $ log "[performAction] DownloadNode"
-------
480 481
performAction (MoveNode {params}) p@{ openNodes: (_ /\ setOpenNodes)
                                    , session } =
482 483 484 485
  case params of
    Nothing -> performAction NoAction p
    Just (SubTreeOut {in:in',out}) -> do
      void $ moveNodeReq session in' out
486
      liftEffect $ setOpenNodes (Set.insert (mkNodeId session out))
487
      performAction RefreshTree p
488

489 490 491 492 493 494
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
495

496
performAction (LinkNode {nodeType, params}) p@{session} = do
497 498 499
  case params of
    Nothing -> performAction NoAction p
    Just (SubTreeOut {in:in',out}) -> do
500
      void $ linkNodeReq session nodeType in' out
501
      performAction RefreshTree p
502

503
-------
504
performAction RefreshTree p@{ reloadTree
505
                            , setPopoverRef } = do
506
  liftEffect $ do
507
    GUR.bump reloadTree
508
  performAction ClosePopover p
Alexandre Delanoë's avatar
Alexandre Delanoë committed
509
-------
510 511 512
performAction NoAction _ = do
    liftEffect $ log "[performAction] NoAction"

513 514 515 516 517
performAction ClosePopover { setPopoverRef } = do
  liftEffect $ do
    case R.readRef setPopoverRef of
      Nothing -> pure unit
      Just setPopover -> setPopover false