Node.purs 10.4 KB
Newer Older
1
module Gargantext.Components.Forest.Tree.Node where
2

3
import Data.Array (reverse)
4 5
import Data.Maybe (Maybe(..))
import Data.Nullable (null)
6
import Data.Tuple (snd)
7
import Data.Tuple.Nested ((/\))
8
import Effect (Effect)
9 10
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
11 12 13 14
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H

15 16 17
import Gargantext.Prelude

import Gargantext.AsyncTasks as GAT
18
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
19
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
20
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..))
21
import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), fileTypeView)
22
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
23
import Gargantext.Components.Forest.Tree.Node.Box.Types (CommonProps)
24 25
import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (asyncProgressBar, BarType(..))
import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, nodeActionsNodeList)
26
import Gargantext.Components.Forest.Tree.Node.Tools (nodeLink)
27 28 29
import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Components.Lang (Lang(EN))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
30
import Gargantext.Ends (Frontends)
31 32
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
33
import Gargantext.Version as GV
34 35 36 37 38
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (Name, ID)
import Gargantext.Types as GT
import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2
39
import Gargantext.Utils.Reload as GUR
40

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

44
-- Main Node
45
type NodeMainSpanProps = (
46
    appReload     :: GUR.ReloadS
47
  , asyncTasks    :: GAT.Reductor
48
  , currentRoute  :: Routes.AppRoute
49 50
  , folderOpen    :: R.State Boolean
  , frontends     :: Frontends
51 52
  , id            :: ID
  , isLeaf        :: IsLeaf
53 54
  , name          :: Name
  , nodeType      :: GT.NodeType
55
  , setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
56 57 58
  | CommonProps
  )

59 60
type IsLeaf = Boolean

61 62
nodeSpan :: R2.Component NodeMainSpanProps
nodeSpan = R.createElement nodeSpanCpt
63

64 65 66
nodeSpanCpt :: R.Component NodeMainSpanProps
nodeSpanCpt = R.hooksComponentWithModule thisModule "nodeSpan" cpt
  where
67 68 69 70 71
    cpt props children = do
      pure $ H.div {} ([ nodeMainSpan props [] ] <> children)

nodeMainSpan :: R2.Component NodeMainSpanProps
nodeMainSpan = R.createElement nodeMainSpanCpt
72

73 74 75
nodeMainSpanCpt :: R.Component NodeMainSpanProps
nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
  where
76 77
    cpt props@{ appReload
              , asyncTasks: (asyncTasks /\ dispatchAsyncTasks)
78
              , currentRoute
79 80 81 82 83 84 85 86 87
              , dispatch
              , folderOpen
              , frontends
              , handed
              , id
              , isLeaf
              , name
              , nodeType
              , session
88
              , setPopoverRef
89
              } _ = do
90 91 92 93 94 95
      -- only 1 popup at a time is allowed to be opened
      droppedFile   <- R.useState' (Nothing :: Maybe DroppedFile)
      isDragOver    <- R.useState' false

      popoverRef    <- R.useRef null

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

99 100 101 102 103
      let ordering =
            case handed of
              GT.LeftHanded  -> reverse
              GT.RightHanded -> identity

104
      let isSelected = Just currentRoute == Routes.nodeTypeAppRoute nodeType (sessionId session) id
105

106
      pure $ H.span (dropProps droppedFile isDragOver)
107 108 109 110
                $ ordering
                [ folderIcon  nodeType folderOpen
                , chevronIcon isLeaf handed nodeType folderOpen
                , nodeLink { frontends
111
                           , handed
112
                           , folderOpen
113 114
                           , id
                           , isSelected
115 116 117
                           , name: name' props
                           , nodeType
                           , session
118
                           } []
119 120 121

                , fileTypeView { dispatch, droppedFile, id, isDragOver, nodeType }
                , H.div {} (map (\t -> asyncProgressBar { asyncTask: t
122 123
                                                       , barType: Pie
                                                       , nodeId: id
124
                                                       , onFinish: onTaskFinish id t
125 126 127
                                                       , session
                                                       }
                                ) $ GAT.getTasks asyncTasks id
128
                           )
129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
                , if nodeType == GT.NodeUser
                        then GV.versionView {session}
                        else H.div {} []

                , if showBox then
                        Popover.popover { arrow: false
                                        , open: false
                                        , onClose: \_ -> pure unit
                                        , onOpen:  \_ -> pure unit
                                        , ref: popoverRef } [
                        popOverIcon
                        , mNodePopupView props (onPopoverClose popoverRef)
                        ]
                else H.div {} []

                , nodeActions { id
145 146
                              , nodeType
                              , session
147
                              , triggerRefresh: const $ dispatch RefreshTree
148
                              }
149 150 151


                ]
152
        where
153
          onTaskFinish id t _ = do
154
            dispatchAsyncTasks $ GAT.Finish id t
155
            GUR.bump appReload
156

157 158 159 160 161 162 163 164 165 166 167 168 169 170 171
          SettingsBox {show: showBox} = settingsBox nodeType
          onPopoverClose popoverRef _ = Popover.setOpen popoverRef false

          name' {name, nodeType} = if nodeType == GT.NodeUser then show session else name

          mNodePopupView props@{id, nodeType} onPopoverClose =
                                nodePopupView { dispatch
                                              , handed : props.handed
                                              , id
                                              , name: name' props
                                              , nodeType
                                              , onPopoverClose
                                              , session
                                              }

172 173 174 175 176 177 178 179 180 181 182
    chevronIcon true handed' nodeType (open /\ setOpen) = H.div {} []
    chevronIcon false handed' nodeType (open /\ setOpen) =
      H.a { className: "chevron-icon"
          , on: { click: \_ -> setOpen $ not }
          }
        [ H.i { className: if open
                           then "fa fa-chevron-down"
                           else if handed' == GT.RightHanded
                                   then "fa fa-chevron-right"
                                   else "fa fa-chevron-left"
                } [] ]
183

184
    folderIcon nodeType (open /\ setOpen) =
185
      H.a { className: "folder-icon"
186
          , on: { click: \_ -> setOpen $ not }
187
          } [
188 189
              H.i {className: GT.fldr nodeType open} []
            ]
190

191 192 193 194
    popOverIcon = H.a { className: "settings fa fa-cog" 
                      , title : "Each node of the Tree can perform some actions.\n"
                             <> "Click here to execute one of them."
                      } []
195 196 197 198 199

    dropProps droppedFile isDragOver =
      { className: "leaf " <> (dropClass droppedFile isDragOver)
      , on: { drop: dropHandler droppedFile
            , dragOver: onDragOverHandler isDragOver
200 201
            , dragLeave: onDragLeave isDragOver }
      }
202 203 204 205 206 207 208 209 210 211
      where
        dropClass   (Just _  /\ _)        _          = "file-dropped"
        dropClass    _                   (true /\ _) = "file-dropped"
        dropClass   (Nothing /\ _)        _          = ""
        dropHandler (_ /\ setDroppedFile) e          = do
          -- prevent redirection when file is dropped
          E.preventDefault e
          E.stopPropagation e
          blob <- R2.dataTransferFileBlob e
          void $ launchAff do
212
            --contents <- readAsText blob
213 214 215
            liftEffect $ setDroppedFile
                       $ const
                       $ Just
216
                       $ DroppedFile { blob: (UploadFileBlob blob)
217 218 219 220 221 222 223 224 225 226
                                     , fileType: Just CSV
                                     , lang    : EN
                                     }
    onDragOverHandler (_ /\ setIsDragOver) e = do
      -- prevent redirection when file is dropped
      -- https://stackoverflow.com/a/6756680/941471
      E.preventDefault e
      E.stopPropagation e
      setIsDragOver $ const true
    onDragLeave (_ /\ setIsDragOver) _ = setIsDragOver $ const false
227 228

{-
229 230 231
fldr nt open = if open
               then "fa fa-globe" -- <> color nt
               else "fa fa-folder-globe" -- <> color nt
232
               --else "fa fa-folder-close" <> color nt
233 234 235 236 237
                 where
                   color GT.NodeUser     = ""
                   color FolderPublic = ""
                   color FolderShared = " text-warning"
                   color _            = " text-danger"
238
-}
239 240


241
-- START nodeActions
242

243 244 245 246
type NodeActionsProps =
  ( id          :: ID
  , nodeType    :: GT.NodeType
  , session     :: Session
247
  , triggerRefresh :: Unit -> Aff Unit
248
  )
249

250 251
nodeActions :: Record NodeActionsProps -> R.Element
nodeActions p = R.createElement nodeActionsCpt p []
252

253 254 255
nodeActionsCpt :: R.Component NodeActionsProps
nodeActionsCpt = R.hooksComponentWithModule thisModule "nodeActions" cpt
  where
256 257 258
    cpt { id
        , nodeType: GT.Graph
        , session
259
        , triggerRefresh
260
        } _ = do
261

262 263 264 265
      useLoader id (graphVersions session) $ \gv ->
        nodeActionsGraph { id
                         , graphVersions: gv
                         , session
266
                         , triggerRefresh
267
                         }
268

269 270 271
    cpt { id
        , nodeType: GT.NodeList
        , session
272
        , triggerRefresh
273 274 275 276 277 278 279
        } _ = do
      useLoader { nodeId: id, session } loadCorpusWithChild $
        \{ corpusId } ->
          nodeActionsNodeList { listId: id
                              , nodeId: corpusId
                              , nodeType: GT.TabNgramType GT.CTabTerms
                              , session
280
                              , triggerRefresh
281 282 283
                              }
    cpt _ _ = do
      pure $ H.div {} []
284

285 286 287 288
    graphVersions session graphId = GraphAPI.graphVersions { graphId, session }


-- END nodeActions