Sidebar.purs 21.7 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 26
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), 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, 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
63

arturo's avatar
arturo committed
64 65 66 67 68
sidebarCpt :: R.Component Props
sidebarCpt = here.component "sidebar" cpt where
  cpt props _ = do
    -- States
    { sideTab
arturo's avatar
arturo committed
69
    } <- GraphStore.use
70

arturo's avatar
arturo committed
71
    sideTab'  <- R2.useLive' sideTab
72

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

arturo's avatar
arturo committed
81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
    -- Render
    pure $

      H.div
      { className: "graph-sidebar" }
      [
        -- 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
100 101 102 103
------------------------------------------------------------

sideTabLegend :: R2.Leaf Props
sideTabLegend = R2.leaf sideTabLegendCpt
arturo's avatar
arturo committed
104

105
sideTabLegendCpt :: R.Component Props
arturo's avatar
arturo committed
106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
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
143 144 145 146 147

      H.div
      { className: "graph-sidebar__legend-tab" }
      [
        Legend.legend
arturo's avatar
arturo committed
148 149 150 151 152
        { legendSeq: Seq.fromFoldable legend
        , extractedNodeList
        , nodeCountList
        , selectedNodeIds: store.selectedNodeIds
        }
arturo's avatar
arturo committed
153 154 155 156 157 158 159 160 161 162
      ,
        H.hr {}
      ,
        documentation EN
      ]

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

sideTabData :: R2.Leaf Props
sideTabData = R2.leaf sideTabDataCpt
arturo's avatar
arturo committed
163

164
sideTabDataCpt :: R.Component Props
arturo's avatar
arturo committed
165 166 167 168 169
sideTabDataCpt = here.component "sideTabData" cpt where
  cpt props _ = do
    -- States
    { selectedNodeIds
    , graph
arturo's avatar
arturo committed
170
    } <- GraphStore.use
arturo's avatar
arturo committed
171 172 173

    selectedNodeIds'  <- R2.useLive' selectedNodeIds
    graph'            <- R2.useLive' graph
174

arturo's avatar
arturo committed
175 176 177
    -- Computed
    let
      hasSelection = not $ Set.isEmpty selectedNodeIds'
arturo's avatar
arturo committed
178

arturo's avatar
arturo committed
179 180
    -- Render
    pure $
arturo's avatar
arturo committed
181

arturo's avatar
arturo committed
182 183 184 185
      H.div
      { className: "graph-sidebar__data-tab" }
      [
        case hasSelection of
arturo's avatar
arturo committed
186

arturo's avatar
arturo committed
187 188
          -- No result
          false ->
arturo's avatar
arturo committed
189

arturo's avatar
arturo committed
190 191 192 193 194
            B.caveat
            {}
            [
              H.text "Select one or more nodes to get their informations"
            ]
arturo's avatar
arturo committed
195

arturo's avatar
arturo committed
196 197
          -- Nodes have been selected
          true ->
arturo's avatar
arturo committed
198

arturo's avatar
arturo committed
199 200 201 202 203 204 205 206 207 208 209 210 211 212
            R.fragment
            [
              selectedNodes $
              { nodesMap: SigmaxT.nodesGraphMap graph'
              } `Record.merge` props
            ,
              sideBarTabSeparator
            ,
              neighborhood
              {}
            ,
              sideBarTabSeparator
            ,
              docListWrapper
arturo's avatar
arturo committed
213
              { metaData: props.metaData
arturo's avatar
arturo committed
214 215 216
              }
            ]
      ]
217

arturo's avatar
arturo committed
218
------------------------------------------------------------
219

arturo's avatar
arturo committed
220 221
sideTabCommunity :: R2.Leaf Props
sideTabCommunity = R2.leaf sideTabCommunityCpt
arturo's avatar
arturo committed
222

223
sideTabCommunityCpt :: R.Component Props
arturo's avatar
arturo committed
224
sideTabCommunityCpt = here.component "sideTabCommunity" cpt where
arturo's avatar
arturo committed
225
  cpt props _ = do
arturo's avatar
arturo committed
226 227 228
    -- States
    { selectedNodeIds
    , graph
arturo's avatar
arturo committed
229
    } <- GraphStore.use
230

arturo's avatar
arturo committed
231 232
    selectedNodeIds'  <- R2.useLive' selectedNodeIds
    graph'            <- R2.useLive' graph
arturo's avatar
arturo committed
233

arturo's avatar
arturo committed
234 235 236
    -- Computed
    let
      hasSelection = not $ Set.isEmpty selectedNodeIds'
arturo's avatar
arturo committed
237

arturo's avatar
arturo committed
238 239
    -- Render
    pure $
arturo's avatar
arturo committed
240

arturo's avatar
arturo committed
241 242 243 244
      H.div
      { className: "graph-sidebar__community-tab" }
      [
        case hasSelection of
arturo's avatar
arturo committed
245

arturo's avatar
arturo committed
246 247
          -- No result
          false ->
arturo's avatar
arturo committed
248

arturo's avatar
arturo committed
249 250 251 252 253
            B.caveat
            {}
            [
              H.text "Select one or more nodes to get their informations"
            ]
arturo's avatar
arturo committed
254

arturo's avatar
arturo committed
255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270
          -- Nodes have been selection
          true ->

            R.fragment
            [
              selectedNodes $
              { nodesMap: SigmaxT.nodesGraphMap graph'
              } `Record.merge` props
            ,
              sideBarTabSeparator
            ,
              neighborhood
              {}
            ,
              sideBarTabSeparator
            ,
arturo's avatar
arturo committed
271 272
              contactListWrapper
              { metaData: props.metaData
arturo's avatar
arturo committed
273 274 275
              }
            ]
      ]
276

arturo's avatar
arturo committed
277 278 279 280 281 282 283 284
-------------------------------------------

sideBarTabSeparator :: R.Element
sideBarTabSeparator =
  H.div
  { className: "graph-sidebar__separator" }
  [
    B.icon
arturo's avatar
arturo committed
285
    { name: "angle-double-down" }
arturo's avatar
arturo committed
286
  ]
287 288

-------------------------------------------
289 290
-- TODO
-- selectedNodes :: Record Props -> Map.Map String Nodes -> R.Element
291

arturo's avatar
arturo committed
292 293
type SelectedNodesProps =
  ( nodesMap :: SigmaxT.NodesMap
294 295 296
  | Props
  )

arturo's avatar
arturo committed
297 298
selectedNodes :: R2.Leaf SelectedNodesProps
selectedNodes = R2.leaf selectedNodesCpt
arturo's avatar
arturo committed
299

300
selectedNodesCpt :: R.Component SelectedNodesProps
arturo's avatar
arturo committed
301
selectedNodesCpt = here.component "selectedNodes" cpt where
arturo's avatar
arturo committed
302
  cpt props _ = do
303 304
    -- | States
    -- |
arturo's avatar
arturo committed
305 306
    { selectedNodeIds
    , graph
307
    , expandSelection
arturo's avatar
arturo committed
308
    } <- GraphStore.use
arturo's avatar
arturo committed
309

arturo's avatar
arturo committed
310 311
    selectedNodeIds'    <- R2.useLive' selectedNodeIds
    graph'              <- R2.useLive' graph
312 313 314 315 316 317 318 319
    expandSelection'    <- R2.useLive' expandSelection

    -- | Effects
    -- |

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

321 322
    -- | Behaviors
    -- |
arturo's avatar
arturo committed
323 324 325
    let
      onBadgeClick id _ = T.write_ (Set.singleton id) selectedNodeIds

326
      onExpandClick _ = T.modify_ (not) expandSelection
arturo's avatar
arturo committed
327

328 329
    -- | Render
    -- |
arturo's avatar
arturo committed
330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345
    pure $

      H.ul
      { className: intercalate " "
          [ "graph-selected-nodes"
          , "list-group"
          ]
        }
      [
        H.li
        { className: "list-group-item" }
        [
          H.ul
          {} $

          Seq.toUnfoldable $
arturo's avatar
arturo committed
346
            flip Seq.map (badges graph' selectedNodeIds') \node ->
arturo's avatar
arturo committed
347 348 349 350 351 352 353 354 355 356 357 358

              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
359
              ]
arturo's avatar
arturo committed
360 361 362
        ,
          -- Expand NGrams actions
          B.iconButton
363
          { name: expandSelection' ?
arturo's avatar
arturo committed
364 365 366 367 368
              "caret-up" $
              "caret-down"
          , className: "graph-selected-nodes__expand"
          , callback: onExpandClick
          }
arturo's avatar
arturo committed
369 370
        ]
      ,
arturo's avatar
arturo committed
371
        -- NGrams actions
372
        R2.when expandSelection' $
arturo's avatar
arturo committed
373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412

          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
413
            ]
arturo's avatar
arturo committed
414
          ]
arturo's avatar
arturo committed
415 416
      ]

417 418 419 420 421 422
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
423 424
---------------------------------------------------------

arturo's avatar
arturo committed
425
neighborhood :: R2.Leaf ()
arturo's avatar
arturo committed
426
neighborhood = R2.leaf neighborhoodCpt
arturo's avatar
arturo committed
427
neighborhoodCpt :: R.Memo ()
arturo's avatar
arturo committed
428
neighborhoodCpt = R.memo' $ here.component "neighborhood" cpt where
arturo's avatar
arturo committed
429
  cpt _ _ = do
430 431
    -- | States
    -- |
arturo's avatar
arturo committed
432 433
    { selectedNodeIds
    , graph
434
    , expandNeighborhood
arturo's avatar
arturo committed
435
    } <- GraphStore.use
arturo's avatar
arturo committed
436 437

    selectedNodeIds' <-
arturo's avatar
arturo committed
438 439
      R2.useLive' selectedNodeIds

440 441
    expandNeighborhood' <-
      R2.useLive' expandNeighborhood
arturo's avatar
arturo committed
442

arturo's avatar
arturo committed
443 444
    graph' <-
      R2.useLive' graph
arturo's avatar
arturo committed
445 446 447

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

arturo's avatar
arturo committed
449 450
    termList /\ termListBox <-
      R2.useBox' []
arturo's avatar
arturo committed
451

arturo's avatar
arturo committed
452 453
    termCount /\ termCountBox <-
      R2.useBox' 0
arturo's avatar
arturo committed
454

455 456
    -- | Computed
    -- |
arturo's avatar
arturo committed
457
    let
458
      minSize = F.foldl DN.min 0.0 (Seq.map _.size (SigmaxT.graphNodes graph'))
arturo's avatar
arturo committed
459

460
      maxSize = F.foldl DN.max 0.0 (Seq.map _.size (SigmaxT.graphNodes graph'))
arturo's avatar
arturo committed
461 462 463

      maxTruncateResult = 5

arturo's avatar
arturo committed
464
      withTruncateResults = (termCount > maxTruncateResult) && (not showMore)
arturo's avatar
arturo committed
465 466


467 468
    -- | Behaviors
    -- |
arturo's avatar
arturo committed
469 470 471
    let
      onBadgeClick id _ = T.write_ (Set.singleton id) selectedNodeIds

472 473 474 475 476 477 478 479
      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
480

arturo's avatar
arturo committed
481
    R.useEffect1' selectedNodeIds' do
arturo's avatar
arturo committed
482
      let refreshed = neighbourBadges graph' selectedNodeIds'
arturo's avatar
arturo committed
483 484 485 486
      let count     = Seq.length refreshed
      let ordered   = A.sortWith (\n -> -n.size) $ Seq.toUnfoldable refreshed
      T.write_ count   termCountBox
      T.write_ ordered termListBox
arturo's avatar
arturo committed
487 488
      T.write_ false showMoreBox

489 490
    -- | Render
    -- |
arturo's avatar
arturo committed
491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507
    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
508 509
            B.wad'
            [ "text-info", "d-inline" ] $
arturo's avatar
arturo committed
510
            show termCount
arturo's avatar
arturo committed
511 512
          ,
            H.text $ nbsp 1 <> "terms"
arturo's avatar
arturo committed
513 514 515
          ,
            -- Expand word cloud
            B.iconButton
516
            { name: expandNeighborhood' ?
arturo's avatar
arturo committed
517 518 519 520 521
                "caret-up" $
                "caret-down"
            , className: "graph-neighborhood__expand"
            , callback: onExpandClick
            }
522 523
          ]
        ]
arturo's avatar
arturo committed
524 525
      ,
        -- Word cloud
526
        R2.when expandNeighborhood' $
arturo's avatar
arturo committed
527

arturo's avatar
arturo committed
528 529 530 531 532 533 534 535 536
          H.li
          { className: "list-group-item"}
          [
            H.ul
            {} $
            flip mapWithIndex termList \index node ->

              R2.when
              (
537 538 539
                (withTruncateResults == false
                || index < maxTruncateResult)
                && (not $ Set.member node.id selectedNodeIds')
arturo's avatar
arturo committed
540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569
              ) $
                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
570
              [
arturo's avatar
arturo committed
571
                H.text "Show more"
arturo's avatar
arturo committed
572
              ]
arturo's avatar
arturo committed
573
          ]
arturo's avatar
arturo committed
574
      ]
575

576 577 578 579 580 581
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
582
---------------------------------------------------------
583

arturo's avatar
arturo committed
584 585
type UpdateTermButtonProps =
  ( variant    :: ButtonVariant
586 587
  , nodesMap   :: SigmaxT.NodesMap
  , rType      :: TermList
arturo's avatar
arturo committed
588
  | Props
589 590
  )

591
updateTermButton :: R2.Component UpdateTermButtonProps
arturo's avatar
arturo committed
592
updateTermButton = R2.component updateTermButtonCpt
arturo's avatar
arturo committed
593

594
updateTermButtonCpt :: R.Component UpdateTermButtonProps
arturo's avatar
arturo committed
595
updateTermButtonCpt = here.component "updateTermButton" cpt where
arturo's avatar
arturo committed
596
  cpt { variant
arturo's avatar
arturo committed
597 598 599 600 601 602
      , metaData
      , nodesMap
      , rType
      , session
      } children = do
    -- States
arturo's avatar
arturo committed
603 604 605 606
    { errors
    , reloadForest
    } <- AppStore.use

arturo's avatar
arturo committed
607 608 609
    { removedNodeIds
    , selectedNodeIds
    , graphId
arturo's avatar
arturo committed
610
    } <- GraphStore.use
arturo's avatar
arturo committed
611 612 613

    selectedNodeIds' <- R2.useLive' selectedNodeIds
    graphId'         <- R2.useLive' graphId
arturo's avatar
arturo committed
614 615 616 617 618 619 620

    -- Behaviors
    let
      callback _ = do
        let nodes = mapMaybe (\id -> Map.lookup id nodesMap)
                            $ Set.toUnfoldable selectedNodeIds'
        sendPatches { errors
arturo's avatar
arturo committed
621
                    , graphId: graphId'
arturo's avatar
arturo committed
622 623 624 625
                    , metaData: metaData
                    , nodes
                    , session: session
                    , termList: rType
arturo's avatar
arturo committed
626 627
                    , reloadForest
                    }
arturo's avatar
arturo committed
628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648
        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
    minFontSize = 10.0
    maxFontSize = 24.0
    sizeScaled = (size - minSize) / (maxSize - minSize)  -- in [0; 1] range
649
    scale' = DN.log (sizeScaled + 1.0) / (DN.log 2.0)  -- in [0; 1] range
arturo's avatar
arturo committed
650 651 652 653
    scale = minFontSize + scale' * (maxFontSize - minFontSize)

  in
    show scale <> "px"
654

655

656 657
badges :: SigmaxT.SGraph -> SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
badges graph selectedNodeIds = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
658

659
neighbourBadges :: SigmaxT.SGraph -> SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
660 661
neighbourBadges graph selectedNodeIds = SigmaxT.neighbours graph selectedNodes' where
  selectedNodes' = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
662

arturo's avatar
arturo committed
663 664
---------------------------------------------------------

665
type SendPatches =
666 667
  ( errors       :: T.Box (Array FrontendError)
  , graphId      :: NodeID
668 669
  , metaData     :: GET.MetaData
  , nodes        :: Array (Record SigmaxT.Node)
670
  , reloadForest :: T2.ReloadS
671 672
  , session      :: Session
  , termList     :: TermList
673
  )
674

675
sendPatches :: Record SendPatches -> Effect Unit
676
sendPatches { errors, metaData, nodes, reloadForest, session, termList } = do
677
  launchAff_ do
678
    patches <- (parTraverse (sendPatch termList session metaData) nodes) -- :: Aff (Array CNT.VersionedNgramsPatches)
679 680 681
    let mPatch = last patches
    case mPatch of
      Nothing -> pure unit
682 683
      Just (Left err) -> liftEffect $ do
        T.modify_ (A.cons $ FRESTError { error: err }) errors
arturo's avatar
arturo committed
684
        here.warn2 "[sendPatches] RESTError" err
685
      Just (Right (CNT.Versioned _patch)) -> do
686
        liftEffect $ T2.reload reloadForest
687

688
-- Why is this called delete node?
689 690 691 692
sendPatch :: TermList
          -> Session
          -> GET.MetaData
          -> Record SigmaxT.Node
693
          -> AffRESTError CNT.VersionedNgramsPatches
694
sendPatch termList session (GET.MetaData metaData) node = do
695 696 697 698
    eRet  <- NTC.putNgramsPatches coreParams versioned
    case eRet of
      Left err -> pure $ Left err
      Right ret -> do
699
        _task <- NTC.postNgramsChartsAsync coreParams  -- TODO add task
700
        pure $ Right ret
701
  where
702
    nodeId :: NodeID
703
    nodeId = unsafePartial $ fromJust $ fromString node.id
704

705 706
    versioned :: CNT.VersionedNgramsPatches
    versioned = CNT.Versioned {version: metaData.list.version, data: np}
707

708
    coreParams :: CNT.CoreParams ()
709
    coreParams = {session, nodeId, listIds: [metaData.list.listId], tabType}
710

711 712
    tabNgramType :: CTabNgramType
    tabNgramType = modeTabType node.gargType
713

714 715
    tabType :: TabType
    tabType = TabCorpus (TabNgramType tabNgramType)
716

717
    term :: CNT.NgramsTerm
718
    term = NTC.normNgram tabNgramType node.label
719

720 721
    np :: CNT.NgramsPatches
    np = NTC.singletonPatchMap term $ CNT.NgramsPatch { patch_children: mempty, patch_list }
722

723 724
    patch_list :: CNT.Replace TermList
    patch_list = CNT.Replace { new: termList, old: MapTerm }
725

arturo's avatar
arturo committed
726

727 728 729

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

arturo's avatar
arturo committed
730 731
            {-, H.div { className: "col-md-12", id: "horizontal-checkbox" }
              [ H.ul {}
732 733 734 735 736 737 738
                [ checkbox "Pubs"
                , checkbox "Projects"
                , checkbox "Patents"
                , checkbox "Others"
                ]
              ]
              -}
739 740 741 742 743
--------------------------------------------------------------------------

documentation :: Lang -> R.Element
documentation _ =

arturo's avatar
arturo committed
744 745 746 747 748 749 750 751 752
    H.div
    { className: "graph-documentation" }
    [
      H.div
      { className: "graph-documentation__text-section" }
      [
        H.p
        {}
        [
arturo's avatar
arturo committed
753
          B.b_ "What is a graph? "
arturo's avatar
arturo committed
754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 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
        ,
          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)."
          ]
        ]
      ]
    ]
823 824 825 826 827 828 829 830 831 832

{-
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.
-}