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.Aff (Aff)
11
import Effect.Class (liftEffect)
12
import Gargantext.AsyncTasks as GAT
arturo's avatar
arturo committed
13
import Gargantext.Components.App.Store (Boxes)
arturo's avatar
arturo committed
14 15
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Forest.Tree.Node (blankNodeSpan, nodeSpan)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
16
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
17
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
18
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode, unpublishNode)
19 20 21
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)
22
import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename)
23
import Gargantext.Components.Forest.Tree.Node.Action.Share as Share
24
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
25
import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
26
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile, uploadFrameCalc)
27
import Gargantext.Components.Forest.Tree.Node.Action.WriteNodesDocuments (documentsFromWriteNodesReq)
28 29
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
30
import Gargantext.Config.REST (AffRESTError, logRESTError)
31
import Gargantext.Config.Utils (handleRESTError)
32
import Gargantext.Ends (Frontends)
33
import Gargantext.Hooks.Loader (useLoaderEffect)
34
import Gargantext.Routes as GR
35
import Gargantext.Sessions (Session, get, mkNodeId)
36
import Gargantext.Sessions.Types (useOpenNodesMemberBox, openNodesInsert, openNodesDelete)
37
import Gargantext.Types (Handed, ID, isPublic, publicize)
38
import Gargantext.Types as GT
39
import Gargantext.Utils ((?))
40
import Gargantext.Utils.Reactix as R2
James Laver's avatar
James Laver committed
41
import Gargantext.Utils.Toestand as T2
42 43 44 45 46
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
import Toestand as T
47

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

51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
-- 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
68

69
type TreeProps =
70 71
 ( root :: ID
 , tree :: FTree
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
 | 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
87

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

94 95 96 97
-- 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 =
98
  ( id     :: ID
99
  , render :: R2.Leaf TreeProps
100
  , root   :: ID
101 102
  | NodeProps
  )
James Laver's avatar
James Laver committed
103

104
type PerformActionProps =
105 106 107
  ( isBoxVisible :: T.Box Boolean
  | PACommon
  )
James Laver's avatar
James Laver committed
108 109

-- | Loads and renders the tree starting at the given root node id.
110 111 112 113
treeLoader :: R2.Leaf ( key :: String | LoaderProps )
treeLoader = R2.leaf treeLoaderCpt

treeLoaderCpt :: R.Component ( key :: String | LoaderProps )
James Laver's avatar
James Laver committed
114
treeLoaderCpt = here.component "treeLoader" cpt where
115 116 117
-- treeLoaderCpt :: R.Memo LoaderProps
-- treeLoaderCpt = R.memo (here.component "treeLoader" cpt) memoCmp where
--   memoCmp ({ root: t1 }) ({ root: t2 }) = t1 == t2
118
  cpt p@{ root, session } _ = do
arturo's avatar
arturo committed
119
    -- States
120
    -- app     <- T.useLive T.unequal p.reloadRoot
arturo's avatar
arturo committed
121
    state /\ stateBox <- R2.useBox' Nothing
122
    let fetch { root: r } = getNodeTree session r
arturo's avatar
arturo committed
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:
arturo's avatar
arturo committed
141
          R2.fromMaybe state $ loaded
arturo's avatar
arturo committed
142
      }
143 144 145 146
      where
        loaded tree' = tree props where
          props = Record.merge common extra where
            common = RecordE.pick p :: Record Common
147
            extra = { reloadTree: p.reload, root, session, tree: tree' }
148
        errorHandler = logRESTError here "[treeLoader]"
James Laver's avatar
James Laver committed
149

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

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

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

167 168 169
    isBoxVisible  <- T.useBox false
    folderOpen    <- useOpenNodesMemberBox nodeId forestOpen
    folderOpen'   <- T.useLive T.unequal folderOpen
arturo's avatar
arturo committed
170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186

    pure $

      H.div
      { className: intercalate " "
          [ "maintree"
          , Array.null children' ?
              "maintree--no-child" $
              "maintree--with-child"
          ]
      }
      [
        H.div
        { className: "maintree__node" }
        [
          nodeSpan
          { boxes
187
          , dispatch: dispatch' isBoxVisible
arturo's avatar
arturo committed
188 189 190 191 192 193 194 195 196
          , folderOpen
          , frontends
          , id
          , isLeaf
          , name
          , nodeType
          , reload
          , root
          , session
197
          , isBoxVisible
arturo's avatar
arturo committed
198 199
          }
        <>
arturo's avatar
arturo committed
200
          R2.when (folderOpen')
arturo's avatar
arturo committed
201 202 203 204 205 206 207 208 209
          (
            renderTreeChildren $
            { childProps:
                { children'
                , folderOpen
                , render: tree
                }
            } `Record.merge` p
          )
210 211
        ]
      ]
James Laver's avatar
James Laver committed
212 213 214
    where
      isLeaf = A.null children
      nodeId = mkNodeId session id
215 216
      children' = A.sortWith fTreeID pubChildren
      pubChildren = if isPublic nodeType then map (map pub) children else children
217
      dispatch' isBoxVisible a = performAction a (Record.merge common' extra) where
218
        common' = RecordE.pick p :: Record PACommon
219
        extra = { isBoxVisible }
James Laver's avatar
James Laver committed
220
  pub (LNode n@{ nodeType: t }) = LNode (n { nodeType = publicize t })
221 222 223



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

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


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

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

arturo's avatar
arturo committed
256

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

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

    -- Render
    pure $

      B.cloak
      { isDisplayed: isJust state
      , sustainingPhaseDuration: Just 50
      , cloakSlot:
          blankTree {}
      , defaultSlot:
arturo's avatar
arturo committed
288
          R2.fromMaybe state $ paint reload
arturo's avatar
arturo committed
289 290
      }

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

299 300
closeBox { isBoxVisible } =
  liftEffect $ T.write_ false isBoxVisible
301

302
refreshTree p@{ reloadTree } = liftEffect $ T2.reload reloadTree *> closeBox p
303

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

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

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

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

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

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

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

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

348 349
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 }
350
  handleRESTError errors eTask $ \task -> liftEffect $ do
351
    GAT.insert id task tasks
352
    here.log2 "[uploadFile'] UploadFile, uploaded, task:" task
353

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

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

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

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

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

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

390 391 392
-- | 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
393 394 395 396 397 398 399 400
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
401
performAction UploadFrameCalc p                               = uploadFrameCalc' p
402 403 404 405
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
406 407 408 409 410
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
411
performAction CloseBox p                                      = closeBox p
412 413
performAction (DocumentsFromWriteNodes { id }) p              = documentsFromWriteNodes id p
performAction NoAction _                                      = liftEffect $ here.log "[performAction] NoAction"