FolderView.purs 15.2 KB
Newer Older
1 2 3
module Gargantext.Components.FolderView where

import Data.Array as A
4
import Data.Either (Either)
5
import Data.Maybe (Maybe(..), fromMaybe)
6
import Data.Nullable (null)
7
import Data.Traversable (traverse_)
8
import Effect (Effect)
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 Toestand as T

16
import Gargantext.AsyncTasks as GAT
17
import Gargantext.Components.App.Data (Boxes)
18 19 20 21 22 23 24 25
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode, unpublishNode)
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)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename)
import Gargantext.Components.Forest.Tree.Node.Action.Share as Share
26
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
27 28 29
import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryFile, uploadFile)
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
30
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), ID, fTreeID)
31
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
32
import Gargantext.Config.REST (RESTError)
33
import Gargantext.Config.Utils (handleRESTError)
34
import Gargantext.Hooks.Loader (useLoader)
35
import Gargantext.Prelude (Ordering, Unit, bind, compare, discard, pure, unit, void, ($), (<$>), (<>))
36 37
import Gargantext.Routes (AppRoute(Home), SessionRoute(..), appPath, nodeTypeAppRoute)
import Gargantext.Sessions (Session, get, sessionId)
38
import Gargantext.Types (NodeType(..))
39
import Gargantext.Types as GT
40
import Gargantext.Utils.Popover as Popover
41
import Gargantext.Utils.Reactix as R2
42
import Gargantext.Utils.Toestand as T2
43

44
foreign import back :: Effect Unit
45
foreign import link :: String -> Effect Unit
46

47 48 49 50
here :: R2.Here
here = R2.here "Gargantext.Components.FolderView"

type Props =
51 52 53 54
  ( backFolder :: Boolean
  , boxes      :: Boxes
  , nodeId     :: Int
  , session    :: Session
55 56 57 58
  )

data FolderStyle = FolderUp | FolderChild

59 60 61 62
folderView :: R2.Leaf Props
folderView props = R.createElement folderViewCpt props []
folderViewCpt :: R.Component Props
folderViewCpt = here.component "folderViewCpt" cpt where
63
  cpt { backFolder, boxes, nodeId, session } _ = do
64 65 66
    setPopoverRef <- R.useRef Nothing
    reload <- T.useBox T2.newReload
    reload' <- T.useLive T.unequal reload
67 68 69
    useLoader { errorHandler
              , loader: loadFolders
              , path: { nodeId, session, reload: reload'}
70
              , render: \folders -> folderViewMain { backFolder
71
                                                   , boxes
72 73 74
                                                   , folders
                                                   , nodeId
                                                   , reload
75
                                                   , session
76
                                                   , setPopoverRef } [] }
77 78
    where
      errorHandler err = here.log2 "[folderView] RESTError" err
79

80
type FolderViewProps =
81
  ( backFolder    :: Boolean
82
  , boxes         :: Boxes
83 84 85 86
  , folders       :: FTree
  , nodeId        :: Int
  , reload        :: T.Box T2.Reload
  , session       :: Session
87
  , setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
88 89
  )

90 91
folderViewMain :: R2.Component FolderViewProps
folderViewMain = R.createElement folderViewMainCpt
92 93
folderViewMainCpt :: R.Component FolderViewProps
folderViewMainCpt = here.component "folderViewMainCpt" cpt where
94
  cpt { backFolder
95
      , boxes
96 97 98 99
      , folders: NTree (LNode {parent_id: parentId, nodeType}) (folders)
      , nodeId
      , reload
      , session
100
      , setPopoverRef } _ = do
101
    let foldersS = A.sortBy sortFolders folders
102
    let backHome = isBackHome nodeType
103
    let parent = makeParentFolder parentId session backFolder backHome
104
    let children = makeFolderElements foldersS { boxes, nodeId, reload, session, setPopoverRef }
105

Karen Konou's avatar
Karen Konou committed
106
    pure $ H.div {className: "fv folders"} $ parent <> children
107

108
  makeFolderElements foldersS props = makeFolderElementsMap <$> foldersS where
109
    makeFolderElementsMap :: NTree LNode -> R.Element
110
    makeFolderElementsMap (NTree (LNode node) _) = folder { boxes: props.boxes
111 112 113
                                                          , nodeId: node.id
                                                          , nodeType: node.nodeType
                                                          , parentId: props.nodeId
114
                                                          , reload: props.reload
115 116 117 118
                                                          , session: props.session
                                                          , setPopoverRef: props.setPopoverRef
                                                          , style: FolderChild
                                                          , text: node.name } []
119 120 121

  makeParentFolder :: Maybe Int -> Session -> Boolean -> Boolean -> Array R.Element
  makeParentFolder (Just parentId) session _ _ =
122 123
    -- FIXME: The NodeType here should not be hardcoded to FolderPrivate but we currently can't get the actual NodeType
    -- without performing another API call. Also parentId is never being returned by this API even when it clearly exists
124
    [ folderSimple {style: FolderUp, text: "..", nodeId: parentId, nodeType: GT.FolderPrivate, session: session} [] ]
125
  makeParentFolder Nothing _ _ true = [ H.a {className: "btn btn-primary", href: appPath Home} [ H.i { className: "fa fa-folder-open" } []
126 127
                                                                   , H.br {}
                                                                   , H.text ".."] ]
128 129 130 131
  makeParentFolder Nothing _ true _ = [ H.button {className: "btn btn-primary", on: { click: back } }  [ H.i { className: "fa fa-folder-open" } []
                                                                   , H.br {}
                                                                   , H.text ".."] ]
  makeParentFolder Nothing _ _ _ = []
132 133 134 135 136


  sortFolders :: FTree -> FTree -> Ordering
  sortFolders a b = compare (fTreeID a) (fTreeID b)

137 138 139 140 141 142
  isBackHome :: GT.NodeType -> Boolean
  isBackHome GT.FolderPrivate = true
  isBackHome GT.FolderPublic = true
  isBackHome GT.FolderShared = true
  isBackHome _ = false

143

144
type FolderSimpleProps =
145 146 147
  (
    style :: FolderStyle
  , text :: String
148
  , nodeType :: GT.NodeType
149
  , nodeId :: Int
150
  , session :: Session
151 152
  )

153 154 155 156 157
folderSimple :: R2.Component FolderSimpleProps
folderSimple = R.createElement folderSimpleCpt

folderSimpleCpt :: R.Component FolderSimpleProps
folderSimpleCpt = here.component "folderSimpleCpt" cpt where
158 159
  cpt {style, text, nodeId, session, nodeType} _ = do
    let sid = sessionId session
160 161 162 163 164
    pure $ H.a { className: "btn btn-primary"
               , href: "/#/" <> getFolderPath nodeType sid nodeId }
      [ H.i { className: icon style nodeType } []
      , H.br {}
      , H.text text ]
165

166
  icon :: FolderStyle -> GT.NodeType -> String
167
  icon FolderUp _ = "fa fa-folder-open"
168
  icon _ nodeType = GT.fldr nodeType false
169

170
  getFolderPath :: GT.NodeType -> GT.SessionId -> Int -> String
171 172
  getFolderPath nodeType sid nodeId = appPath $ fromMaybe Home $ nodeTypeAppRoute nodeType sid nodeId

173
type FolderProps =
174
  ( boxes         :: Boxes
175 176 177
  , parentId      :: Int
  , reload        :: T.Box T2.Reload
  , setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
178 179 180
  | FolderSimpleProps
  )

181 182 183 184
folder :: R2.Component FolderProps
folder = R.createElement folderCpt
folderCpt :: R.Component FolderProps
folderCpt = here.component "folderCpt" cpt where
185 186 187 188 189 190 191 192 193
  cpt props@{ boxes
            , nodeId
            , nodeType
            , parentId
            , reload
            , session
            , setPopoverRef
            , style
            , text } _ = do
194
    let sid = sessionId session
195
    let dispatch a = performAction a { boxes, nodeId, parentId, reload, session, setPopoverRef }
196 197 198 199 200
    popoverRef <- R.useRef null

    R.useEffect' $ do
        R.setRef setPopoverRef $ Just $ Popover.setOpen popoverRef

201
    pure $
202 203
        H.div {} [
        H.span{style: {position: "absolute"}} [ Popover.popover {
204 205 206 207
            arrow: false
          , open: false
          , onClose: \_ -> pure unit
          , onOpen:  \_ -> pure unit
208
          , ref: popoverRef
209
          } [
210
              popOverIcon
211
              , mNodePopupView (Record.merge props { dispatch }) (onPopoverClose popoverRef)
212
              ]]
213
      , H.button {on: {click: link ("/#/" <> getFolderPath nodeType sid nodeId) }, className: "btn btn-primary fv btn" } [
214
          H.i {className: icon style nodeType} []
215
        , H.br {}
216
        , H.text text]]
217 218


219
  icon :: FolderStyle -> GT.NodeType -> String
220
  icon FolderUp _ = "fa fa-folder-open"
221
  icon _ nodeType = GT.fldr nodeType false
222

223
  getFolderPath :: GT.NodeType -> GT.SessionId -> Int -> String
224 225
  getFolderPath nodeType sid nodeId = appPath $ fromMaybe Home $ nodeTypeAppRoute nodeType sid nodeId

226 227
  onPopoverClose popoverRef _ = Popover.setOpen popoverRef false

228
  popOverIcon = H.span { className: "fv action" } [
229
        H.a { className: "settings fa fa-cog"
230
          , title : "Each node of the Tree can perform some actions.\n"
231
            <> "Click here to execute one of them." } []
232 233
      ]

234
  mNodePopupView props opc = nodePopupView { boxes: props.boxes
235 236
                                           , dispatch: props.dispatch
                                           , id: props.nodeId
237 238 239
                                           , onPopoverClose: opc
                                           , nodeType: props.nodeType
                                           , name: props.text
240 241
                                           , session: props.session
                                           }
242

243
backButton :: R.Element
244
backButton =
245 246 247 248
  H.button {
    className: "btn btn-primary"
  , on: {click: back}
  } [
249
    H.i { className: "fa fa-arrow-left", title: "Previous view"} []
250 251
  ]

252 253 254 255 256 257 258
type LoadProps =
  (
    session :: Session,
    nodeId :: Int,
    reload :: T2.Reload
  )

259
loadFolders :: Record LoadProps -> Aff (Either RESTError FTree)
260
loadFolders {nodeId, session} = get session $ TreeFirstLevel (Just nodeId) ""
261 262

type PerformActionProps =
263
  ( boxes         :: Boxes
264 265 266 267 268
  , nodeId        :: Int
  , parentId      :: Int
  , reload        :: T.Box T2.Reload
  , setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
  , session       :: Session
269 270 271 272 273 274 275 276 277 278 279 280
  )

performAction :: Action -> Record PerformActionProps -> Aff Unit
performAction = performAction' where
  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
281 282 283 284
  performAction' (UploadFile nodeType fileType mName contents selection) p =
    uploadFile' nodeType fileType mName contents p selection
  performAction' (UploadArbitraryFile mName blob selection) p =
    uploadArbitraryFile' mName blob p selection
285
  performAction' DownloadNode _ = liftEffect $ here.log "[performAction] DownloadNode"
286 287 288
  performAction' (MoveNode {params}) p = moveNode params p
  performAction' (MergeNode {params}) p = mergeNode params p
  performAction' (LinkNode { nodeType, params }) p = linkNode nodeType params p
289
  performAction' NoAction _ = liftEffect $ here.log "[performAction] NoAction"
290
  performAction' ClosePopover p = closePopover p
291
  performAction' _ _ = liftEffect $ here.log "[performAction] unsupported action"
292 293 294 295

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

296
  refreshFolders p@{ boxes: { reloadForest }, reload } = do
297 298
    liftEffect $ T2.reload reload
    liftEffect $ T2.reload reloadForest
299 300
    closePopover p

301
  deleteNode' nt p@{ nodeId: id, parentId: parent_id, session } = do
302
    case nt of
303
      NodePublic FolderPublic  -> void $ deleteNode session id
304
      NodePublic _             -> void $ unpublishNode session (Just parent_id) id
305
      _                        -> void $ deleteNode session id
306 307
    refreshFolders p

308
  doSearch task { boxes: { tasks }, nodeId: id } = liftEffect $ do
309
    GAT.insert id task tasks
310
    here.log2 "[performAction] DoSearch task:" task
311

312 313
  updateNode params { boxes: { errors, tasks }, nodeId: id, session } = do
    eTask <- updateRequest params session id
314
    handleRESTError errors eTask $ \task -> liftEffect $ do
315
      GAT.insert id task tasks
316
      here.log2 "[performAction] UpdateNode task:" task
317

318 319
  shareTeam username { boxes: { errors }, nodeId: id, session } = do
    eTask <- Share.shareReq session id $ Share.ShareTeamParams { username }
320
    handleRESTError errors eTask $ \_task -> pure unit
321

322
  sharePublic params p@{ boxes: { errors }, session } = traverse_ f params where
323
    f (SubTreeOut { in: inId, out }) = do
324
      eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out }
325
      handleRESTError errors eTask $ \_task -> pure unit
326 327
      refreshFolders p

328 329
  addContact params { nodeId: id, session } =
    void $ Contact.contactReq session id params
330

331 332
  uploadFile' nodeType fileType mName contents { boxes: { errors, tasks }, nodeId: id, session } selection = do
    eTask <- uploadFile { contents, fileType, id, nodeType, mName, selection, session }
333
    handleRESTError errors eTask $ \task -> liftEffect $ do
334
      GAT.insert id task tasks
335
      here.log2 "[performAction] UploadFile, uploaded, task:" task
336

337 338
  uploadArbitraryFile' mName blob { boxes: { errors, tasks }, nodeId: id, session } selection = do
    eTask <- uploadArbitraryFile session id { blob, mName } selection
339
    handleRESTError errors eTask $ \task -> liftEffect $ do
340
      GAT.insert id task tasks
341
      here.log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
342

343
  moveNode params p@{ boxes: { errors }, session } = traverse_ f params where
344
    f (SubTreeOut { in: in', out }) = do
345
      eTask <- moveNodeReq session in' out
346
      handleRESTError errors eTask $ \_task -> pure unit
347 348
      refreshFolders p

349
  mergeNode params p@{ boxes: { errors }, session } = traverse_ f params where
350
    f (SubTreeOut { in: in', out }) = do
351
      eTask <- mergeNodeReq session in' out
352
      handleRESTError errors eTask $ \_task -> pure unit
353 354
      refreshFolders p

355
  linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params where
356
    f (SubTreeOut { in: in', out }) = do
357
      eTask <- linkNodeReq session nodeType in' out
358
      handleRESTError errors eTask $ \_task -> pure unit
359 360
      refreshFolders p

361 362
  renameNode name p@{ boxes: { errors }, nodeId: id, session } = do
    eTask <- rename session id $ RenameValue { text: name }
363
    handleRESTError errors eTask $ \_task -> pure unit
364 365
    refreshFolders p

366 367
  addNode' name nodeType p@{ boxes: { errors }, nodeId: id, session } = do
    eTask <- addNode session id $ AddNodeValue {name, nodeType}
368
    handleRESTError errors eTask $ \_task -> pure unit
369
    refreshFolders p