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

James Laver's avatar
James Laver committed
3
import Gargantext.Prelude
4

5 6
import Data.Maybe (Maybe(..))
import Data.Nullable (null)
James Laver's avatar
James Laver committed
7
import Data.Symbol (SProxy(..))
8
import Effect (Effect)
9 10
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
11
import Gargantext.AsyncTasks as GAT
12
import Gargantext.Components.App.Data (Boxes)
13
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
14
import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), fileTypeView)
15
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..))
16
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
17 18
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Tools (nodeLink)
19 20 21 22 23
import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (asyncProgressBar, BarType(..))
import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, nodeActionsNodeList)
import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Components.Lang (Lang(EN))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
24
import Gargantext.Config.REST (logRESTError)
25
import Gargantext.Ends (Frontends)
26 27 28
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId)
29
import Gargantext.Types (ID, Name, reverseHanded)
30 31 32
import Gargantext.Types as GT
import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2
James Laver's avatar
James Laver committed
33
import Gargantext.Utils.Toestand as T2
34
import Gargantext.Version as GV
35 36 37 38 39
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
40

James Laver's avatar
James Laver committed
41 42
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node"
43

44
-- Main Node
James Laver's avatar
James Laver committed
45
type NodeMainSpanProps =
46 47 48 49 50 51 52 53 54
  ( boxes         :: Boxes
  , dispatch      :: Action -> Aff Unit
  , folderOpen    :: T.Box Boolean
  , frontends     :: Frontends
  , id            :: ID
  , isLeaf        :: IsLeaf
  , name          :: Name
  , nodeType      :: GT.NodeType
  , reload        :: T2.ReloadS
55
  , root          :: ID
56 57
  , session       :: Session
  , setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
58 59
  )

60 61
type IsLeaf = Boolean

62 63
nodeSpan :: R2.Component NodeMainSpanProps
nodeSpan = R.createElement nodeSpanCpt
64
nodeSpanCpt :: R.Component NodeMainSpanProps
James Laver's avatar
James Laver committed
65
nodeSpanCpt = here.component "nodeSpan" cpt
66
  where
67 68 69
    cpt props@{ boxes: { handed } } children = do
      handed' <- T.useLive T.unequal handed
      let className = case handed' of
70 71 72 73
            GT.LeftHanded  -> "lefthanded"
            GT.RightHanded -> "righthanded"

      pure $ H.div { className } ([ nodeMainSpan props [] ] <> children)
74 75 76

nodeMainSpan :: R2.Component NodeMainSpanProps
nodeMainSpan = R.createElement nodeMainSpanCpt
77
nodeMainSpanCpt :: R.Component NodeMainSpanProps
James Laver's avatar
James Laver committed
78
nodeMainSpanCpt = here.component "nodeMainSpan" cpt
79
  where
80 81 82 83 84 85 86
    cpt props@{ boxes: boxes@{ errors
                             , handed
                             , reloadMainPage
                             , reloadRoot
                             , route
                             , tasks }
              , dispatch
87 88 89 90 91
              , folderOpen
              , frontends
              , id
              , isLeaf
              , nodeType
92
              , reload
93
              , session
94
              , setPopoverRef
95
              } _ = do
96
      handed' <- T.useLive T.unequal handed
97
      route' <- T.useLive T.unequal route
98
      -- only 1 popup at a time is allowed to be opened
99 100 101 102
      droppedFile   <- T.useBox (Nothing :: Maybe DroppedFile)
      droppedFile'  <- T.useLive T.unequal droppedFile
      isDragOver    <- T.useBox false
      isDragOver'   <- T.useLive T.unequal isDragOver
103
      popoverRef    <- R.useRef null
104

105 106 107
      currentTasks <- GAT.focus id tasks
      currentTasks' <- T.useLive T.unequal currentTasks

108 109
      R.useEffect' $ do
        R.setRef setPopoverRef $ Just $ Popover.setOpen popoverRef
110
      let isSelected = Just route' == Routes.nodeTypeAppRoute nodeType (sessionId session) id
111

112
      -- tasks' <- T.read tasks
113

114
      pure $ H.span (dropProps droppedFile droppedFile' isDragOver isDragOver')
115
        $ reverseHanded handed'
116
        [ folderIcon  { folderOpen, nodeType } []
117
        , chevronIcon { folderOpen, handed, isLeaf } []
118
        , nodeLink { boxes
119
                   , folderOpen
120
                   , frontends
121 122 123 124 125
                   , id
                   , isSelected
                   , name: name' props
                   , nodeType
                   , session } []
126

127
                , fileTypeView { dispatch, droppedFile, id, isDragOver, nodeType } []
128
                , H.div {} (map (\t -> asyncProgressBar { asyncTask: t
129
                                                        , barType: Pie
130 131 132 133
                                                        , errors
                                                        , nodeId: id
                                                        , onFinish: onTaskFinish id t
                                                        , session } []
134
                                ) currentTasks'
135
                           )
136
                , if nodeType == GT.NodeUser
137
                        then GV.versionView { session } []
138 139 140 141 142 143 144 145 146 147 148 149 150 151
                        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
152
                              , nodeType
153
                              , refresh: const $ dispatch RefreshTree
154
                              , session
155
                              } []
156
                ]
157
        where
158
          onTaskFinish id' t _ = do
159
            GAT.finish id' t tasks
160 161 162 163
            if GAT.asyncTaskTTriggersAppReload t then do
              here.log2 "reloading root for task" t
              T2.reload reloadRoot
            else do
164 165 166 167 168 169 170 171 172 173 174 175
              if GAT.asyncTaskTTriggersTreeReload t then do
                here.log2 "reloading tree for task" t
                T2.reload reload
              else do
                here.log2 "task doesn't trigger a tree reload" t
                pure unit
              if GAT.asyncTaskTTriggersMainPageReload t then do
                here.log2 "reloading main page for task" t
                T2.reload reloadMainPage
              else do
                here.log2 "task doesn't trigger a main page reload" t
                pure unit
176
            -- snd tasks $ GAT.Finish id' t
177 178 179 180
            -- mT <- T.read tasks
            -- case mT of
            --   Just t' -> snd t' $ GAT.Finish id' t
            --   Nothing -> pure unit
181
            -- T2.reload reloadRoot
182

183 184 185
          SettingsBox {show: showBox} = settingsBox nodeType
          onPopoverClose popoverRef _ = Popover.setOpen popoverRef false

186
          name' {name: n, nodeType: nt} = if nt == GT.NodeUser then show session else n
187

188 189 190 191 192 193 194 195
          mNodePopupView props'@{ boxes: b, id: i, nodeType: nt } opc =
            nodePopupView { boxes: b
                          , dispatch
                          , id: i
                          , name: name' props'
                          , nodeType: nt
                          , onPopoverClose: opc
                          , session }
196

James Laver's avatar
James Laver committed
197 198 199 200
    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." } []
201 202
    dropProps droppedFile droppedFile' isDragOver isDragOver' =
      { className: "leaf " <> (dropClass droppedFile' isDragOver')
203
      , on: { dragLeave: onDragLeave isDragOver
204
            , dragOver: onDragOverHandler isDragOver
205
            , drop: dropHandler }
206
      }
207
      where
208 209 210 211
        dropClass (Just _) _    = "file-dropped"
        dropClass _        true = "file-dropped"
        dropClass Nothing  _    = ""

212
        dropHandler e = do
213 214 215 216 217
          -- prevent redirection when file is dropped
          E.preventDefault e
          E.stopPropagation e
          blob <- R2.dataTransferFileBlob e
          void $ launchAff do
218
            --contents <- readAsText blob
219 220 221 222 223 224
            liftEffect $ do
              T.write_ (Just
                       $ DroppedFile { blob: (UploadFileBlob blob)
                                     , fileType: Just CSV
                                     , lang    : EN
                                     }) droppedFile
225
    onDragOverHandler isDragOver e = do
226 227 228 229
      -- prevent redirection when file is dropped
      -- https://stackoverflow.com/a/6756680/941471
      E.preventDefault e
      E.stopPropagation e
230 231
      T.write_ true isDragOver
    onDragLeave isDragOver _ = T.write_ false isDragOver
232

233
type FolderIconProps = (
234
    folderOpen :: T.Box Boolean
235 236 237 238 239 240 241 242 243
  , nodeType   ::  GT.NodeType
  )

folderIcon :: R2.Component FolderIconProps
folderIcon = R.createElement folderIconCpt
folderIconCpt :: R.Component FolderIconProps
folderIconCpt = here.component "folderIcon" cpt
  where
    cpt { folderOpen, nodeType } _ = do
244
      open <- T.useLive T.unequal folderOpen
245
      pure $ H.a { className: "folder-icon", on: { click: \_ -> T.modify_ not folderOpen } }
246 247 248
        [ H.i { className: GT.fldr nodeType open } [] ]

type ChevronIconProps = (
249
    folderOpen :: T.Box Boolean
250
  , handed     :: T.Box GT.Handed
251 252 253 254 255 256 257 258
  , isLeaf     :: Boolean
  )

chevronIcon :: R2.Component ChevronIconProps
chevronIcon = R.createElement chevronIconCpt
chevronIconCpt :: R.Component ChevronIconProps
chevronIconCpt = here.component "chevronIcon" cpt
  where
259
    cpt { isLeaf: true } _ = do
260
      pure $ H.div {} []
261
    cpt { folderOpen, handed, isLeaf: false } _ = do
262
      handed' <- T.useLive T.unequal handed
263
      open <- T.useLive T.unequal folderOpen
264
      pure $ H.a { className: "chevron-icon"
265
          , on: { click: \_ -> T.modify_ not folderOpen }
266 267 268
          }
        [ H.i { className: if open
                            then "fa fa-chevron-down"
269
                            else if handed' == GT.RightHanded
270 271 272 273
                                    then "fa fa-chevron-right"
                                    else "fa fa-chevron-left"
                } [] ]

274
{-
275 276 277
fldr nt open = if open
               then "fa fa-globe" -- <> color nt
               else "fa fa-folder-globe" -- <> color nt
278
               --else "fa fa-folder-close" <> color nt
279 280 281 282 283
                 where
                   color GT.NodeUser     = ""
                   color FolderPublic = ""
                   color FolderShared = " text-warning"
                   color _            = " text-danger"
284
-}
285 286


287
-- START nodeActions
288

James Laver's avatar
James Laver committed
289 290 291
type NodeActionsCommon =
  ( id       :: ID
  , refresh  :: Unit -> Aff Unit
292
  , session  :: Session
293
  )
294

James Laver's avatar
James Laver committed
295 296
type NodeActionsProps = ( nodeType :: GT.NodeType | NodeActionsCommon )

297 298
nodeActions :: R2.Component NodeActionsProps
nodeActions = R.createElement nodeActionsCpt
299

300
nodeActionsCpt :: R.Component NodeActionsProps
James Laver's avatar
James Laver committed
301 302 303 304 305 306 307 308 309 310 311 312 313
nodeActionsCpt = here.component "nodeActions" cpt where
  cpt props _ = pure (child props.nodeType) where
    nodeActionsP = SProxy :: SProxy "nodeType"
    childProps = Record.delete nodeActionsP props
    child GT.NodeList = listNodeActions childProps
    child GT.Graph = graphNodeActions childProps
    child _ = H.div {} []

graphNodeActions :: R2.Leaf NodeActionsCommon
graphNodeActions props = R.createElement graphNodeActionsCpt props []
graphNodeActionsCpt :: R.Component NodeActionsCommon
graphNodeActionsCpt = here.component "graphNodeActions" cpt where
  cpt { id, session, refresh } _ =
314 315 316 317
    useLoader { errorHandler
              , loader: graphVersions session
              , path: id
              , render: \gv -> nodeActionsGraph { graphVersions: gv, session, id, refresh } [] }
James Laver's avatar
James Laver committed
318
  graphVersions session graphId = GraphAPI.graphVersions { graphId, session }
319
  errorHandler = logRESTError here "[graphNodeActions]"
James Laver's avatar
James Laver committed
320 321 322 323 324 325

listNodeActions :: R2.Leaf NodeActionsCommon
listNodeActions props = R.createElement listNodeActionsCpt props []
listNodeActionsCpt :: R.Component NodeActionsCommon
listNodeActionsCpt = here.component "listNodeActions" cpt where
  cpt { id, session, refresh } _ =
326 327 328 329 330 331 332
    useLoader { errorHandler
              , path: { nodeId: id, session }
              , loader: loadCorpusWithChild
              , render: \{ corpusId } -> nodeActionsNodeList
                 { listId: id, nodeId: corpusId, session, refresh: refresh
                 , nodeType: GT.TabNgramType GT.CTabTerms } }
    where
333
      errorHandler = logRESTError here "[listNodeActions]"
334