Sidebar.purs 16.5 KB
Newer Older
1
module Gargantext.Components.GraphExplorer.Sidebar
2
  -- (Props, sidebar)
3
  where
4

5 6
import Gargantext.Prelude

7
import Control.Parallel (parTraverse)
8
import Data.Array (head, last, concat)
9
import Data.Array as A
10
import Data.Either (Either(..))
11
import Data.Int (fromString)
12
import Data.Map as Map
13
import Data.Maybe (Maybe(..), fromJust)
14
import Data.Sequence as Seq
15
import Data.Set as Set
16
import Effect (Effect)
17
import Effect.Aff (Aff, launchAff_)
18
import Effect.Class (liftEffect)
19
import Gargantext.Components.App.Data (Boxes)
20
import Gargantext.Components.GraphExplorer.Legend as Legend
21
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
22 23
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Lang (Lang(..))
24
import Gargantext.Components.NgramsTable.Core as NTC
25
import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT
26
import Gargantext.Components.RandomText (words)
27
import Gargantext.Components.Search (SearchType(..), SearchQuery(..))
28
import Gargantext.Config.REST (RESTError)
29
import Gargantext.Data.Array (mapMaybe)
30
import Gargantext.Ends (Frontends)
31
import Gargantext.Hooks.Sigmax.Types as SigmaxT
32
import Gargantext.Sessions (Session)
33
import Gargantext.Types (CTabNgramType, FrontendError(..), NodeID, TabSubType(..), TabType(..), TermList(..), modeTabType)
34
import Gargantext.Utils.Reactix as R2
35
import Gargantext.Utils.Toestand as T2
36 37 38 39 40 41 42
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as RH
import Record as Record
import Record.Extra as RX
import Toestand as T
43

44 45
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Sidebar"
46

47
type Common = (
48
    boxes           :: Boxes
49
  , graphId         :: NodeID
50 51
  , metaData        :: GET.MetaData
  , session         :: Session
52 53 54 55 56 57
  )

type Props = (
    frontends       :: Frontends
  , graph           :: SigmaxT.SGraph
  | Common
58
  )
59

60 61
sidebar :: R2.Component Props
sidebar = R.createElement sidebarCpt
62
sidebarCpt :: R.Component Props
63
sidebarCpt = here.component "sidebar" cpt
64
  where
65 66
    cpt props@{ boxes: { sidePanelGraph } } _ = do
      { sideTab } <- GEST.focusedSidePanel sidePanelGraph
67 68 69 70 71
      sideTab' <- T.useLive T.unequal sideTab

      pure $ RH.div { id: "sp-container" }
        [ sideTabNav { sideTab
                     , sideTabs: [GET.SideTabLegend, GET.SideTabData, GET.SideTabCommunity] } []
72 73 74 75
        , case sideTab' of
            GET.SideTabLegend -> sideTabLegend sideTabProps []
            GET.SideTabData -> sideTabData sideTabProps []
            GET.SideTabCommunity -> sideTabCommunity sideTabProps []
76
        ]
77
      where
78
        sideTabProps = RX.pick props :: Record Props
79

80
type SideTabNavProps = (
81 82
    sideTab  :: T.Box GET.SideTab
  , sideTabs :: Array GET.SideTab
83 84 85 86 87 88 89
  )

sideTabNav :: R2.Component SideTabNavProps
sideTabNav = R.createElement sideTabNavCpt
sideTabNavCpt :: R.Component SideTabNavProps
sideTabNavCpt = here.component "sideTabNav" cpt
  where
90 91
    cpt { sideTab, sideTabs } _ = do
      sideTab' <- T.useLive T.unequal sideTab
92 93

      pure $ R.fragment [ H.div { className: "text-primary center"} [H.text ""]
94
                        , H.div { className: "nav nav-tabs"} (liItem sideTab' <$> sideTabs)
95 96 97
                            -- , H.div {className: "center"} [ H.text "Doc sideTabs"]
                        ]
      where
98 99
        liItem :: GET.SideTab -> GET.SideTab -> R.Element
        liItem sideTab' tab =
100
          H.div { className : "nav-item nav-link"
101
                            <> if tab == sideTab'
102 103
                                 then " active"
                                 else ""
104 105
                , on: { click: \_ -> T.write_ tab sideTab }
                } [ H.text $ show tab ]
106

107
sideTabLegend :: R2.Component Props
108
sideTabLegend = R.createElement sideTabLegendCpt
109
sideTabLegendCpt :: R.Component Props
110 111
sideTabLegendCpt = here.component "sideTabLegend" cpt
  where
112
    cpt { metaData: GET.MetaData { legend } } _ = do
113 114 115 116
      pure $ H.div {}
        [ Legend.legend { items: Seq.fromFoldable legend }
        , documentation EN
        ]
117

118
sideTabData :: R2.Component Props
119
sideTabData = R.createElement sideTabDataCpt
120
sideTabDataCpt :: R.Component Props
121 122
sideTabDataCpt = here.component "sideTabData" cpt
  where
123 124 125
    cpt props@{ boxes: { sidePanelGraph } } _ = do
      { selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
      selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
126 127 128 129 130

      pure $ RH.div {}
        [ selectedNodes (Record.merge { nodesMap: SigmaxT.nodesGraphMap props.graph } props) []
        , neighborhood props []
        , RH.div { className: "col-md-12", id: "query" }
131 132 133 134 135 136 137
          [ query { frontends: props.frontends
                  , metaData: props.metaData
                  , nodesMap: SigmaxT.nodesGraphMap props.graph
                  , searchType: SearchDoc
                  , selectedNodeIds: selectedNodeIds'
                  , session: props.session
                  } []
138 139
          ]
        ]
140

141

142
sideTabCommunity :: R2.Component Props
143
sideTabCommunity = R.createElement sideTabCommunityCpt
144
sideTabCommunityCpt :: R.Component Props
145 146
sideTabCommunityCpt = here.component "sideTabCommunity" cpt
  where
147 148 149 150
    cpt props@{ boxes: { sidePanelGraph }
              , frontends } _ = do
      { selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
      selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
151 152 153 154

      pure $ RH.div { className: "col-md-12", id: "query" }
        [ selectedNodes (Record.merge { nodesMap: SigmaxT.nodesGraphMap props.graph } props) []
        , neighborhood props []
155
        , query { frontends
156 157 158 159 160 161
                , metaData: props.metaData
                , nodesMap: SigmaxT.nodesGraphMap props.graph
                , searchType: SearchContact
                , selectedNodeIds: selectedNodeIds'
                , session: props.session
                } []
162
        ]
163 164 165


-------------------------------------------
166 167
-- TODO
-- selectedNodes :: Record Props -> Map.Map String Nodes -> R.Element
168 169 170 171 172 173 174 175 176 177 178

type SelectedNodesProps = (
  nodesMap :: SigmaxT.NodesMap
  | Props
  )

selectedNodes :: R2.Component SelectedNodesProps
selectedNodes = R.createElement selectedNodesCpt
selectedNodesCpt :: R.Component SelectedNodesProps
selectedNodesCpt = here.component "selectedNodes" cpt
  where
179 180 181 182
    cpt props@{ boxes: { sidePanelGraph }
              , graph
              , nodesMap } _ = do
      { selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
183 184 185 186
      selectedNodeIds' <- T.useLive T.unequal selectedNodeIds

      pure $ R2.row
        [ R2.col 12
187 188 189
          [ RH.ul { className: "nav nav-tabs d-flex justify-content-center"
                  , id: "myTab"
                  , role: "tablist" }
Alexandre Delanoë's avatar
Alexandre Delanoë committed
190
            [ RH.div { className: "tab-content" }
191
              [ RH.div { className: "d-flex flex-wrap justify-content-center"
Alexandre Delanoë's avatar
Alexandre Delanoë committed
192
                       , role: "tabpanel" }
193 194 195 196 197
                ( Seq.toUnfoldable
                  $ ( Seq.map (badge selectedNodeIds)
                      (badges graph selectedNodeIds')
                    )
                )
Alexandre Delanoë's avatar
Alexandre Delanoë committed
198 199 200
              , H.br {}
              ]
            ]
201
          , RH.div { className: "tab-content flex-space-between" }
202 203 204 205
            [ updateTermButton (Record.merge { buttonType: "primary"
                                             , rType: CandidateTerm
                                             , nodesMap
                                             , text: "Move as candidate" } commonProps) []
206
            , H.br {}
207 208 209 210
            , updateTermButton (Record.merge { buttonType: "danger"
                                             , nodesMap
                                             , rType: StopTerm
                                             , text: "Move as stop" } commonProps) []
211 212 213 214 215 216 217 218 219 220 221
            ]
          ]
        ]
      where
        commonProps = RX.pick props :: Record Common

neighborhood :: R2.Component Props
neighborhood = R.createElement neighborhoodCpt
neighborhoodCpt :: R.Component Props
neighborhoodCpt = here.component "neighborhood" cpt
  where
222 223 224 225
    cpt { boxes: { sidePanelGraph }
        , graph
         } _ = do
      { selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
226 227 228 229 230 231 232 233 234 235 236 237 238 239
      selectedNodeIds' <- T.useLive T.unequal selectedNodeIds

      pure $ RH.div { className: "tab-content", id: "myTabContent" }
        [ RH.div { -- className: "flex-space-around d-flex justify-content-center"
             className: "d-flex flex-wrap flex-space-around"
             , id: "home"
             , role: "tabpanel"
             }
          (Seq.toUnfoldable $ Seq.map (badge selectedNodeIds)
           $ neighbourBadges graph selectedNodeIds'
          )
        ]


240
type UpdateTermButtonProps = (
241 242 243 244 245 246 247
    buttonType :: String
  , nodesMap   :: SigmaxT.NodesMap
  , rType      :: TermList
  , text       :: String
  | Common
  )

248 249 250 251
updateTermButton :: R2.Component UpdateTermButtonProps
updateTermButton = R.createElement updateTermButtonCpt
updateTermButtonCpt :: R.Component UpdateTermButtonProps
updateTermButtonCpt = here.component "updateTermButton" cpt
252
  where
253 254 255 256
    cpt { boxes: { errors
                 , reloadForest
                 , sidePanelGraph }
        , buttonType
257 258 259 260 261 262
        , graphId
        , metaData
        , nodesMap
        , rType
        , session
        , text } _ = do
263
      { removedNodeIds, sideTab, selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
264 265 266 267 268 269
      selectedNodeIds' <- T.useLive T.unequal selectedNodeIds

      pure $ if Set.isEmpty selectedNodeIds' then
               RH.div {} []
             else
               RH.button { className: "btn btn-sm btn-" <> buttonType
270
                         , on: { click: onClickRemove removedNodeIds selectedNodeIds selectedNodeIds' }
271 272
                         } [ RH.text text ]
      where
273
        onClickRemove removedNodeIds selectedNodeIds selectedNodeIds' _ = do
274 275
          let nodes = mapMaybe (\id -> Map.lookup id nodesMap)
                              $ Set.toUnfoldable selectedNodeIds'
276 277
          sendPatches { errors
                      , graphId: graphId
278 279 280 281 282
                      , metaData: metaData
                      , nodes
                      , session: session
                      , termList: rType
                      , reloadForest }
283 284
          T.write_ selectedNodeIds' removedNodeIds
          T.write_ SigmaxT.emptyNodeIds selectedNodeIds
285 286 287



288
badge :: T.Box SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element
289
badge selectedNodeIds {id, label} =
290
  RH.a { className: "badge badge-pill badge-light"
291
       , on: { click: onClick }
292
       } [ RH.h6 {} [ RH.text label ] ]
293
  where
294
    onClick _ = do
295
      T.write_ (Set.singleton id) selectedNodeIds
296

297 298
badges :: SigmaxT.SGraph -> SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
badges graph selectedNodeIds = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
299

300
neighbourBadges :: SigmaxT.SGraph -> SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
301 302
neighbourBadges graph selectedNodeIds = SigmaxT.neighbours graph selectedNodes' where
  selectedNodes' = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
303

304
type SendPatches =
305 306
  ( errors       :: T.Box (Array FrontendError)
  , graphId      :: NodeID
307 308
  , metaData     :: GET.MetaData
  , nodes        :: Array (Record SigmaxT.Node)
309
  , reloadForest :: T2.ReloadS
310 311
  , session      :: Session
  , termList     :: TermList
312
  )
313

314
sendPatches :: Record SendPatches -> Effect Unit
315
sendPatches { errors, metaData, nodes, reloadForest, session, termList } = do
316
  launchAff_ do
317
    patches <- (parTraverse (sendPatch termList session metaData) nodes) -- :: Aff (Array NTC.VersionedNgramsPatches)
318 319 320
    let mPatch = last patches
    case mPatch of
      Nothing -> pure unit
321 322 323
      Just (Left err) -> liftEffect $ do
        T.modify_ (A.cons $ FRESTError { error: err }) errors
        here.log2 "[sendPatches] RESTError" err
324
      Just (Right (NTC.Versioned _patch)) -> do
325
        liftEffect $ T2.reload reloadForest
326

327
-- Why is this called delete node?
328 329 330 331
sendPatch :: TermList
          -> Session
          -> GET.MetaData
          -> Record SigmaxT.Node
332
          -> Aff (Either RESTError NTC.VersionedNgramsPatches)
333
sendPatch termList session (GET.MetaData metaData) node = do
334 335 336 337
    eRet  <- NTC.putNgramsPatches coreParams versioned
    case eRet of
      Left err -> pure $ Left err
      Right ret -> do
338
        _task <- NTC.postNgramsChartsAsync coreParams  -- TODO add task
339
        pure $ Right ret
340
  where
341
    nodeId :: NodeID
342
    nodeId = unsafePartial $ fromJust $ fromString node.id
343

344 345
    versioned :: NTC.VersionedNgramsPatches
    versioned = NTC.Versioned {version: metaData.list.version, data: np}
346

347
    coreParams :: NTC.CoreParams ()
348
    coreParams = {session, nodeId, listIds: [metaData.list.listId], tabType}
349

350 351
    tabNgramType :: CTabNgramType
    tabNgramType = modeTabType node.gargType
352

353 354
    tabType :: TabType
    tabType = TabCorpus (TabNgramType tabNgramType)
355

356 357
    term :: NTC.NgramsTerm
    term = NTC.normNgram tabNgramType node.label
358

359 360
    np :: NTC.NgramsPatches
    np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list }
361

362
    patch_list :: NTC.Replace TermList
363
    patch_list = NTC.Replace { new: termList, old: MapTerm }
364

365 366 367 368 369 370 371 372 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 413 414
type Query =
  ( frontends       :: Frontends
  , metaData        :: GET.MetaData
  , nodesMap        :: SigmaxT.NodesMap
  , searchType      :: SearchType
  , selectedNodeIds :: SigmaxT.NodeIds
  , session         :: Session )

query :: R2.Component Query
query = R.createElement queryCpt

queryCpt :: R.Component Query
queryCpt = here.component "query" cpt where
  cpt props@{ selectedNodeIds } _ = do

    pure $ if Set.isEmpty selectedNodeIds
           then RH.div {} []
           else query' props []

query' :: R2.Component Query
query' = R.createElement queryCpt'

queryCpt' :: R.Component Query
queryCpt' = here.component "query'" cpt where
  cpt { frontends
      , metaData: GET.MetaData metaData
      , nodesMap
      , searchType
      , selectedNodeIds
      , session } _ = do
    pure $ case (head metaData.corpusId) of
      Nothing -> RH.div {} []
      Just corpusId ->
        CGT.tabs { frontends
                 , query: SearchQuery { expected: searchType
                                      , query : concat $ toQuery <$> Set.toUnfoldable selectedNodeIds
                                      }
                 , session
                 , sides: [side corpusId]
                 }

    where
      toQuery id = case Map.lookup id nodesMap of
        Nothing -> []
        Just n -> words n.label

      side corpusId = GET.GraphSideCorpus { corpusId
                                          , corpusLabel: metaData.title
                                          , listId     : metaData.list.listId
                                          }
415 416 417 418 419 420 421 422 423 424 425 426

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

            {-, RH.div { className: "col-md-12", id: "horizontal-checkbox" }
              [ RH.ul {}
                [ checkbox "Pubs"
                , checkbox "Projects"
                , checkbox "Patents"
                , checkbox "Others"
                ]
              ]
              -}
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 460 461
--------------------------------------------------------------------------


documentation :: Lang -> R.Element
documentation _ =
  H.div {} [ H.h2 {} [ H.text "What is Graph ?"]
           , ul [ "Graph is a conveniant tool to explore your documents. "
                , "Nodes are terms selected in your Map List. "
                <> "Node size is proportional to the number of documents with the associated term. "
                , "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.h3 {} [ H.text "Basic Interactions:"]
           , ul [ "Click on a node to select/unselect and get its information. "
                , "In case of multiple selection, the button unselect clears all selections. "
                <> "Use your mouse scroll to zoom in and out in the graph. "
                , "Use the node filter to create a subgraph with nodes of a given size "
                <>"range (e.g. display only generic terms). "
                , "Use the edge filter so create a subgraph with links in a given range (e.g. keep the strongest association)."
                ]
           ]

  where
    ul ts = H.ul {} $ map (\t -> H.li {} [ H.text t ]) ts

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