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

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

41
thisModule :: String
42
thisModule = "Gargantext.Components.Forest.Tree"
43

44
------------------------------------------------------------------------
45 46
type CommonProps = (
    frontends     :: Frontends
47
  , handed        :: GT.Handed
48 49 50 51
  , mCurrentRoute :: Maybe AppRoute
  , openNodes     :: R.State OpenNodes
  , reload        :: R.State Reload
  , session       :: Session
52 53
  )

54
------------------------------------------------------------------------
55 56 57 58 59
type Props = (
    asyncTasks :: GAT.Reductor
  , root       :: ID
  | CommonProps
  )
60

61 62 63
treeView :: Record Props -> R.Element
treeView props = R.createElement treeViewCpt props []
  where
64
    treeViewCpt :: R.Component Props
65
    treeViewCpt = R.hooksComponentWithModule thisModule "treeView" cpt
66
      where
67
        cpt { asyncTasks
Alexandre Delanoë's avatar
Alexandre Delanoë committed
68
            , frontends
69
            , handed
70
            , mCurrentRoute
Alexandre Delanoë's avatar
Alexandre Delanoë committed
71 72
            , openNodes
            , reload
73
            , root
74
            , session
75 76 77 78 79 80 81 82 83 84
            } _children = do
          pure $ treeLoadView { asyncTasks
                              , frontends
                              , handed
                              , mCurrentRoute
                              , openNodes
                              , reload
                              , root
                              , session
                              }
85

86
treeLoadView :: Record Props -> R.Element
87
treeLoadView p = R.createElement treeLoadViewCpt p []
88
  where
89
    treeLoadViewCpt :: R.Component Props
90
    treeLoadViewCpt = R.hooksComponentWithModule thisModule "treeLoadView" cpt
91
      where
92
        cpt { asyncTasks
Alexandre Delanoë's avatar
Alexandre Delanoë committed
93
            , frontends
94
            , handed
95
            , mCurrentRoute
Alexandre Delanoë's avatar
Alexandre Delanoë committed
96 97
            , openNodes
            , reload
98
            , root
99
            , session
Alexandre Delanoë's avatar
Alexandre Delanoë committed
100
            } _children = do
101
          let fetch _ = getNodeTree session root
102
          let paint loaded = loadedTreeView { asyncTasks
Alexandre Delanoë's avatar
Alexandre Delanoë committed
103
                                            , frontends
104
                                            , handed
105
                                            , mCurrentRoute
Alexandre Delanoë's avatar
Alexandre Delanoë committed
106 107
                                            , openNodes
                                            , reload
108
                                            , session
109
                                            -- , tasks: tasksStruct root asyncTasks reload
Alexandre Delanoë's avatar
Alexandre Delanoë committed
110
                                            , tree: loaded
111
                                            }
Alexandre Delanoë's avatar
Alexandre Delanoë committed
112
          useLoader { root, counter: fst reload } fetch paint
113

114 115 116 117 118
--------------
getNodeTree :: Session -> GT.ID -> Aff FTree
getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""

--------------
119 120 121 122 123
type TreeViewProps = (
    asyncTasks :: GAT.Reductor
  , tree       :: FTree
  | CommonProps
  )
124

125
loadedTreeView :: Record TreeViewProps -> R.Element
126
loadedTreeView p = R.createElement loadedTreeViewCpt p []
127
  where
128
    loadedTreeViewCpt :: R.Component TreeViewProps
129
    loadedTreeViewCpt = R.hooksComponentWithModule thisModule "loadedTreeView" cpt
130
      where
Alexandre Delanoë's avatar
Alexandre Delanoë committed
131 132
        cpt { asyncTasks
            , frontends
133
            , handed
Alexandre Delanoë's avatar
Alexandre Delanoë committed
134 135 136
            , mCurrentRoute
            , openNodes
            , reload
137
            , session
138
            -- , tasks
Alexandre Delanoë's avatar
Alexandre Delanoë committed
139
            , tree
140 141 142 143 144 145 146 147 148 149 150 151 152 153 154
          } _ = do
          pure $ H.ul { className: "tree" } [
            H.div { className: if handed == GT.RightHanded then "righthanded" else "lefthanded" } [
               toHtml { asyncTasks
                      , frontends
                      , handed
                      , mCurrentRoute
                      , openNodes
                      , reload
                      , session
                        -- , tasks
                      , tree
                      }
               ]
            ]
155

156
------------------------------------------------------------------------
157 158


159 160
type ToHtmlProps = (
    asyncTasks :: GAT.Reductor
161
  -- , tasks      :: Record Tasks
162
  , tree       :: FTree
163
  | CommonProps
164 165 166
  )

toHtml :: Record ToHtmlProps -> R.Element
167 168 169 170
toHtml p = R.createElement toHtmlCpt p []

toHtmlCpt :: R.Component ToHtmlProps
toHtmlCpt = R.hooksComponentWithModule thisModule "nodeView" cpt
Alexandre Delanoë's avatar
Alexandre Delanoë committed
171
    where
172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187
      cpt p@{ asyncTasks
            , frontends
            , handed
            , mCurrentRoute
            , openNodes
            , reload: reload@(_ /\ setReload)
            , session
            , tree: tree@(NTree (LNode { id
                                       , name
                                       , nodeType
                                       }
                                ) ary
                         )
            } _ = do
        let commonProps = RecordE.pick p :: Record CommonProps
        let pAction a   = performAction a (RecordE.pick p :: Record PerformActionProps)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
188 189 190 191 192 193 194 195 196

        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'

197
        pure $ H.li { className: if A.null ary then "no-children" else "with-children" } $
198 199
          [ nodeMainSpan { appReload: reload
                         , asyncTasks
200
                         , dispatch: pAction
201 202
                         , folderOpen
                         , frontends
203
                         , handed
204
                         , id
205
                         , isLeaf: A.null ary
206 207 208 209
                         , mCurrentRoute
                         , name
                         , nodeType
                         , session
210
                         -- , tasks
211 212 213
                         } ]
          <> childNodes ( Record.merge commonProps
                          { asyncTasks
214
                          , children: if isPublic nodeType
215 216 217
                                         then map (\t -> map (\(LNode n@{ nodeType:nt } )
                                                               -> (LNode (n { nodeType= publicize nt }))
                                                            ) t) ary
218
                                         else ary
219
                          , folderOpen
220
                          , handed
221 222
                          }
                        )
223

224

225
type ChildNodesProps =
226
  ( asyncTasks :: GAT.Reductor
227
  , children   :: Array FTree
228 229
  , folderOpen :: R.State Boolean
  | CommonProps
230 231 232
  )

childNodes :: Record ChildNodesProps -> Array R.Element
233 234
childNodes { children: []                       } = []
childNodes { folderOpen: (false /\ _)           } = []
235
childNodes props@{ asyncTasks, children, reload, handed } =
236
  map (\ctree@(NTree (LNode {id}) _) -> H.ul {} [
Alexandre Delanoë's avatar
Alexandre Delanoë committed
237
        toHtml (Record.merge commonProps { asyncTasks
238
                                         , handed
239
                                         -- , tasks: tasksStruct id asyncTasks reload
Alexandre Delanoë's avatar
Alexandre Delanoë committed
240 241
                                         , tree: ctree
                                         }
242
               )]
Alexandre Delanoë's avatar
Alexandre Delanoë committed
243
      ) $ sorted children
244 245 246 247
  where
    commonProps = RecordE.pick props :: Record CommonProps
    sorted :: Array FTree -> Array FTree
    sorted = A.sortWith (\(NTree (LNode {id}) _) -> id)
248 249

type PerformActionProps =
250 251
  ( asyncTasks :: GAT.Reductor
  , openNodes :: R.State OpenNodes
252 253
  , reload    :: R.State Reload
  , session   :: Session
254
  -- , tasks     :: Record Tasks
255
  , tree      :: FTree
256
  )
257

Alexandre Delanoë's avatar
Alexandre Delanoë committed
258
-------
259 260
performAction :: Action
              -> Record PerformActionProps
261
              -> Aff Unit
262
performAction (DeleteNode nt) p@{ openNodes: (_ /\ setOpenNodes)
263 264 265 266
                                , reload: (_ /\ setReload)
                                , session
                                , tree: (NTree (LNode {id, parent_id}) _)
                                } =
267
  do
268 269 270 271 272
    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

273
    liftEffect $ setOpenNodes (Set.delete (mkNodeId session id))
274 275
    performAction RefreshTree p

Alexandre Delanoë's avatar
Alexandre Delanoë committed
276
-------
277
performAction (DoSearch task) { asyncTasks: (_ /\ dispatch)
278 279 280 281
                              , session
                              , tree: (NTree (LNode {id}) _)
                              }  =
  do
282
    liftEffect $ dispatch $ GAT.Insert id task
283 284
    liftEffect $ log2 "[performAction] DoSearch task:" task

Alexandre Delanoë's avatar
Alexandre Delanoë committed
285
-------
286
performAction (UpdateNode params) { asyncTasks: (_ /\ dispatch)
287 288 289
                                  , session
                                  , tree: (NTree (LNode {id}) _)
                                  } =
290
  do
291
    task <- updateRequest params session id
292
    liftEffect $ dispatch $ GAT.Insert id task
293 294
    liftEffect $ log2 "[performAction] UpdateNode task:" task

Alexandre Delanoë's avatar
Alexandre Delanoë committed
295 296

-------
297
performAction (RenameNode name) p@{ reload: (_ /\ setReload)
298 299 300
                                  , session
                                  , tree: (NTree (LNode {id}) _)
                                  } =
301 302 303 304
  do
    void $ rename session id $ RenameValue {text:name}
    performAction RefreshTree p

Alexandre Delanoë's avatar
Alexandre Delanoë committed
305
-------
306
performAction (ShareTeam username) p@{ reload: (_ /\ setReload)
307 308 309 310
                                     , session
                                     , tree: (NTree (LNode {id}) _)
                                     } =
  do
311
    void $ Share.shareReq session id $ Share.ShareTeamParams {username}
312

313

314 315 316
performAction (SharePublic {params}) p@{ session
                                       , openNodes: (_ /\ setOpenNodes)
                                       } =
317 318 319 320
  case params of
    Nothing -> performAction NoAction p
    Just (SubTreeOut {in:inId,out}) -> do
      void $ Share.shareReq session inId $ Share.SharePublicParams {node_id:out}
321
      liftEffect $ setOpenNodes (Set.insert (mkNodeId session out))
322
      performAction RefreshTree p
323

324 325 326 327 328 329 330 331 332

performAction (AddContact params) p@{ reload: (_ /\ setReload)
                                     , session
                                     , tree: (NTree (LNode {id}) _)
                                     } =
    void $ Contact.contactReq session id params



Alexandre Delanoë's avatar
Alexandre Delanoë committed
333
-------
334 335 336 337 338 339 340
performAction (AddNode name nodeType) p@{ openNodes: (_ /\ setOpenNodes)
                                        , reload:    (_ /\ setReload)
                                        , session
                                        , tree: (NTree (LNode {id}) _)
                                        } =
  do
    task <- addNode session id $ AddNodeValue {name, nodeType}
341
    liftEffect $ setOpenNodes (Set.insert (mkNodeId session id))
342 343
    performAction RefreshTree p

Alexandre Delanoë's avatar
Alexandre Delanoë committed
344
-------
345 346
performAction (UploadFile nodeType fileType mName blob) { asyncTasks: (_ /\ dispatch)
                                                        , session
347 348
                                                        , tree: (NTree (LNode {id}) _)
                                                        } =
349
  do
350
    task <- uploadFile session nodeType id fileType {mName, blob}
351
    liftEffect $ dispatch $ GAT.Insert id task
352
    liftEffect $ log2 "Uploaded, task:" task
353

354 355
performAction (UploadArbitraryFile mName blob) { asyncTasks: (_ /\ dispatch)
                                               , session
356 357
                                               , tree: (NTree (LNode {id}) _)
                                               } =
358
  do
359
    task <- uploadArbitraryFile session id { blob, mName }
360
    liftEffect $ dispatch $ GAT.Insert id task
361
    liftEffect $ log2 "Uploaded, task:" task
362

Alexandre Delanoë's avatar
Alexandre Delanoë committed
363
-------
364 365 366
performAction DownloadNode _ = do
    liftEffect $ log "[performAction] DownloadNode"
-------
367 368 369 370 371 372
performAction (MoveNode {params}) p@{session} =
  case params of
    Nothing -> performAction NoAction p
    Just (SubTreeOut {in:in',out}) -> do
      void $ moveNodeReq session in' out
      performAction RefreshTree p
373

374 375 376 377 378 379
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
380

381
performAction (LinkNode {nodeType, params}) p@{session} = do
382 383 384
  case params of
    Nothing -> performAction NoAction p
    Just (SubTreeOut {in:in',out}) -> do
385
      void $ linkNodeReq session nodeType in' out
386
      performAction RefreshTree p
387

388
-------
389
performAction RefreshTree { reload: (_ /\ setReload) } = do
390
  liftEffect $ setReload (_ + 1)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
391
-------
392 393 394
performAction NoAction _ = do
    liftEffect $ log "[performAction] NoAction"