Sidebar.purs 22.8 KB
Newer Older
1
module Gargantext.Components.GraphExplorer.Sidebar
arturo's avatar
arturo committed
2
  ( sidebar
arturo's avatar
arturo committed
3
  ) where
4

5 6
import Gargantext.Prelude

7
import Control.Parallel (parTraverse)
8
import Data.Array (last)
9
import Data.Array as A
10
import Data.Either (Either(..))
arturo's avatar
arturo committed
11
import Data.Foldable (intercalate)
12
import Data.Foldable as F
13
import Data.FunctorWithIndex (mapWithIndex)
14
import Data.Int (fromString)
15
import Data.Map as Map
16
import Data.Maybe (Maybe(..), fromJust)
17
import Data.Number as DN
18
import Data.Sequence as Seq
19
import Data.Set as Set
arturo's avatar
arturo committed
20
import Data.Tuple.Nested ((/\))
21
import Effect (Effect)
22
import Effect.Aff (launchAff_)
23
import Effect.Class (liftEffect)
arturo's avatar
arturo committed
24
import Gargantext.Components.App.Store as AppStore
arturo's avatar
arturo committed
25
import Gargantext.Components.Bootstrap as B
26
import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), Elevation(..), Variant(..))
arturo's avatar
arturo committed
27 28
import Gargantext.Components.GraphExplorer.Sidebar.ContactList (contactListWrapper)
import Gargantext.Components.GraphExplorer.Sidebar.DocList (docListWrapper)
arturo's avatar
arturo committed
29 30
import Gargantext.Components.GraphExplorer.Sidebar.Legend as Legend
import Gargantext.Components.GraphExplorer.Store as GraphStore
31
import Gargantext.Components.GraphExplorer.Types as GET
arturo's avatar
arturo committed
32
import Gargantext.Components.GraphExplorer.Utils as GEU
33
import Gargantext.Components.Lang (Lang(..))
34
import Gargantext.Config.REST (AffRESTError)
arturo's avatar
arturo committed
35
import Gargantext.Core.NgramsTable.Functions as NTC
36
import Gargantext.Core.NgramsTable.Types as CNT
37
import Gargantext.Data.Array (mapMaybe)
38
import Gargantext.Ends (Frontends)
39
import Gargantext.Hooks.FirstEffect (useFirstEffect')
40
import Gargantext.Hooks.Sigmax.Types as SigmaxT
41
import Gargantext.Sessions (Session)
42
import Gargantext.Types (CTabNgramType, FrontendError(..), NodeID, SidePanelState(..), TabSubType(..), TabType(..), TermList(..), modeTabType)
arturo's avatar
arturo committed
43
import Gargantext.Utils (getter, nbsp, setter, (?))
44
import Gargantext.Utils.Reactix as R2
45
import Gargantext.Utils.Toestand as T2
46 47 48 49 50
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
51

52 53
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Sidebar"
54

arturo's avatar
arturo committed
55
type Props =
arturo's avatar
arturo committed
56
  ( metaData        :: GET.MetaData
57
  , session         :: Session
arturo's avatar
arturo committed
58
  , frontends       :: Frontends
59
  )
60

arturo's avatar
arturo committed
61 62
sidebar :: R2.Leaf Props
sidebar = R2.leaf sidebarCpt
arturo's avatar
arturo committed
63 64 65
sidebarCpt :: R.Component Props
sidebarCpt = here.component "sidebar" cpt where
  cpt props _ = do
66 67
    -- | States
    -- |
arturo's avatar
arturo committed
68
    { sideTab
69
    , showSidebar
arturo's avatar
arturo committed
70
    } <- GraphStore.use
71

72
    sideTab'      <- R2.useLive' sideTab
73

74 75
    -- | Computed
    -- |
arturo's avatar
arturo committed
76 77 78 79 80
    let
      sideTabs =
        [ GET.SideTabLegend
        , GET.SideTabData
        , GET.SideTabCommunity
arturo's avatar
arturo committed
81 82
        ]

83 84 85 86 87 88 89 90
    -- | Behaviors
    -- |
    let
      closeCallback :: Unit -> Effect Unit
      closeCallback _ = T.write_ Closed showSidebar

    -- | Render
    -- |
arturo's avatar
arturo committed
91 92 93 94 95
    pure $

      H.div
      { className: "graph-sidebar" }
      [
96 97 98 99 100 101 102 103
        -- Close CTA
        B.iconButton
        { name: "times"
        , elevation: Level2
        , callback: closeCallback
        , className: "graph-sidebar__close"
        }
      ,
arturo's avatar
arturo committed
104 105 106 107 108 109 110 111 112 113 114 115 116
        -- Menu
        B.tabs
        { value: sideTab'
        , list: sideTabs
        , callback: flip T.write_ sideTab
        }
      ,
        case sideTab' of
          GET.SideTabLegend     -> sideTabLegend props
          GET.SideTabData       -> sideTabData props
          GET.SideTabCommunity  -> sideTabCommunity props
      ]

arturo's avatar
arturo committed
117 118 119 120
------------------------------------------------------------

sideTabLegend :: R2.Leaf Props
sideTabLegend = R2.leaf sideTabLegendCpt
121
sideTabLegendCpt :: R.Component Props
arturo's avatar
arturo committed
122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158
sideTabLegendCpt = here.component "sideTabLegend" cpt where
  cpt { metaData: GET.MetaData { legend } } _ = do
    -- | States
    -- |
    store <- GraphStore.use

    hyperdataGraph
      <- R2.useLive' store.hyperdataGraph

    -- | Computed
    -- |
    let
      maxItemPerCluster = 4

    -- | Hooks
    -- |

    -- For each provided Cluster (see Legend), extract the greatest nodes
    extractedNodeList <- R.useMemo1 hyperdataGraph $ const $
      flip A.foldMap legend
      (   getter _.id_
      >>> GEU.takeGreatestNodeByCluster
            hyperdataGraph
            maxItemPerCluster
      )

    -- For each provided Cluster (see Legend), count the number of nodes
    nodeCountList <- R.useMemo1 hyperdataGraph $ const $
      flip A.foldMap legend
      (   getter _.id_
      >>> GEU.countNodeByCluster hyperdataGraph
      >>> A.singleton
      )

    -- | Render
    -- |
    pure $
arturo's avatar
arturo committed
159 160 161 162 163

      H.div
      { className: "graph-sidebar__legend-tab" }
      [
        Legend.legend
arturo's avatar
arturo committed
164 165 166 167 168
        { legendSeq: Seq.fromFoldable legend
        , extractedNodeList
        , nodeCountList
        , selectedNodeIds: store.selectedNodeIds
        }
arturo's avatar
arturo committed
169 170 171 172 173 174 175 176 177 178
      ,
        H.hr {}
      ,
        documentation EN
      ]

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

sideTabData :: R2.Leaf Props
sideTabData = R2.leaf sideTabDataCpt
179
sideTabDataCpt :: R.Component Props
arturo's avatar
arturo committed
180 181 182 183
sideTabDataCpt = here.component "sideTabData" cpt where
  cpt props _ = do
    -- States
    { selectedNodeIds
arturo's avatar
arturo committed
184
    } <- GraphStore.use
arturo's avatar
arturo committed
185 186

    selectedNodeIds'  <- R2.useLive' selectedNodeIds
187

arturo's avatar
arturo committed
188 189 190
    -- Computed
    let
      hasSelection = not $ Set.isEmpty selectedNodeIds'
arturo's avatar
arturo committed
191

arturo's avatar
arturo committed
192 193
    -- Render
    pure $
arturo's avatar
arturo committed
194

arturo's avatar
arturo committed
195 196 197 198
      H.div
      { className: "graph-sidebar__data-tab" }
      [
        case hasSelection of
arturo's avatar
arturo committed
199

arturo's avatar
arturo committed
200 201
          -- No result
          false ->
arturo's avatar
arturo committed
202

203
            sideTabDataNoSelection {}
arturo's avatar
arturo committed
204 205
          -- Nodes have been selected
          true ->
206 207
            sideTabDataWithSelection props
      ]
arturo's avatar
arturo committed
208

209 210 211 212 213 214 215 216 217 218

sideTabDataNoSelection :: R2.Leaf ()
sideTabDataNoSelection = R2.leaf sideTabDataNoSelectionCpt
sideTabDataNoSelectionCpt :: R.Component ()
sideTabDataNoSelectionCpt = here.component "sideTabDataNoSelection" cpt where
  cpt {} _ = do
    pure $ B.caveat
      {}
      [
        H.text "Select one or more nodes to get their informations"
arturo's avatar
arturo committed
219
      ]
220

221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249
sideTabDataWithSelection :: R2.Leaf Props
sideTabDataWithSelection = R2.leaf sideTabDataWithSelectionCpt
sideTabDataWithSelectionCpt :: R.Component Props
sideTabDataWithSelectionCpt = here.component "sideTabDataWithSelection" cpt where
  cpt props _ = do
    -- States
    { graph
    } <- GraphStore.use

    graph'  <- R2.useLive' graph

    pure $
      R.fragment [
        selectedNodes $
        { nodesMap: SigmaxT.nodesGraphMap graph'
        } `Record.merge` props
        ,
        sideBarTabSeparator
        ,
        neighborhood
        {}
        ,
        sideBarTabSeparator
        ,
        docListWrapper
        { metaData: props.metaData
        }
        ]

arturo's avatar
arturo committed
250
------------------------------------------------------------
251

arturo's avatar
arturo committed
252 253
sideTabCommunity :: R2.Leaf Props
sideTabCommunity = R2.leaf sideTabCommunityCpt
254
sideTabCommunityCpt :: R.Component Props
arturo's avatar
arturo committed
255
sideTabCommunityCpt = here.component "sideTabCommunity" cpt where
arturo's avatar
arturo committed
256
  cpt props _ = do
arturo's avatar
arturo committed
257 258
    -- States
    { selectedNodeIds
arturo's avatar
arturo committed
259
    } <- GraphStore.use
260

arturo's avatar
arturo committed
261
    selectedNodeIds'  <- R2.useLive' selectedNodeIds
arturo's avatar
arturo committed
262

arturo's avatar
arturo committed
263 264 265
    -- Computed
    let
      hasSelection = not $ Set.isEmpty selectedNodeIds'
arturo's avatar
arturo committed
266

arturo's avatar
arturo committed
267 268
    -- Render
    pure $
arturo's avatar
arturo committed
269

arturo's avatar
arturo committed
270 271 272 273
      H.div
      { className: "graph-sidebar__community-tab" }
      [
        case hasSelection of
arturo's avatar
arturo committed
274

arturo's avatar
arturo committed
275 276
          -- No result
          false ->
277
            sideTabCommunityNoSelection {}
arturo's avatar
arturo committed
278

arturo's avatar
arturo committed
279 280
          -- Nodes have been selection
          true ->
281 282
            sideTabCommunityWithSelection props
      ]
arturo's avatar
arturo committed
283

284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322
sideTabCommunityNoSelection :: R2.Leaf ()
sideTabCommunityNoSelection = R2.leaf sideTabCommunityNoSelectionCpt
sideTabCommunityNoSelectionCpt :: R.Component ()
sideTabCommunityNoSelectionCpt = here.component "sideTabCommunityNoSelection" cpt where
  cpt {} _ = do
    pure $ B.caveat
      {}
      [
        H.text "Select one or more nodes to get their informations"
      ]


sideTabCommunityWithSelection :: R2.Leaf Props
sideTabCommunityWithSelection = R2.leaf sideTabCommunityWithSelectionCpt
sideTabCommunityWithSelectionCpt :: R.Component Props
sideTabCommunityWithSelectionCpt = here.component "sideTabCommunityWithSelection" cpt where
  cpt props _ = do
    { graph
    } <- GraphStore.use

    graph'  <- R2.useLive' graph

    pure $
      R.fragment
      [
        selectedNodes $
        { nodesMap: SigmaxT.nodesGraphMap graph'
        } `Record.merge` props
      ,
        sideBarTabSeparator
      ,
        neighborhood
        {}
      ,
        sideBarTabSeparator
      ,
        contactListWrapper
        { metaData: props.metaData
        }
arturo's avatar
arturo committed
323
      ]
324

arturo's avatar
arturo committed
325 326 327 328 329 330 331 332
-------------------------------------------

sideBarTabSeparator :: R.Element
sideBarTabSeparator =
  H.div
  { className: "graph-sidebar__separator" }
  [
    B.icon
arturo's avatar
arturo committed
333
    { name: "angle-double-down" }
arturo's avatar
arturo committed
334
  ]
335 336

-------------------------------------------
337 338
-- TODO
-- selectedNodes :: Record Props -> Map.Map String Nodes -> R.Element
339

arturo's avatar
arturo committed
340 341
type SelectedNodesProps =
  ( nodesMap :: SigmaxT.NodesMap
342 343 344
  | Props
  )

arturo's avatar
arturo committed
345 346
selectedNodes :: R2.Leaf SelectedNodesProps
selectedNodes = R2.leaf selectedNodesCpt
347
selectedNodesCpt :: R.Component SelectedNodesProps
arturo's avatar
arturo committed
348
selectedNodesCpt = here.component "selectedNodes" cpt where
arturo's avatar
arturo committed
349
  cpt props _ = do
350 351
    -- | States
    -- |
arturo's avatar
arturo committed
352 353
    { selectedNodeIds
    , graph
354
    , expandSelection
arturo's avatar
arturo committed
355
    } <- GraphStore.use
arturo's avatar
arturo committed
356

arturo's avatar
arturo committed
357 358
    selectedNodeIds'    <- R2.useLive' selectedNodeIds
    graph'              <- R2.useLive' graph
359 360 361 362 363 364 365 366
    expandSelection'    <- R2.useLive' expandSelection

    -- | Effects
    -- |

    -- transfer local Component change to Local Storage cache
    useFirstEffect' $
      flip T.listen expandSelection onExpandSelectionChange
arturo's avatar
arturo committed
367

368 369
    -- | Behaviors
    -- |
arturo's avatar
arturo committed
370 371 372
    let
      onBadgeClick id _ = T.write_ (Set.singleton id) selectedNodeIds

373
      onExpandClick _ = T.modify_ (not) expandSelection
arturo's avatar
arturo committed
374

375 376
    -- | Render
    -- |
arturo's avatar
arturo committed
377 378 379 380 381 382 383 384 385 386 387 388 389
    pure $

      H.ul
      { className: intercalate " "
          [ "graph-selected-nodes"
          , "list-group"
          ]
        }
      [
        H.li
        { className: "list-group-item" }
        [
          H.ul
390
          { className: "graph-selected-nodes__list" } $
arturo's avatar
arturo committed
391 392

          Seq.toUnfoldable $
arturo's avatar
arturo committed
393
            flip Seq.map (badges graph' selectedNodeIds') \node ->
arturo's avatar
arturo committed
394 395 396 397 398 399 400 401 402 403 404 405

              H.li
              { className: "graph-selected-nodes__item" }
              [
                H.a
                { className: intercalate " "
                    [ "graph-selected-nodes__badge"
                    , "badge badge-info"
                    ]
                , on: { click: onBadgeClick node.id }
                }
                [ H.text node.label ]
Alexandre Delanoë's avatar
Alexandre Delanoë committed
406
              ]
arturo's avatar
arturo committed
407 408 409
        ,
          -- Expand NGrams actions
          B.iconButton
410
          { name: expandSelection' ?
arturo's avatar
arturo committed
411 412 413 414 415
              "caret-up" $
              "caret-down"
          , className: "graph-selected-nodes__expand"
          , callback: onExpandClick
          }
arturo's avatar
arturo committed
416 417
        ]
      ,
arturo's avatar
arturo committed
418
        -- NGrams actions
419
        R2.when expandSelection' $
arturo's avatar
arturo committed
420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459

          H.li
          { className: intercalate " "
              [ "list-group-item"
              , "graph-selected-nodes__actions"
              ]
          }
          [
            B.buttonGroup
            { collapse: false }
            [
              updateTermButton
              ( props `Record.merge`
                { variant: ButtonVariant Light
                , rType: CandidateTerm
                }
              )
              [
                B.icon
                { name: "circle"
                , className: "mr-1 candidate-term"
                }
              ,
                H.text "Move as candidate"
              ]
            ,
              updateTermButton
              ( props `Record.merge`
                { variant: ButtonVariant Light
                , rType: StopTerm
                }
              )
              [
                B.icon
                { name: "circle"
                , className: "mr-1 stop-term"
                }
              ,
                H.text "Move as stop"
              ]
Alexandre Delanoë's avatar
Alexandre Delanoë committed
460
            ]
arturo's avatar
arturo committed
461
          ]
arturo's avatar
arturo committed
462 463
      ]

464 465 466 467 468 469
onExpandSelectionChange :: T.Change Boolean -> Effect Unit
onExpandSelectionChange { new } = do
  cache <- R2.loadLocalStorageState' R2.graphParamsKey GET.defaultCacheParams
  let update = setter (_ { expandSelection = new }) cache
  R2.setLocalStorageState R2.graphParamsKey update

arturo's avatar
arturo committed
470 471
---------------------------------------------------------

arturo's avatar
arturo committed
472
neighborhood :: R2.Leaf ()
arturo's avatar
arturo committed
473
neighborhood = R2.leaf neighborhoodCpt
arturo's avatar
arturo committed
474
neighborhoodCpt :: R.Memo ()
arturo's avatar
arturo committed
475
neighborhoodCpt = R.memo' $ here.component "neighborhood" cpt where
arturo's avatar
arturo committed
476
  cpt _ _ = do
477 478
    -- | States
    -- |
arturo's avatar
arturo committed
479 480
    { selectedNodeIds
    , graph
481
    , expandNeighborhood
arturo's avatar
arturo committed
482
    } <- GraphStore.use
arturo's avatar
arturo committed
483 484

    selectedNodeIds' <-
arturo's avatar
arturo committed
485 486
      R2.useLive' selectedNodeIds

487 488
    expandNeighborhood' <-
      R2.useLive' expandNeighborhood
arturo's avatar
arturo committed
489

arturo's avatar
arturo committed
490 491
    graph' <-
      R2.useLive' graph
arturo's avatar
arturo committed
492 493 494

    showMore /\ showMoreBox <-
      R2.useBox' false
arturo's avatar
arturo committed
495

arturo's avatar
arturo committed
496 497
    termList /\ termListBox <-
      R2.useBox' []
arturo's avatar
arturo committed
498

arturo's avatar
arturo committed
499 500
    termCount /\ termCountBox <-
      R2.useBox' 0
arturo's avatar
arturo committed
501

502 503
    -- | Computed
    -- |
arturo's avatar
arturo committed
504
    let
505
      minSize = F.foldl DN.min 0.0 (Seq.map _.size (SigmaxT.graphNodes graph'))
arturo's avatar
arturo committed
506

507
      maxSize = F.foldl DN.max 0.0 (Seq.map _.size (SigmaxT.graphNodes graph'))
arturo's avatar
arturo committed
508 509 510

      maxTruncateResult = 5

arturo's avatar
arturo committed
511
      withTruncateResults = (termCount > maxTruncateResult) && (not showMore)
arturo's avatar
arturo committed
512 513


514 515
    -- | Behaviors
    -- |
arturo's avatar
arturo committed
516 517 518
    let
      onBadgeClick id _ = T.write_ (Set.singleton id) selectedNodeIds

519 520 521 522 523 524 525 526
      onExpandClick _ = T.modify_ (not) expandNeighborhood

    -- | Effects
    -- |

    -- transfer local Component change to Local Storage cache
    useFirstEffect' $
      flip T.listen expandNeighborhood onExpandNeighborhoodChange
arturo's avatar
arturo committed
527

arturo's avatar
arturo committed
528
    R.useEffect1' selectedNodeIds' do
arturo's avatar
arturo committed
529
      let refreshed = neighbourBadges graph' selectedNodeIds'
arturo's avatar
arturo committed
530 531
      let count     = Seq.length refreshed
      let ordered   = A.sortWith (\n -> -n.size) $ Seq.toUnfoldable refreshed
532
      T.write_ (count-1)   termCountBox
arturo's avatar
arturo committed
533
      T.write_ ordered termListBox
arturo's avatar
arturo committed
534 535
      T.write_ false showMoreBox

536 537
    -- | Render
    -- |
arturo's avatar
arturo committed
538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554
    pure $

      H.ul
      { className: intercalate " "
          [ "graph-neighborhood"
          , "list-group"
          ]
      }
      [
        -- Extracted count
        H.li
        { className: "list-group-item" }
        [
          -- @XXX: Bootstrap CSS w/ one <li> deduped the list-style-type bullet
          H.div
          { className: "graph-neighborhood__counter" }
          [
arturo's avatar
arturo committed
555 556
            B.wad'
            [ "text-info", "d-inline" ] $
arturo's avatar
arturo committed
557
            show termCount
arturo's avatar
arturo committed
558
          ,
559
            H.text $ nbsp 1 <> "related terms"
arturo's avatar
arturo committed
560 561 562
          ,
            -- Expand word cloud
            B.iconButton
563
            { name: expandNeighborhood' ?
arturo's avatar
arturo committed
564 565 566 567 568
                "caret-up" $
                "caret-down"
            , className: "graph-neighborhood__expand"
            , callback: onExpandClick
            }
569 570
          ]
        ]
arturo's avatar
arturo committed
571 572
      ,
        -- Word cloud
573
        R2.when expandNeighborhood' $
arturo's avatar
arturo committed
574

arturo's avatar
arturo committed
575 576 577 578
          H.li
          { className: "list-group-item"}
          [
            H.ul
579
            { className: "graph-neighborhood__parent" } $
arturo's avatar
arturo committed
580 581 582 583
            flip mapWithIndex termList \index node ->

              R2.when
              (
584 585 586
                (withTruncateResults == false
                || index < maxTruncateResult)
                && (not $ Set.member node.id selectedNodeIds')
arturo's avatar
arturo committed
587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616
              ) $
                H.li
                { className: "graph-neighborhood__badge" }
                [
                  H.a
                  { className: "badge badge-light"
                  -- adjust font accordingly
                  , style:
                      { fontSize: badgeSize
                          minSize
                          maxSize
                          node.size
                      , lineHeight: badgeSize
                          minSize
                          maxSize
                          node.size
                      }
                  , on: { click: onBadgeClick node.id }
                  }
                  [ H.text node.label ]
                ]
          ,
            R2.when (withTruncateResults) $

              B.button
              { variant: ButtonVariant Light
              , callback: \_ -> T.modify_ (not) showMoreBox
              , block: true
              , className: "graph-neighborhood__show-more"
              }
arturo's avatar
arturo committed
617
              [
arturo's avatar
arturo committed
618
                H.text "Show more"
arturo's avatar
arturo committed
619
              ]
arturo's avatar
arturo committed
620
          ]
arturo's avatar
arturo committed
621
      ]
622

623 624 625 626 627 628
onExpandNeighborhoodChange :: T.Change Boolean -> Effect Unit
onExpandNeighborhoodChange { new } = do
  cache <- R2.loadLocalStorageState' R2.graphParamsKey GET.defaultCacheParams
  let update = setter (_ { expandNeighborhood = new }) cache
  R2.setLocalStorageState R2.graphParamsKey update

arturo's avatar
arturo committed
629
---------------------------------------------------------
630

arturo's avatar
arturo committed
631 632
type UpdateTermButtonProps =
  ( variant    :: ButtonVariant
633 634
  , nodesMap   :: SigmaxT.NodesMap
  , rType      :: TermList
arturo's avatar
arturo committed
635
  | Props
636 637
  )

638
updateTermButton :: R2.Component UpdateTermButtonProps
arturo's avatar
arturo committed
639
updateTermButton = R2.component updateTermButtonCpt
arturo's avatar
arturo committed
640

641
updateTermButtonCpt :: R.Component UpdateTermButtonProps
arturo's avatar
arturo committed
642
updateTermButtonCpt = here.component "updateTermButton" cpt where
arturo's avatar
arturo committed
643
  cpt { variant
arturo's avatar
arturo committed
644 645 646 647 648 649
      , metaData
      , nodesMap
      , rType
      , session
      } children = do
    -- States
arturo's avatar
arturo committed
650 651 652 653
    { errors
    , reloadForest
    } <- AppStore.use

arturo's avatar
arturo committed
654 655 656
    { removedNodeIds
    , selectedNodeIds
    , graphId
arturo's avatar
arturo committed
657
    } <- GraphStore.use
arturo's avatar
arturo committed
658 659 660

    selectedNodeIds' <- R2.useLive' selectedNodeIds
    graphId'         <- R2.useLive' graphId
arturo's avatar
arturo committed
661 662 663 664 665 666 667

    -- Behaviors
    let
      callback _ = do
        let nodes = mapMaybe (\id -> Map.lookup id nodesMap)
                            $ Set.toUnfoldable selectedNodeIds'
        sendPatches { errors
arturo's avatar
arturo committed
668
                    , graphId: graphId'
arturo's avatar
arturo committed
669 670 671 672
                    , metaData: metaData
                    , nodes
                    , session: session
                    , termList: rType
arturo's avatar
arturo committed
673 674
                    , reloadForest
                    }
arturo's avatar
arturo committed
675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692
        T.write_ selectedNodeIds' removedNodeIds
        T.write_ SigmaxT.emptyNodeIds selectedNodeIds

    -- Render
    pure $

      B.button
      { variant
      , callback
      }
      children


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

badgeSize :: Number -> Number -> Number -> String
badgeSize minSize maxSize size =
  let
693 694
    minFontSize = 8.0
    maxFontSize = 26.0
arturo's avatar
arturo committed
695
    sizeScaled = (size - minSize) / (maxSize - minSize)  -- in [0; 1] range
696 697
    scale' = DN.log (sizeScaled + 1.0) / (DN.log 2.0)  -- in [0; 1] range
    scale = minFontSize + scale' * (maxFontSize - minFontSize)
arturo's avatar
arturo committed
698 699 700

  in
    show scale <> "px"
701

702

703 704
badges :: SigmaxT.SGraph -> SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
badges graph selectedNodeIds = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
705

706
neighbourBadges :: SigmaxT.SGraph -> SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
707 708 709
neighbourBadges graph selectedNodeIds = SigmaxT.neighbors graph selectedNodes'
  where
    selectedNodes' = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
710

arturo's avatar
arturo committed
711 712
---------------------------------------------------------

713
type SendPatches =
714 715
  ( errors       :: T.Box (Array FrontendError)
  , graphId      :: NodeID
716 717
  , metaData     :: GET.MetaData
  , nodes        :: Array (Record SigmaxT.Node)
718
  , reloadForest :: T2.ReloadS
719 720
  , session      :: Session
  , termList     :: TermList
721
  )
722

723
sendPatches :: Record SendPatches -> Effect Unit
724
sendPatches { errors, metaData, nodes, reloadForest, session, termList } = do
725
  launchAff_ do
726
    patches <- (parTraverse (sendPatch termList session metaData) nodes) -- :: Aff (Array CNT.VersionedNgramsPatches)
727 728 729
    let mPatch = last patches
    case mPatch of
      Nothing -> pure unit
730 731
      Just (Left err) -> liftEffect $ do
        T.modify_ (A.cons $ FRESTError { error: err }) errors
arturo's avatar
arturo committed
732
        here.warn2 "[sendPatches] RESTError" err
733
      Just (Right (CNT.Versioned _patch)) -> do
734
        liftEffect $ T2.reload reloadForest
735

736
-- Why is this called delete node?
737 738 739 740
sendPatch :: TermList
          -> Session
          -> GET.MetaData
          -> Record SigmaxT.Node
741
          -> AffRESTError CNT.VersionedNgramsPatches
742
sendPatch termList session (GET.MetaData metaData) node = do
743 744 745 746
    eRet  <- NTC.putNgramsPatches coreParams versioned
    case eRet of
      Left err -> pure $ Left err
      Right ret -> do
747
        _task <- NTC.postNgramsChartsAsync coreParams  -- TODO add task
748
        pure $ Right ret
749
  where
750
    nodeId :: NodeID
751
    nodeId = unsafePartial $ fromJust $ fromString node.id
752

753 754
    versioned :: CNT.VersionedNgramsPatches
    versioned = CNT.Versioned {version: metaData.list.version, data: np}
755

756
    coreParams :: CNT.CoreParams ()
757
    coreParams = {session, nodeId, listIds: [metaData.list.listId], tabType}
758

759 760
    tabNgramType :: CTabNgramType
    tabNgramType = modeTabType node.gargType
761

762 763
    tabType :: TabType
    tabType = TabCorpus (TabNgramType tabNgramType)
764

765
    term :: CNT.NgramsTerm
766
    term = NTC.normNgram tabNgramType node.label
767

768 769
    np :: CNT.NgramsPatches
    np = NTC.singletonPatchMap term $ CNT.NgramsPatch { patch_children: mempty, patch_list }
770

771 772
    patch_list :: CNT.Replace TermList
    patch_list = CNT.Replace { new: termList, old: MapTerm }
773

arturo's avatar
arturo committed
774

775

776
-----------------------------------------------------
777 778 779
documentation :: Lang -> R.Element
documentation _ =

arturo's avatar
arturo committed
780 781 782 783 784 785 786 787 788
    H.div
    { className: "graph-documentation" }
    [
      H.div
      { className: "graph-documentation__text-section" }
      [
        H.p
        {}
        [
arturo's avatar
arturo committed
789
          B.b_ "What is a graph? "
arturo's avatar
arturo committed
790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858
        ,
          H.text "Graph is a conveniant tool to explore your documents."
        ]
      ,
        H.p
        {}
        [
          H.text $

            "Nodes are terms selected in your Map List. "
          <>
            "Node size is proportional to the number of documents with the associated term. "
        ]
      ,
        H.p
        {}
        [
          H.text $

            "Edges between nodes represent proximities of terms according to a specific distance between your documents. "
          <>
            "Link strength is proportional to the strenght of terms association."
        ]
      ]
    ,
      H.div
      { className: "graph-documentation__text-section" }
      [
        H.ul
        {}
        [
          H.li
          {}
          [
            H.text $

              "Click on a node to select/unselect and get its information."
          ]
        ,
          H.li
          {}
          [
            H.text $

              "In case of multiple selection, the button unselect clears all selections. "
            <>
              "Use your mouse scroll to zoom in and out in the graph. "
          ]
        ,
          H.li
          {}
          [
            H.text $

              "Use the node filter to create a subgraph with nodes of a given size "
            <>
              "range (e.g. display only generic terms). "
          ]
        ,
          H.li
          {}
          [
            H.text $

              "Use the edge filter so create a subgraph with links in a given range (e.g. keep the strongest association)."
          ]
        ]
      ]
    ]
859 860 861 862 863 864 865 866 867 868

{-
TODO DOC
  Conditional distance between the terms X and Y is the probability to have both terms X and Y in the same textual context.
  Distributional distance between the terms X and Y is the probability to have same others terms in the same textual context as X or Y.

Global/local view:
    The 'change level' button allows to change between global view and node centered view,
    To explore the neighborhood of a selection click on the 'change level' button.
-}