Tree.purs 15.2 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 $ closeBox p *> T2.reload reloadTree
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
updateNode params p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode {id}) _) } = do
317
  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
    closeBox p
322

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

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

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

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

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

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

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

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

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

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

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

387
documentsFromWriteNodes params p@{ boxes: { errors, tasks }, session, tree: NTree (LNode { id }) _ } = do
388
  eTask <- documentsFromWriteNodesReq session params
389 390 391
  handleRESTError errors eTask $ \task -> liftEffect $ do
    GAT.insert id task tasks
    pure unit
392 393
  refreshTree p

394 395 396
-- | 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
397 398 399 400 401 402 403 404
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
405
performAction (UploadFrameCalc lang selection) p              = uploadFrameCalc' lang p selection
406 407
performAction (UploadFile nodeType fileType fileFormat lang mName contents selection) p =
  uploadFile' nodeType fileType fileFormat lang mName contents p selection
408 409
performAction (UploadArbitraryFile fileFormat mName blob selection) p              =
  uploadArbitraryFile' fileFormat mName blob p selection
410 411 412 413 414
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
415
performAction CloseBox p                                      = closeBox p
416
performAction (DocumentsFromWriteNodes params) p              = documentsFromWriteNodes params p
417
performAction NoAction _                                      = liftEffect $ here.log "[performAction] NoAction"