Tree.purs 15.5 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
import Data.Array as Array
7 8
import Data.Maybe (fromMaybe, Maybe(..), isJust)
import Data.String (Pattern(..), split)
arturo's avatar
arturo committed
9 10
import Data.Traversable (intercalate, traverse, traverse_)
import Data.Tuple.Nested ((/\))
11
import Effect.Aff (Aff)
12
import Effect.Class (liftEffect)
13
import Gargantext.AsyncTasks as GAT
14
import Gargantext.Components.App.Store as Store
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)
34
import Gargantext.Hooks.Loader (useLoaderEffect)
35
import Gargantext.Routes as GR
36
import Gargantext.Sessions (Session, get, mkNodeId)
Fabien Manière's avatar
Fabien Manière committed
37
import Gargantext.Sessions.Types (useOpenNodesMemberBox, openNodesInsert, openNodesDelete)
38
import Gargantext.Types (Handed, ID, isPublic, publicize)
39
import Gargantext.Types as GT
40
import Gargantext.Utils ((?))
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
-- Shared by every component here
type Common =
54
  ( frontends :: Frontends
55 56 57 58 59 60 61 62 63 64 65 66 67
  , 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
 | 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 =
82
  ( reloadTree :: T2.ReloadS
83 84 85
  , session    :: Session
  , tree       :: FTree
  )
James Laver's avatar
James Laver committed
86

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

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

103
type PerformActionProps =
104 105
  ( boxes        :: Store.Boxes
  , isBoxVisible :: T.Box Boolean
106 107
  | 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 )
114
treeLoaderCpt = R2.hereComponent here "treeLoader" hCpt 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
  hCpt hp 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 hp
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
tree :: R2.Leaf TreeProps
tree props = R.createElement treeCpt props []
158

James Laver's avatar
James Laver committed
159 160
treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt where
161
  cpt p@{ frontends
162
        , reload
163
        , root
164 165
        , session
        , tree: NTree (LNode { id, name, nodeType }) children } _ = do
166
    boxes@{ forestOpen } <- Store.use
arturo's avatar
arturo committed
167

168 169 170
    isBoxVisible  <- T.useBox false
    folderOpen    <- useOpenNodesMemberBox nodeId forestOpen
    folderOpen'   <- T.useLive T.unequal folderOpen
171 172 173 174 175 176 177

    R.useEffect' do
      selectedLeaf <- R2.querySelector ".mainleaf--selected"
      case selectedLeaf of
          Nothing -> pure unit
          Just el -> R2.scrollIntoView el

arturo's avatar
arturo committed
178 179 180 181 182 183 184 185 186 187 188 189 190 191 192
    pure $

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


arturo's avatar
arturo committed
229 230 231 232 233
blankTree :: R2.Leaf ()
blankTree = R2.leaf blankTreeCpt
blankTreeCpt :: R.Component ()
blankTreeCpt = here.component "__blank__" cpt where
  cpt _ _ = pure $
234

arturo's avatar
arturo committed
235 236 237 238 239 240 241 242 243 244 245 246 247 248
    H.div
    { className: "maintree maintree--blank" }
    [
      H.div
      { className: "maintree__node" }
      [
        blankNodeSpan
        {}
      ]
    ]


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

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

arturo's avatar
arturo committed
261

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

    -- 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
293
          R2.fromMaybe state $ paint reload
arturo's avatar
arturo committed
294 295
      }

James Laver's avatar
James Laver committed
296
    where
297
      errorHandler = logRESTError hp
James Laver's avatar
James Laver committed
298
      fetch _ = getNodeTreeFirstLevel p.session p.id
299 300
      paint reload tree' = render (Record.merge base extra) where
        base = nodeProps { reload = reload }
301
        extra = { root, tree: tree' }
302
        nodeProps = RecordE.pick p :: Record NodeProps
James Laver's avatar
James Laver committed
303

304 305
closeBox { isBoxVisible } =
  liftEffect $ T.write_ false isBoxVisible
306

307
refreshTree p@{ reloadTree } = liftEffect $ closeBox p *> T2.reload reloadTree
308

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

317
doSearch task { boxes: { tasks }, tree: NTree (LNode {id}) _ } = liftEffect $ do
318
  GAT.insert id task tasks
319

320
updateNode params p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode {id}) _) } = do
321
  eTask <- updateRequest params session id
322
  handleRESTError (R2.herePrefix here "[updateNode]") errors eTask $ \task -> liftEffect $ do
323
    GAT.insert id task tasks
324
    closeBox p
325

326 327
renameNode name p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
  eTask <- rename session id $ RenameValue { text: name }
328
  handleRESTError (R2.herePrefix here "[renameNode]") errors eTask $ \_task -> pure unit
329 330
  refreshTree p

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
    handleRESTError (R2.herePrefix here "[sharePublic]") errors eTask $ \_task -> do
335 336 337
      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
  handleRESTError (R2.herePrefix here "[addContact]") errors eTask $ \_task -> pure unit
341

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

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

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

360
uploadFrameCalc' lang { boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
361
  eTask <- uploadFrameCalc session id lang selection
362
  handleRESTError (R2.herePrefix here "[uploadFrameCalc']") errors eTask $ \task -> liftEffect $ do
363 364
    GAT.insert id task tasks

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

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

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

384
documentsFromWriteNodes params p@{ boxes: { errors, tasks }, session, tree: NTree (LNode { id }) _ } = do
385
  eTask <- documentsFromWriteNodesReq session params
386
  handleRESTError (R2.herePrefix here "[documentsFromWriteNodes]") errors eTask $ \task -> liftEffect $ do
387 388
    GAT.insert id task tasks
    pure unit
389 390
  refreshTree p

391 392 393
-- | 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
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 (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 lang selection) p              = uploadFrameCalc' lang p selection
402 403
performAction (UploadFile nodeType fileType fileFormat lang mName contents selection) p =
  uploadFile' nodeType fileType fileFormat lang mName contents p selection
404 405
performAction (UploadArbitraryFile fileFormat mName blob) p              =
  uploadArbitraryFile' fileFormat mName blob p
406 407 408 409
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
410
performAction CloseBox p                                      = closeBox p
411
performAction (DocumentsFromWriteNodes params) p              = documentsFromWriteNodes params p
412
performAction NoAction _                                      = liftEffect $ here.log "[performAction] NoAction"
413 414
performAction DownloadNode _                                  = liftEffect $ here.log "[performAction] DownloadNode"
performAction (ShareTeam _) _                                 = liftEffect $ here.log "[performAction] ShareTeam not used as action, see Node/Action/Share instead"