Node.purs 21.8 KB
Newer Older
arturo's avatar
arturo committed
1 2 3 4
module Gargantext.Components.Forest.Tree.Node
  ( nodeSpan
  , blankNodeSpan
  ) where
5

James Laver's avatar
James Laver committed
6
import Gargantext.Prelude
7

Karen Konou's avatar
Karen Konou committed
8
import DOM.Simple.Console (log2)
arturo's avatar
arturo committed
9
import Data.Array.NonEmpty as NArray
arturo's avatar
arturo committed
10
import Data.Foldable (intercalate)
11
import Data.Map as Map
Karen Konou's avatar
Karen Konou committed
12
import Data.Maybe (Maybe(..), maybe)
arturo's avatar
arturo committed
13
import Data.String.Regex as Regex
14
import Effect (Effect)
15 16
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
17
import Gargantext.AsyncTasks as GAT
18
import Gargantext.Components.App.Store as AppStore
arturo's avatar
arturo committed
19
import Gargantext.Components.Bootstrap as B
20
import Gargantext.Components.Bootstrap.Types (ComponentStatus(..), Elevation(..), TooltipEffect(..), Variant(..))
21
import Gargantext.Components.Corpus.CodeSection (loadCorpusWithChild)
22
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
23
import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), fileTypeView)
24
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..))
25
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
26
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
27 28 29
import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, nodeActionsNodeList)
import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Components.Lang (Lang(EN))
30
import Gargantext.Components.Nodes.Corpus.Types (CorpusData)
arturo's avatar
arturo committed
31
import Gargantext.Context.Progress (asyncContext, asyncProgress)
arturo's avatar
arturo committed
32
import Gargantext.Ends (Frontends, url)
33
import Gargantext.Hooks.Loader (useLoader)
34
import Gargantext.Hooks.UpdateEffect (useUpdateEffect1')
arturo's avatar
arturo committed
35
import Gargantext.Hooks.Version (Version, useVersion)
36 37
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId)
38
import Gargantext.Types (Handed(..), ID, Name)
39
import Gargantext.Types as GT
40
import Gargantext.Utils (nbsp, (?))
41
import Gargantext.Utils.Reactix as R2
James Laver's avatar
James Laver committed
42
import Gargantext.Utils.Toestand as T2
arturo's avatar
arturo committed
43
import React.SyntheticEvent as SE
44 45 46 47
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
48
import Type.Proxy (Proxy(..))
49

arturo's avatar
arturo committed
50 51 52
-- (?) never been able to properly declare PureScript Regex...
foreign import nodeUserRegexp :: Regex.Regex

James Laver's avatar
James Laver committed
53 54
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node"
55

56
-- Main Node
arturo's avatar
arturo committed
57
type NodeSpanProps =
58
  ( dispatch      :: Action -> Aff Unit
59 60 61
  , folderOpen    :: T.Box Boolean
  , frontends     :: Frontends
  , id            :: ID
62
  , isBoxVisible  :: T.Box Boolean
63 64 65 66
  , isLeaf        :: IsLeaf
  , name          :: Name
  , nodeType      :: GT.NodeType
  , reload        :: T2.ReloadS
67
  , root          :: ID
68
  , session       :: Session
69 70
  )

71 72
type IsLeaf = Boolean

arturo's avatar
arturo committed
73 74 75 76

nodeSpan :: R2.Leaf NodeSpanProps
nodeSpan = R2.leaf nodeSpanCpt
nodeSpanCpt :: R.Component NodeSpanProps
James Laver's avatar
James Laver committed
77
nodeSpanCpt = here.component "nodeSpan" cpt
78
  where
79
    cpt props@{ dispatch
80 81 82 83 84
              , folderOpen
              , frontends
              , id
              , isLeaf
              , nodeType
85
              , reload
86
              , session
87
              , isBoxVisible
88
              } _ = do
89
    -- States
90
      boxes <- AppStore.use
arturo's avatar
arturo committed
91

92
      route' <- T.useLive T.unequal boxes.route
93
      -- only 1 popup at a time is allowed to be opened
94 95 96 97 98
      droppedFile   <- T.useBox (Nothing :: Maybe DroppedFile)
      droppedFile'  <- T.useLive T.unequal droppedFile
      isDragOver    <- T.useBox false
      isDragOver'   <- T.useLive T.unequal isDragOver

99
      currentTasks  <- GAT.focus id boxes.tasks
100 101
      currentTasks' <- T.useLive T.unequal currentTasks

arturo's avatar
arturo committed
102
      folderOpen' <- R2.useLive' folderOpen
103

104 105 106 107 108 109 110 111 112 113 114 115 116
      isBoxVisible' <- R2.useLive' isBoxVisible
      isBoxVisiblePersist <- T.useBox isBoxVisible'
      isBoxVisiblePersist' <- R2.useLive' isBoxVisiblePersist

      -- | Modal not visible initially, but visible after first user
      -- | click. This is to avoid modal loading initially
      -- | (optimization for large trees), but persist it after user
      -- | opens it.
      useUpdateEffect1' isBoxVisible'
        if isBoxVisible'
           then T.write_ true isBoxVisiblePersist
           else pure unit

117
      -- tasks' <- T.read tasks
118

arturo's avatar
arturo committed
119 120 121 122 123 124
    -- Computed
      let

        dropClass :: Maybe DroppedFile -> Boolean -> String
        dropClass (Just _) _    = "mainleaf--file-dropped"
        dropClass _        true = "mainleaf--file-dropped"
125 126
        dropClass Nothing  _    = ""

arturo's avatar
arturo committed
127
        name' :: String -> GT.NodeType -> Session -> String
arturo's avatar
arturo committed
128 129
        name' _ GT.NodeUser s = show s
        name' n _           _ = n
arturo's avatar
arturo committed
130 131 132 133 134 135 136

        isSelected = Just route' == Routes.nodeTypeAppRoute nodeType (sessionId session) id

        SettingsBox {show: showBox} = settingsBox nodeType

        href = url frontends $ GT.NodePath (sessionId session) nodeType (Just id)

arturo's avatar
arturo committed
137 138
        name = name' props.name nodeType session

arturo's avatar
arturo committed
139 140 141 142 143
    -- Methods

        dropHandler :: forall event.
             SE.SyntheticEvent_ event
          -> Effect Unit
144
        dropHandler e = do
145
          -- prevent redirection when file is dropped
arturo's avatar
arturo committed
146 147
          SE.preventDefault e
          SE.stopPropagation e
148 149
          blob <- R2.dataTransferFileBlob e
          void $ launchAff do
150
            --contents <- readAsText blob
151 152
            liftEffect $ do
              T.write_ (Just
arturo's avatar
arturo committed
153
                      $ DroppedFile { blob: (UploadFileBlob blob)
Loïc Chapron's avatar
Loïc Chapron committed
154
                                    , fileType: Just TSV
arturo's avatar
arturo committed
155 156 157 158 159 160 161
                                    , lang    : EN
                                    }) droppedFile

        onDragOverHandler :: forall event.
             T.Box Boolean
          -> SE.SyntheticEvent_ event
          -> Effect Unit
arturo's avatar
arturo committed
162
        onDragOverHandler box e = do
arturo's avatar
arturo committed
163 164 165 166
          -- prevent redirection when file is dropped
          -- https://stackoverflow.com/a/6756680/941471
          SE.preventDefault e
          SE.stopPropagation e
arturo's avatar
arturo committed
167
          T.write_ true box
arturo's avatar
arturo committed
168 169 170 171 172

        onDragLeave :: forall event.
             T.Box Boolean
          -> SE.SyntheticEvent_ event
          -> Effect Unit
arturo's avatar
arturo committed
173
        onDragLeave box _ = T.write_ false box
arturo's avatar
arturo committed
174 175 176 177 178 179 180

        onTaskFinish ::
             GT.NodeID
          -> GT.AsyncTaskWithType
          -> Unit
          -> Effect Unit
        onTaskFinish id' t _ = do
181
          GAT.finish id' t boxes.tasks
arturo's avatar
arturo committed
182 183
          if GAT.asyncTaskTTriggersAppReload t then do
            here.log2 "reloading root for task" t
184
            T2.reload boxes.reloadRoot
arturo's avatar
arturo committed
185 186 187 188 189 190 191 192 193
          else do
            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
194
              T2.reload boxes.reloadMainPage
arturo's avatar
arturo committed
195 196 197 198 199 200 201 202 203 204 205 206 207 208
            else do
              here.log2 "task doesn't trigger a main page reload" t
              pure unit
          -- snd tasks $ GAT.Finish id' t
          -- mT <- T.read tasks
          -- case mT of
          --   Just t' -> snd t' $ GAT.Finish id' t
          --   Nothing -> pure unit
          -- T2.reload reloadRoot

        -- NOTE Don't toggle tree if it is not selected
        onNodeLinkClick :: Unit -> Effect Unit
        onNodeLinkClick _ = when (not isSelected) (T.write_ true folderOpen)

209
    -- Hooks
arturo's avatar
arturo committed
210 211 212 213 214 215 216

      mVersion <- useVersion $ nodeType == GT.NodeUser ?
        Just { session } $
        Nothing

      host <- R2.getPortalHost

217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232
    -- Tooltip
      let hasTooltip = nodeType == GT.NodeUser
          tooltipEl = if hasTooltip then
              nodeTooltip
              { id
              , nodeType
              , name
              }
              [
                case mVersion of
                  Nothing -> mempty
                  Just v  -> versionComparator v
              ]
            else
              H.div {} []

arturo's avatar
arturo committed
233 234 235 236
    -- Render

      pure $

237
        R.fragment
arturo's avatar
arturo committed
238
        [
239 240 241 242 243 244 245 246 247 248
          H.span
          { className: intercalate " "
              [ "mainleaf"
              , dropClass droppedFile' isDragOver'
              , isSelected ? "mainleaf--selected" $ ""
              ]
          , on: { dragLeave: onDragLeave isDragOver
                , dragOver: onDragOverHandler isDragOver
                , drop: dropHandler
                }
arturo's avatar
arturo committed
249 250 251
          }
          [

252
        -- // Abstract informations //
arturo's avatar
arturo committed
253

254 255 256
            tooltipEl

          ,
257 258 259 260 261 262 263 264 265 266 267 268 269
            R.createPortal
            [
              fileTypeView
              { dispatch
              , droppedFile
              , id
              , isDragOver
              , nodeType
              , key: "fileType-" <> show id
              }
            ]
            host
          ,
arturo's avatar
arturo committed
270

271
        -- // Leaf informations data //
arturo's avatar
arturo committed
272

273 274 275 276
            folderIcon
            { isLeaf
            , isOpened: folderOpen'
            , callback: const $ T.modify_ (not) folderOpen
arturo's avatar
arturo committed
277
            }
278 279 280 281 282 283 284 285 286
          ,
            nodeIcon
            (
              { nodeType
              , isLeaf
              , callback: const $ T.modify_ (not) folderOpen
              , isSelected
              }
            )
arturo's avatar
arturo committed
287
            [
288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303
              case mVersion of
                Nothing                              -> mempty
                Just { clientVersion, remoteVersion} ->
                  B.iconButton $
                  { className: intercalate " "
                      [ "mainleaf__version-badge"
                      , clientVersion == remoteVersion ?
                          "mainleaf__version-badge--matched" $
                          "mainleaf__version-badge--mismatched"
                      ]
                  , name: clientVersion == remoteVersion ?
                      "check-circle" $
                      "exclamation-circle"
                  , callback: const $ T.modify_ (not) folderOpen
                  , overlay: false
                  }
arturo's avatar
arturo committed
304
            ]
305
          ,
306 307 308 309 310 311 312 313
            nodeLink
            { callback: onNodeLinkClick
            , href
            , id
            , name: name' props.name nodeType session
            , type: nodeType
            }
          ,
314

315
        -- // Leaf action features //
316

317 318
            nodeActions
            { id
319
            , nodeType
320
            , refresh: const $ dispatch RefreshTree
321
            , session
322 323 324
            } []
          ,
            R2.when (showBox) $
Karen Konou's avatar
Karen Konou committed
325 326
              R.fragment [
                B.iconButton
327
                { name: "thumb-tack-inclined"
328
                , className: "mainleaf__pin-icon"
Karen Konou's avatar
Karen Konou committed
329 330 331
                , callback: \_ -> do 
                log2 "[Pinning tree ID]" id
                T.modify_ (Map.insert (show session) id) boxes.pinnedTreeId
332
                , title: "Pin the tree to this node"
Karen Konou's avatar
Karen Konou committed
333 334 335 336 337
                , variant: Secondary
                , elevation: Level1
                }
              ,
                B.iconButton
338
                { name: "flower-7"
Karen Konou's avatar
Karen Konou committed
339
                , className: "mainleaf__settings-icon"
340 341 342 343
                , callback: \_ -> T.write_ true isBoxVisible
                , title:
                      "Each node of the Tree can perform some actions.\n"
                    <> "Click here to execute one of them."
Karen Konou's avatar
Karen Konou committed
344 345 346 347
                , variant: Secondary
                , elevation: Level1
                }
              ]
348 349 350 351 352 353 354
          ,
            R.fragment $ flip map currentTasks' \task ->

              asyncProgress
              { asyncTask: task
              , nodeId: id
              , onFinish: onTaskFinish id task
355
              , session
356 357 358 359 360 361 362 363 364
              }
              [
                taskProgress
                {}
              ]
            ,

          -- // Modals //

365 366 367 368 369 370
            R2.when isBoxVisiblePersist' (
              B.baseModal
              { isVisibleBox: isBoxVisible
              , noBody: true
              , noHeader: true
              , modalClassName: "forest-tree-node-modal"
371
              }
372 373 374 375 376 377 378 379 380 381 382 383
              [
                nodePopupView
                { boxes
                , closeCallback: \_ -> T.write_ false isBoxVisible
                , dispatch
                , id
                , name
                , nodeType
                , session
                }
              ]
            )
384 385 386 387 388 389 390 391 392 393 394
        ,
        -- // Mainleaf indicator of selected node //
        --
        --    (?) why not integrating this block directly within the
        --        "mainleaf"? → this is due to the "relative" position set rule,
        --        whereas this indicator should have its stacking context based
        --        on the Forest sidebar width (and not the "mainleaf", which
        --        can be hidden due to the Forest sidebar overflow hidden)
          R2.when isSelected $

            H.div
395
            { className: "mainleaf-selection-indicator" }
396
            []
arturo's avatar
arturo committed
397
        ]
398
      ]
arturo's avatar
arturo committed
399 400 401 402 403


---------------------------------------------------------

type NodeIconProps =
arturo's avatar
arturo committed
404 405 406 407
  ( nodeType      ::  GT.NodeType
  , callback      :: Unit -> Effect Unit
  , isLeaf        :: Boolean
  , isSelected    :: Boolean
408 409
  )

arturo's avatar
arturo committed
410 411 412 413 414 415 416
nodeIcon :: R2.Component NodeIconProps
nodeIcon = R2.component nodeIconCpt
nodeIconCpt :: R.Component NodeIconProps
nodeIconCpt = here.component "nodeIcon" cpt where
  cpt { nodeType
      , callback
      , isLeaf
arturo's avatar
arturo committed
417 418 419 420 421 422 423 424 425 426 427 428
      , isSelected
      } children = do
    -- Render
    pure $

      H.span
      { className: "mainleaf__node-icon" } $
      [
        B.iconButton
        { name: GT.getIcon nodeType true
        , callback
        , status: isLeaf ? Idled $ Enabled
429
        , variant: isSelected ? Primary $ Secondary
arturo's avatar
arturo committed
430
        , overlay: false
arturo's avatar
arturo committed
431 432 433
        }
      ]
        <> children
arturo's avatar
arturo committed
434 435 436 437 438 439 440 441 442

-----------------------------------------------

type FolderIconProps =
  ( isOpened :: Boolean
  , callback :: Unit -> Effect Unit
  , isLeaf   :: Boolean
  )

Fabien Manière's avatar
Fabien Manière committed
443 444 445 446 447 448

handedPartClassName :: Handed -> String
handedPartClassName = case _ of
  LeftHanded  -> "angle-left"
  RightHanded -> "angle-right"

arturo's avatar
arturo committed
449 450
folderIcon :: R2.Leaf FolderIconProps
folderIcon = R2.leaf folderIconCpt
451
folderIconCpt :: R.Component FolderIconProps
arturo's avatar
arturo committed
452
folderIconCpt = here.component "folderIcon" cpt where
453 454 455 456 457 458 459
  cpt { isLeaf: true } _ = do
    -- | States
    -- |
    { handed
    } <- AppStore.use
    handed' <- R2.useLive' handed
    -- | Computed
Fabien Manière's avatar
Fabien Manière committed
460
    -- |    
461 462 463 464 465 466 467
    pure $

      B.icon
      { className: intercalate " "
          ["mainleaf__folder-icon"
          , "mainleaf__folder-icon--leaf"
          ]
Fabien Manière's avatar
Fabien Manière committed
468
      , name: handedPartClassName handed'
469 470 471 472 473 474 475 476 477 478 479
      }

  cpt { callback, isOpened } _ = do
    -- | States
    -- |
    { handed
    } <- AppStore.use
    handed' <- R2.useLive' handed
    -- | Computed
    -- |
    pure $
arturo's avatar
arturo committed
480

481 482
      B.iconButton
      { className: "mainleaf__folder-icon"
Fabien Manière's avatar
Fabien Manière committed
483
      , name: isOpened ? "angle-down" $ handedPartClassName handed'
484 485 486
      , overlay: false
      , callback
      }
arturo's avatar
arturo committed
487 488 489 490 491 492 493 494

-----------------------------------------------

type NodeLinkProps =
  ( callback   :: Unit -> Effect Unit
  , href       :: String
  , id         :: Int
  , name       :: GT.Name
arturo's avatar
arturo committed
495
  , type       :: GT.NodeType
496 497
  )

arturo's avatar
arturo committed
498 499 500
nodeLink :: R2.Leaf NodeLinkProps
nodeLink = R2.leaf nodeLinkCpt
nodeLinkCpt :: R.Component NodeLinkProps
arturo's avatar
arturo committed
501 502 503 504 505 506 507 508 509 510
nodeLinkCpt = here.component "nodeLink" cpt where
  cpt { callback
      , href
      , id
      , name
      , type: nodeType
      } _ = do
    -- Computed
    let
      tid = tooltipId name id
arturo's avatar
arturo committed
511

arturo's avatar
arturo committed
512 513 514
      aProps =
        { href
        } `Record.merge` B.tooltipBind tid
arturo's avatar
arturo committed
515

arturo's avatar
arturo committed
516 517
    -- Render
    pure $
arturo's avatar
arturo committed
518

arturo's avatar
arturo committed
519 520 521 522 523 524 525
      H.div
      { className: "mainleaf__node-link"
      , on: { click: const $ callback unit }
      }
      [
        H.a
        aProps
arturo's avatar
arturo committed
526
        [
arturo's avatar
arturo committed
527
          B.span_ $ nodeLinkText nodeType name
arturo's avatar
arturo committed
528
        ]
arturo's avatar
arturo committed
529 530 531 532 533
      ]

nodeLinkText :: GT.NodeType -> String -> String
nodeLinkText GT.NodeUser s = s # (truncateNodeUser)
                         >>> maybe s identity
534 535
-- nodeLinkText _           s = textEllipsisBreak 15 s
nodeLinkText _           s = s
arturo's avatar
arturo committed
536 537 538

truncateNodeUser :: String -> Maybe String
truncateNodeUser = Regex.match (nodeUserRegexp) >=> flip NArray.index 1 >>> join
arturo's avatar
arturo committed
539 540 541 542 543 544 545 546

---------------------------------------------------

type NodeTooltipProps =
  ( name      :: String
  , id        :: GT.NodeID
  , nodeType  :: GT.NodeType
  )
547

arturo's avatar
arturo committed
548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587
nodeTooltip :: R2.Component NodeTooltipProps
nodeTooltip = R2.component nodeTooltipCpt
nodeTooltipCpt :: R.Component NodeTooltipProps
nodeTooltipCpt = here.component "nodeTooltip" cpt where
  cpt { name, id, nodeType } children = pure $

    B.tooltip
    { id: tooltipId name id
    , effect: FloatEffect
    , delayShow: 600
    } $
    [
      H.b
      {}
      [
        B.icon
        { name: GT.getIcon nodeType true }
      ,
        B.span_ $
          GT.prettyNodeType nodeType
      ]
    ,
      B.div_ $
        name
    ]
      <> children

tooltipId :: String -> GT.NodeID -> String
tooltipId name id = name <> "-node-link-" <> show id

---------------------------------------------------------

blankNodeSpan :: R2.Leaf ()
blankNodeSpan = R2.leaf blankNodeSpanCpt
blankNodeSpanCpt :: R.Component ()
blankNodeSpanCpt = here.component "__blank__" cpt where
  cpt _ _ = pure $

    H.div { className: "mainleaf mainleaf--blank" }
    [
588
      B.icon { className: "mainleaf__folder-icon", name: "angle-right"}
arturo's avatar
arturo committed
589 590 591 592 593 594 595 596 597 598
    ,
      H.span { className: "mainleaf__node-icon" }
      [
        B.icon { name: "circle" }
      ]
    ,
      H.div { className: "mainleaf__node-link"} [ H.text $ nbsp 1 ]
    ]

-----------------------------------------------
599

600
-- START nodeActions
601

James Laver's avatar
James Laver committed
602 603 604
type NodeActionsCommon =
  ( id       :: ID
  , refresh  :: Unit -> Aff Unit
605
  , session  :: Session
606
  )
607

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

610 611
nodeActions :: R2.Component NodeActionsProps
nodeActions = R.createElement nodeActionsCpt
612

613
nodeActionsCpt :: R.Component NodeActionsProps
James Laver's avatar
James Laver committed
614
nodeActionsCpt = here.component "nodeActions" cpt where
arturo's avatar
arturo committed
615 616
  cpt props _ = pure (child props.nodeType)
    where
617
      nodeActionsP      = Proxy :: Proxy "nodeType"
arturo's avatar
arturo committed
618 619 620 621

      childProps        = Record.delete nodeActionsP props

      child GT.NodeList = listNodeActions childProps
622
      -- child GT.Graph    = graphNodeActions childProps --Remove the refresh/sync icon removed on #644 (purescript-gargantext)
arturo's avatar
arturo committed
623
      child _           = mempty
James Laver's avatar
James Laver committed
624 625

graphNodeActions :: R2.Leaf NodeActionsCommon
626
graphNodeActions = R2.leaf graphNodeActionsCpt
James Laver's avatar
James Laver committed
627
graphNodeActionsCpt :: R.Component NodeActionsCommon
628 629
graphNodeActionsCpt = R2.hereComponent here "graphNodeActions" hCpt where
  hCpt hp { id, refresh, session } _ = do
arturo's avatar
arturo committed
630
    -- Hooks
631 632
    useLoader
      { errorHandler: Nothing
633
      , herePrefix: hp
arturo's avatar
arturo committed
634 635
      , loader: graphVersions session
      , path: id
636
      , render: \gv -> graphNodeActionsLoaded { gv, id, refresh, session }
arturo's avatar
arturo committed
637
      }
638 639
    where
      graphVersions session graphId = GraphAPI.graphVersions { graphId, session }
arturo's avatar
arturo committed
640

641 642 643
type NodeActionsGraphLoaded =
  ( gv :: Record GraphAPI.GraphVersions
  | NodeActionsCommon )
arturo's avatar
arturo committed
644

645 646 647 648 649 650 651 652 653 654
graphNodeActionsLoaded :: R2.Leaf NodeActionsGraphLoaded
graphNodeActionsLoaded = R2.leaf graphNodeActionsLoadedCpt
graphNodeActionsLoadedCpt :: R.Component NodeActionsGraphLoaded
graphNodeActionsLoadedCpt = here.component "graphNodeActionsLoaded" cpt where
  cpt { gv, id, refresh, session } _ = do
    -- Render
    pure $ nodeActionsGraph { graphVersions: gv
                            , id
                            , refresh
                            , session } []
James Laver's avatar
James Laver committed
655

656

James Laver's avatar
James Laver committed
657
listNodeActions :: R2.Leaf NodeActionsCommon
658
listNodeActions = R2.leaf listNodeActionsCpt
James Laver's avatar
James Laver committed
659
listNodeActionsCpt :: R.Component NodeActionsCommon
660 661
listNodeActionsCpt = R2.hereComponent here "listNodeActions" hCpt where
  hCpt hp { id, refresh, session } _ = do
arturo's avatar
arturo committed
662
    -- Hooks
663 664
    useLoader
      { errorHandler: Nothing
665
      , herePrefix: hp
arturo's avatar
arturo committed
666 667
      , loader: loadCorpusWithChild
      , path: { nodeId: id, session }
668
      , render: \corpusData -> listNodeActionsLoaded { corpusData, id, refresh, session }
arturo's avatar
arturo committed
669 670
      }

671 672 673
type NodeActionsListLoaded =
  ( corpusData :: CorpusData
  | NodeActionsCommon )
arturo's avatar
arturo committed
674

675 676 677 678 679 680 681 682 683 684 685 686 687
listNodeActionsLoaded :: R2.Leaf NodeActionsListLoaded
listNodeActionsLoaded = R2.leaf listNodeActionsLoadedCpt
listNodeActionsLoadedCpt :: R.Component NodeActionsListLoaded
listNodeActionsLoadedCpt = here.component "listNodeActionsLoaded" cpt where
  cpt { corpusData: { corpusId }, id, refresh, session } _ = do

    -- Render
    pure $ nodeActionsNodeList { listId: id
                               , nodeId: corpusId
                               , nodeType: GT.TabNgramType GT.CTabTerms
                               , refresh
                               , session
                               }
arturo's avatar
arturo committed
688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765

-----------------------------------------------

type VersionComparatorProps =
  ( clientVersion :: Version
  , remoteVersion :: Version
  )

versionComparator :: R2.Leaf VersionComparatorProps
versionComparator = R2.leaf versionComparatorCpt
versionComparatorCpt :: R.Component VersionComparatorProps
versionComparatorCpt = here.component "versionComparator" cpt where
  cpt { clientVersion, remoteVersion } _
    | clientVersion == remoteVersion = pure $
        B.caveat
        { variant: Success
        , className: "mainleaf__version-comparator"
        }
        [
          B.b_ "Versions match"
        ,
          content clientVersion remoteVersion
        ]
    | otherwise = pure $
        B.caveat
        { variant: Warning
        , className: "mainleaf__version-comparator"
        }
        [
          B.b_ "Versions mismatch"
        ,
          content clientVersion remoteVersion
        ]

  content :: Version -> Version -> R.Element
  content clientVersion remoteVersion =
    H.ul
    {}
    [
      H.li
      {}
      [
        B.span_ "frontend: "
      ,
        H.text $ nbsp 1
      ,
        B.code_ clientVersion
      ]
    ,
      H.li
      {}
      [
        B.span_ "backend: "
      ,
        H.text $ nbsp 1
      ,
        B.code_ remoteVersion
      ]
    ]

-------------------------------------------------------

taskProgress :: R2.Leaf ()
taskProgress = R2.leaf taskProgressCpt
taskProgressCpt :: R.Component ()
taskProgressCpt = here.component "progress" cpt where
  cpt _ _ = do
    -- Context
    asyncProgressContext <- R.useContext asyncContext
    -- Render
    pure $

      H.span
      { className: "mainleaf__progress-bar" }
      [
        B.progressBar
        { value: asyncProgressContext
        , variant: Info
766
        , waitingTextClass: if asyncProgressContext > 0.0 then "d-none" else "d-block"
arturo's avatar
arturo committed
767 768
        }
      ]