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

James Laver's avatar
James Laver committed
3
import Gargantext.Prelude
4

5
import Data.Array as A
arturo's avatar
arturo committed
6 7 8 9
import Data.Array as Array
import Data.Maybe (Maybe(..), isJust)
import Data.Traversable (intercalate, traverse, traverse_)
import Data.Tuple.Nested ((/\))
10
import Effect (Effect)
11
import Effect.Aff (Aff)
12
import Effect.Class (liftEffect)
13
import Gargantext.AsyncTasks as GAT
arturo's avatar
arturo committed
14
import Gargantext.Components.App.Store (Boxes)
arturo's avatar
arturo committed
15 16
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Forest.Tree.Node (blankNodeSpan, nodeSpan)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
17
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
18
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
19
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode, unpublishNode)
20 21 22
import Gargantext.Components.Forest.Tree.Node.Action.Link (linkNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Merge (mergeNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Move (moveNodeReq)
23
import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename)
24
import Gargantext.Components.Forest.Tree.Node.Action.Share as Share
25
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
26
import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
27
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile, uploadFrameCalc)
28
import Gargantext.Components.Forest.Tree.Node.Action.WriteNodesDocuments (documentsFromWriteNodesReq)
29 30
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
31
import Gargantext.Config.REST (AffRESTError, logRESTError)
32
import Gargantext.Config.Utils (handleRESTError)
33
import Gargantext.Ends (Frontends)
arturo's avatar
arturo committed
34
import Gargantext.Hooks.Loader (useLoader, useLoaderEffect)
35
import Gargantext.Routes as GR
36
import Gargantext.Sessions (Session, get, mkNodeId)
37
import Gargantext.Sessions.Types (useOpenNodesMemberBox, openNodesInsert, openNodesDelete)
38
import Gargantext.Types (Handed, ID, isPublic, publicize, switchHanded)
39
import Gargantext.Types as GT
arturo's avatar
arturo committed
40
import Gargantext.Utils (nbsp, (?))
41
import Gargantext.Utils.Reactix as R2
James Laver's avatar
James Laver committed
42
import Gargantext.Utils.Toestand as T2
43 44 45 46 47
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
import Toestand as T
48

James Laver's avatar
James Laver committed
49 50 51
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree"

52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
-- Shared by every component here
type Common =
  ( boxes     :: Boxes
  , frontends :: Frontends
  , handed    :: Handed
  , reload    :: T2.ReloadS
  )

type LoaderProps =
 ( root    :: ID
 , session :: Session
 | Common )

type NodeProps =
 ( reloadTree :: T2.ReloadS
 , session :: Session
 | Common )
James Laver's avatar
James Laver committed
69

70
type TreeProps =
71 72
 ( root :: ID
 , tree :: FTree
73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
 | NodeProps )

type ChildrenTreeProps =
  ( childProps :: { children'  :: Array FTree
                  , folderOpen :: T.Box Boolean
                  , render     :: R2.Leaf TreeProps }
  | TreeProps )

--- The properties tree shares in common with performAction
type PACommon =
  ( boxes      :: Boxes
  , reloadTree :: T2.ReloadS
  , session    :: Session
  , tree       :: FTree
  )
James Laver's avatar
James Laver committed
88

89 90
-- The properties tree shares in common with nodeSpan
type NSCommon =
91 92
  ( frontends :: Frontends
  , handed    :: Handed
93
  , session   :: Session  )
James Laver's avatar
James Laver committed
94

95 96 97 98
-- The annoying 'render' here is busting a cycle in the low tech
-- way. This function is only called by functions in this module, so
-- we just have to careful in what we pass.
type ChildLoaderProps =
99
  ( id     :: ID
100
  , render :: R2.Leaf TreeProps
101
  , root   :: ID
102
  | NodeProps )
James Laver's avatar
James Laver committed
103

104 105 106
type PerformActionProps =
  ( setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
  | PACommon )
James Laver's avatar
James Laver committed
107 108 109 110 111 112

-- | Loads and renders the tree starting at the given root node id.
treeLoader :: R2.Component LoaderProps
treeLoader = R.createElement treeLoaderCpt
treeLoaderCpt :: R.Component LoaderProps
treeLoaderCpt = here.component "treeLoader" cpt where
113 114 115
-- treeLoaderCpt :: R.Memo LoaderProps
-- treeLoaderCpt = R.memo (here.component "treeLoader" cpt) memoCmp where
--   memoCmp ({ root: t1 }) ({ root: t2 }) = t1 == t2
116
  cpt p@{ root, session } _ = do
arturo's avatar
arturo committed
117
    -- States
118
    -- app     <- T.useLive T.unequal p.reloadRoot
arturo's avatar
arturo committed
119
    state /\ stateBox <- R2.useBox' Nothing
120
    let fetch { root: r } = getNodeTree session r
arturo's avatar
arturo committed
121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140

    -- Hooks
    useLoaderEffect
      { errorHandler
      , loader: fetch
      , path: { root }
      , state: stateBox
      }

    -- Render
    pure $

      B.cloak
      { isDisplayed: isJust state
      , sustainingPhaseDuration: Just 50
      , cloakSlot:
          blankTree {}
      , defaultSlot:
          R2.fromMaybe_ state $ loaded
      }
141 142 143 144
      where
        loaded tree' = tree props where
          props = Record.merge common extra where
            common = RecordE.pick p :: Record Common
145
            extra = { reloadTree: p.reload, root, session, tree: tree' }
146
        errorHandler = logRESTError here "[treeLoader]"
James Laver's avatar
James Laver committed
147

148
getNodeTree :: Session -> ID -> AffRESTError FTree
149
getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
150

151
getNodeTreeFirstLevel :: Session -> ID -> AffRESTError FTree
James Laver's avatar
James Laver committed
152
getNodeTreeFirstLevel session nodeId = get session $ GR.TreeFirstLevel (Just nodeId) ""
153

James Laver's avatar
James Laver committed
154 155 156 157
tree :: R2.Leaf TreeProps
tree props = R.createElement treeCpt props []
treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt where
158 159 160
  cpt p@{ boxes: boxes@{ forestOpen }
        , frontends
        , reload
161
        , root
162 163
        , session
        , tree: NTree (LNode { id, name, nodeType }) children } _ = do
arturo's avatar
arturo committed
164

James Laver's avatar
James Laver committed
165
    setPopoverRef <- R.useRef Nothing
166
    folderOpen <- useOpenNodesMemberBox nodeId forestOpen
arturo's avatar
arturo committed
167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
    folderOpen' <- T.useLive T.unequal folderOpen

    pure $

      H.div
      { className: intercalate " "
          [ "maintree"
          , Array.null children' ?
              "maintree--no-child" $
              "maintree--with-child"
          ]
      }
      [
        H.div
        { className: "maintree__node" }
        [
          nodeSpan
          { boxes
          , dispatch: dispatch setPopoverRef
          , folderOpen
          , frontends
          , id
          , isLeaf
          , name
          , nodeType
          , reload
          , root
          , session
          , setPopoverRef
          }
        <>
          R2.if' (folderOpen')
          (
            renderTreeChildren $
            { childProps:
                { children'
                , folderOpen
                , render: tree
                }
            } `Record.merge` p
          )
208 209
        ]
      ]
James Laver's avatar
James Laver committed
210 211 212
    where
      isLeaf = A.null children
      nodeId = mkNodeId session id
213 214
      children' = A.sortWith fTreeID pubChildren
      pubChildren = if isPublic nodeType then map (map pub) children else children
215 216 217
      dispatch setPopoverRef a = performAction a (Record.merge common' spr) where
        common' = RecordE.pick p :: Record PACommon
        spr = { setPopoverRef }
James Laver's avatar
James Laver committed
218
  pub (LNode n@{ nodeType: t }) = LNode (n { nodeType = publicize t })
219 220 221



arturo's avatar
arturo committed
222 223 224 225 226
blankTree :: R2.Leaf ()
blankTree = R2.leaf blankTreeCpt
blankTreeCpt :: R.Component ()
blankTreeCpt = here.component "__blank__" cpt where
  cpt _ _ = pure $
227

arturo's avatar
arturo committed
228 229 230 231 232 233 234 235 236 237 238 239 240 241
    H.div
    { className: "maintree maintree--blank" }
    [
      H.div
      { className: "maintree__node" }
      [
        blankNodeSpan
        {}
      ]
    ]


renderTreeChildren :: R2.Leaf ChildrenTreeProps
renderTreeChildren = R2.leaf renderTreeChildrenCpt
242 243 244
renderTreeChildrenCpt :: R.Component ChildrenTreeProps
renderTreeChildrenCpt = here.component "renderTreeChildren" cpt where
  cpt p@{ childProps: { children'
245 246
                      , render }
        , root } _ = do
247 248 249 250 251
    pure $ R.fragment (map renderChild children')

    where
      nodeProps = RecordE.pick p :: Record NodeProps
      renderChild (NTree (LNode {id: cId}) _) = childLoader props [] where
252
        props = Record.merge nodeProps { id: cId, render, root }
253

arturo's avatar
arturo committed
254

James Laver's avatar
James Laver committed
255 256 257 258
childLoader :: R2.Component ChildLoaderProps
childLoader = R.createElement childLoaderCpt
childLoaderCpt :: R.Component ChildLoaderProps
childLoaderCpt = here.component "childLoader" cpt where
259 260
  cpt p@{ boxes: { reloadRoot }
        , reloadTree
261 262
        , render
        , root } _ = do
arturo's avatar
arturo committed
263
    -- States
264
    reload <- T.useBox T2.newReload
arturo's avatar
arturo committed
265
    state /\ stateBox <- R2.useBox' Nothing
266
    let reloads = [ reload, reloadRoot, reloadTree ]
James Laver's avatar
James Laver committed
267
    cache <- (A.cons p.id) <$> traverse (T.useLive T.unequal) reloads
arturo's avatar
arturo committed
268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288

    -- Hooks
    useLoaderEffect
      { errorHandler
      , loader: fetch
      , path: cache
      , state: stateBox
      }

    -- Render
    pure $

      B.cloak
      { isDisplayed: isJust state
      , sustainingPhaseDuration: Just 50
      , cloakSlot:
          blankTree {}
      , defaultSlot:
          R2.fromMaybe_ state $ paint reload
      }

James Laver's avatar
James Laver committed
289
    where
290
      errorHandler = logRESTError here "[childLoader]"
James Laver's avatar
James Laver committed
291
      fetch _ = getNodeTreeFirstLevel p.session p.id
292 293
      paint reload tree' = render (Record.merge base extra) where
        base = nodeProps { reload = reload }
294
        extra = { root, tree: tree' }
295
        nodeProps = RecordE.pick p :: Record NodeProps
James Laver's avatar
James Laver committed
296

297 298 299
closePopover { setPopoverRef } =
   liftEffect $ traverse_ (\set -> set false) (R.readRef setPopoverRef)

300
refreshTree p@{ reloadTree } = liftEffect $ T2.reload reloadTree *> closePopover p
301

302
deleteNode' nt p@{ boxes: { forestOpen }, session, tree: (NTree (LNode {id, parent_id}) _) } = do
James Laver's avatar
James Laver committed
303
  case nt of
304
    GT.NodePublic GT.FolderPublic -> void $ deleteNode session id
305
    GT.NodePublic _               -> void $ unpublishNode session parent_id id
306
    _                             -> void $ deleteNode session id
307
  liftEffect $ T.modify_ (openNodesDelete (mkNodeId session id)) forestOpen
308 309
  refreshTree p

310
doSearch task { boxes: { tasks }, tree: NTree (LNode {id}) _ } = liftEffect $ do
311
  GAT.insert id task tasks
312 313
  here.log2 "[doSearch] DoSearch task:" task

314 315
updateNode params { boxes: { errors, tasks }, session, tree: (NTree (LNode {id}) _) } = do
  eTask <- updateRequest params session id
316
  handleRESTError errors eTask $ \task -> liftEffect $ do
317
    GAT.insert id task tasks
318
    here.log2 "[updateNode] UpdateNode task:" task
319

320 321
renameNode name p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
  eTask <- rename session id $ RenameValue { text: name }
322
  handleRESTError errors eTask $ \_task -> pure unit
323 324
  refreshTree p

325
shareTeam username { boxes: { errors }, session, tree: (NTree (LNode {id}) _)} = do
326
  eTask <- Share.shareReq session id $ Share.ShareTeamParams { username }
327
  handleRESTError errors eTask $ \_task -> pure unit
328

329
sharePublic params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where
James Laver's avatar
James Laver committed
330
  f (SubTreeOut { in: inId, out }) = do
331
    eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out }
332 333 334 335
    handleRESTError errors eTask $ \_task -> do
      liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session out)) forestOpen
      refreshTree p

336
addContact params { boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
337
  eTask <- Contact.contactReq session id params
338 339
  handleRESTError errors eTask $ \_task -> pure unit

340 341
addNode' name nodeType p@{ boxes: { errors, forestOpen }, session, tree: (NTree (LNode { id }) _) } = do
  eId <- addNode session id $ AddNodeValue { name, nodeType }
342
  handleRESTError errors eId $ \_id -> liftEffect $ do
343
    liftEffect $ T.modify_ (openNodesInsert (mkNodeId session id)) forestOpen
344 345
    refreshTree p

346 347
uploadFile' nodeType fileType fileFormat mName contents p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
  eTask <- uploadFile { contents, fileFormat, fileType, id, mName, nodeType, selection, session }
348
  handleRESTError errors eTask $ \task -> liftEffect $ do
349
    GAT.insert id task tasks
350
    here.log2 "[uploadFile'] UploadFile, uploaded, task:" task
351

352 353
uploadArbitraryFile' fileFormat mName blob p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
  eTask <- uploadArbitraryFile session id { blob, fileFormat, mName } selection
354
  handleRESTError errors eTask $ \task -> liftEffect $ do
355
    GAT.insert id task tasks
356
    here.log2 "[uploadArbitraryFile'] UploadArbitraryFile, uploaded, task:" task
357

358 359 360
uploadFrameCalc' p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } = do
  eTask <- uploadFrameCalc session id
  handleRESTError errors eTask $ \task -> liftEffect $ do
361
    GAT.insert id task tasks
362
    here.log2 "[performAction] UploadFrameCalc, uploaded, task:" task
363

364
moveNode params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where
365
  f (SubTreeOut { in: in', out }) = do
366
    eTask <- moveNodeReq session in' out
367
    handleRESTError errors eTask $ \_task -> pure unit
368
    liftEffect $ T.modify_ (openNodesInsert (mkNodeId session out)) forestOpen
369 370
    refreshTree p

371
mergeNode params p@{ boxes: { errors }, session } = traverse_ f params where
James Laver's avatar
James Laver committed
372
  f (SubTreeOut { in: in', out }) = do
373
    eTask <- mergeNodeReq session in' out
374
    handleRESTError errors eTask $ \_task -> pure unit
375 376
    refreshTree p

377
linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params where
James Laver's avatar
James Laver committed
378
  f (SubTreeOut { in: in', out }) = do
379
    eTask <- linkNodeReq session nodeType in' out
380
    handleRESTError errors eTask $ \_task -> pure unit
381 382
    refreshTree p

383 384 385 386 387
documentsFromWriteNodes id p@{ boxes: { errors }, session } = do
  eTask <- documentsFromWriteNodesReq session id
  handleRESTError errors eTask $ \_task -> pure unit
  refreshTree p

388 389 390
-- | This thing is basically a hangover from when garg was a thermite
-- | application. we should slowly get rid of it.
performAction :: Action -> Record PerformActionProps -> Aff Unit
391 392 393 394 395 396 397 398
performAction (DeleteNode nt) p                               = deleteNode' nt p
performAction (DoSearch task) p                               = doSearch task p
performAction (UpdateNode params) p                           = updateNode params p
performAction (RenameNode name) p                             = renameNode name p
performAction (ShareTeam username) p                          = shareTeam username p
performAction (SharePublic { params }) p                      = sharePublic params p
performAction (AddContact params) p                           = addContact params p
performAction (AddNode name nodeType) p                       = addNode' name nodeType p
399
performAction UploadFrameCalc p                               = uploadFrameCalc' p
400 401 402 403
performAction (UploadFile nodeType fileType fileFormat mName contents selection) p =
  uploadFile' nodeType fileType fileFormat mName contents p selection
performAction (UploadArbitraryFile fileFormat mName blob selection) p              =
  uploadArbitraryFile' fileFormat mName blob p selection
404 405 406 407 408 409
performAction DownloadNode _                                  = liftEffect $ here.log "[performAction] DownloadNode"
performAction (MoveNode {params}) p                           = moveNode params p
performAction (MergeNode {params}) p                          = mergeNode params p
performAction (LinkNode { nodeType, params }) p               = linkNode nodeType params p
performAction RefreshTree p                                   = refreshTree p
performAction ClosePopover p                                  = closePopover p
410 411
performAction (DocumentsFromWriteNodes { id }) p              = documentsFromWriteNodes id p
performAction NoAction _                                      = liftEffect $ here.log "[performAction] NoAction"