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

5
import Control.Parallel (parTraverse)
6
import Data.Array (head, last, concat)
7
import Data.Int (fromString)
8
import Data.Map as Map
9
import Data.Maybe (Maybe(..), fromJust)
10
import Data.Sequence as Seq
11
import Data.Set as Set
12
import Data.Tuple (fst, snd)
13
import Data.Tuple.Nested ((/\))
14 15
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
16
import Effect.Class (liftEffect)
17 18 19 20 21 22
import Reactix as R
import Reactix.DOM.HTML as RH
import Reactix.DOM.HTML as H

import Gargantext.Prelude

23
import Gargantext.Components.Lang (Lang(..))
24
import Gargantext.Components.Search (SearchType(..), SearchQuery(..))
25
import Gargantext.Components.GraphExplorer.Types  as GET
26
import Gargantext.Components.GraphExplorer.Types  (SidePanelState(..), SideTab(..))
27
import Gargantext.Components.GraphExplorer.Legend as Legend
28
import Gargantext.Components.NgramsTable.Core as NTC
29
import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT
30
import Gargantext.Components.RandomText (words)
31
import Gargantext.Data.Array (mapMaybe)
32
import Gargantext.Ends (Frontends)
33
import Gargantext.Hooks.Sigmax.Types as SigmaxT
34
import Gargantext.Sessions (Session)
35
import Gargantext.Types (CTabNgramType, TabSubType(..), TabType(..), TermList(..), modeTabType)
36
import Gargantext.Utils.Reactix as R2
37
import Gargantext.Utils.Reload as GUR
38
import Partial.Unsafe (unsafePartial)
39 40

thisModule = "Gargantext.Components.GraphExplorer.Sidebar"
41 42

type Props =
43 44 45
  ( frontends       :: Frontends
  , graph           :: SigmaxT.SGraph
  , graphId         :: Int
46
  , graphVersion    :: GUR.ReloadS
47 48
  , metaData        :: GET.MetaData
  , removedNodeIds  :: R.State SigmaxT.NodeIds
49
  , selectedNodeIds :: R.State SigmaxT.NodeIds
50
  , session         :: Session
51
  , showSidePanel   :: R.State GET.SidePanelState
52
  , treeReload      :: GUR.ReloadS
53
  )
54

55 56
sidebar :: Record Props -> R.Element
sidebar props = R.createElement sidebarCpt props []
57
  where
58 59 60
    sidebarCpt :: R.Component Props
    sidebarCpt = R.hooksComponentWithModule thisModule "sidebar" cpt

61
    cpt {showSidePanel: (GET.Closed /\ _)} _children = do
62
      pure $ RH.div {} []
63
    cpt {showSidePanel: (GET.InitialClosed /\ _)} _children = do
64
      pure $ RH.div {} []
65
    cpt props@{metaData, showSidePanel} _children = do
66
      pure $ RH.div { id: "sp-container" }
67
        [ sideTabNav showSidePanel [SideTabLegend, SideTabData, SideTabCommunity]
68 69 70 71 72
        , sideTab (fst showSidePanel) props
        ]

sideTabNav :: R.State SidePanelState -> Array SideTab -> R.Element
sideTabNav (sidePanel /\ setSidePanel) sideTabs =
73
  R.fragment [ H.div { className: "text-primary center"} [H.text ""]
74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89
                     , H.div {className: "nav nav-tabs"} (liItem <$> sideTabs)
                     -- , H.div {className: "center"} [ H.text "Doc sideTabs"]
             ]
    where
      liItem :: SideTab -> R.Element
      liItem  tab =
        H.div { className : "nav-item nav-link"
                          <> if (Opened tab) == sidePanel
                               then " active"
                               else ""
            , on: { click: \_ -> setSidePanel $ const (Opened tab)
                  }
            } [ H.text $ show tab ]

sideTab :: SidePanelState -> Record Props -> R.Element
sideTab (Opened SideTabLegend) props@{metaData} =
90
  H.div {} [ let (GET.MetaData {legend}) = metaData
91
                    in Legend.legend { items: Seq.fromFoldable legend}
92 93
           , documentation EN
           ]
94

95
sideTab (Opened SideTabData) props =
96 97
  RH.div {} [ selectedNodes props (SigmaxT.nodesGraphMap props.graph)
            , neighborhood  props
98 99 100 101 102
            , RH.div { className: "col-md-12", id: "query" }
                     [ query SearchDoc
                             props.frontends
                             props.metaData
                             props.session
103
                             (SigmaxT.nodesGraphMap props.graph)
104 105
                             props.selectedNodeIds
                     ]
106
            ]
107 108 109 110 111 112 113
    where

      checkbox text =
        RH.li {}
        [ RH.span {} [ RH.text text ]
        , RH.input { type: "checkbox"
                   , className: "checkbox"
114
                   , defaultChecked: true
115 116 117
                   , title: "Mark as completed" } ]


118 119
sideTab (Opened SideTabCommunity) props  =
  RH.div { className: "col-md-12", id: "query" }
120 121 122
                         [ selectedNodes props (SigmaxT.nodesGraphMap props.graph)
                         , neighborhood  props
                         , query SearchContact
123
                                 props.frontends
124 125 126 127 128
                                 props.metaData
                                 props.session
                                 (SigmaxT.nodesGraphMap props.graph)
                                 props.selectedNodeIds
                         ]
129 130 131 132 133

sideTab _ _  = H.div {} []


-------------------------------------------
134 135
-- TODO
-- selectedNodes :: Record Props -> Map.Map String Nodes -> R.Element
Alexandre Delanoë's avatar
Alexandre Delanoë committed
136 137
selectedNodes props nodesMap =
  R2.row [ R2.col 12
138 139 140
          [ RH.ul { className: "nav nav-tabs d-flex justify-content-center"
                  , id: "myTab"
                  , role: "tablist" }
Alexandre Delanoë's avatar
Alexandre Delanoë committed
141
            [ RH.div { className: "tab-content" }
142
              [ RH.div { className: "d-flex flex-wrap justify-content-center"
Alexandre Delanoë's avatar
Alexandre Delanoë committed
143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158
                       , role: "tabpanel" }
                       ( Seq.toUnfoldable
                       $ ( Seq.map (badge              props.selectedNodeIds)
                                   (badges props.graph props.selectedNodeIds)
                         )
                       )
              , H.br {}
              ]
            ]
            , RH.div { className: "tab-content flex-space-between" }
                     [ removeButton "primary" "Move as candidate" CandidateTerm props nodesMap
                     , H.br {}
                     , removeButton "danger"  "Move as stop"      StopTerm      props nodesMap
                     ]
           ]
       ]
159
neighborhood props = RH.div { className: "tab-content", id: "myTabContent" }
Alexandre Delanoë's avatar
Alexandre Delanoë committed
160
                            [ RH.div { -- className: "flex-space-around d-flex justify-content-center"
161
                                       className: "d-flex flex-wrap flex-space-around"
Alexandre Delanoë's avatar
Alexandre Delanoë committed
162 163 164
                                     , id: "home"
                                     , role: "tabpanel"
                                     }
165 166 167 168 169 170
                              (Seq.toUnfoldable $ Seq.map (badge props.selectedNodeIds)
                                                $ neighbourBadges props.graph props.selectedNodeIds
                               )
                            ]


Alexandre Delanoë's avatar
Alexandre Delanoë committed
171
removeButton btnType text rType props' nodesMap' =
172 173 174
  if Set.isEmpty $ fst props'.selectedNodeIds then
    RH.div {} []
  else
175
    RH.button { className: "btn btn-sm btn-" <> btnType
176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193
              , on: { click: onClickRemove rType props' nodesMap' }
              }
              [ RH.text text ]

onClickRemove rType props' nodesMap' e = do
  let nodes = mapMaybe (\id -> Map.lookup id nodesMap')
                       $ Set.toUnfoldable $ fst props'.selectedNodeIds
  deleteNodes { graphId: props'.graphId
              , metaData: props'.metaData
              , nodes
              , session: props'.session
              , termList: rType
              , treeReload: props'.treeReload }
  snd props'.removedNodeIds  $ const $ fst props'.selectedNodeIds
  snd props'.selectedNodeIds $ const SigmaxT.emptyNodeIds



194 195
badge :: R.State SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element
badge (_ /\ setNodeIds) {id, label} =
196
  RH.a { className: "badge badge-light"
197 198
       , on: { click: onClick }
       } [ RH.text label ]
199 200
  where
    onClick e = do
201
      setNodeIds $ const $ Set.singleton id
202

203 204
badges :: SigmaxT.SGraph -> R.State SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
badges graph (selectedNodeIds /\ _) = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
205

206 207
neighbourBadges :: SigmaxT.SGraph -> R.State SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
neighbourBadges graph (selectedNodeIds /\ _) = SigmaxT.neighbours graph selectedNodes
208
  where
209
    selectedNodes = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
210

211

212
type DeleteNodes =
213 214 215 216 217
  ( graphId    :: Int
  , metaData   :: GET.MetaData
  , nodes      :: Array (Record SigmaxT.Node)
  , session    :: Session
  , termList   :: TermList
218
  , treeReload :: GUR.ReloadS
219
  )
220

221 222
deleteNodes :: Record DeleteNodes -> Effect Unit
deleteNodes { graphId, metaData, nodes, session, termList, treeReload } = do
223 224 225 226 227 228
  launchAff_ do
    patches <- (parTraverse (deleteNode termList session metaData) nodes) :: Aff (Array NTC.VersionedNgramsPatches)
    let mPatch = last patches
    case mPatch of
      Nothing -> pure unit
      Just (NTC.Versioned patch) -> do
229
        liftEffect $ GUR.bump treeReload
230

231
-- Why is this called delete node?
232 233 234 235 236
deleteNode :: TermList
           -> Session
           -> GET.MetaData
           -> Record SigmaxT.Node
           -> Aff NTC.VersionedNgramsPatches
237
deleteNode termList session (GET.MetaData metaData) node = do
238
    ret  <- NTC.putNgramsPatches coreParams versioned
239 240
    task <- NTC.postNgramsChartsAsync coreParams  -- TODO add task
    pure ret
241 242 243
  where
    nodeId :: Int
    nodeId = unsafePartial $ fromJust $ fromString node.id
244

245 246
    versioned :: NTC.VersionedNgramsPatches
    versioned = NTC.Versioned {version: metaData.list.version, data: np}
247

248
    coreParams :: NTC.CoreParams ()
249
    coreParams = {session, nodeId, listIds: [metaData.list.listId], tabType}
250

251 252
    tabNgramType :: CTabNgramType
    tabNgramType = modeTabType node.gargType
253

254 255
    tabType :: TabType
    tabType = TabCorpus (TabNgramType tabNgramType)
256

257 258
    term :: NTC.NgramsTerm
    term = NTC.normNgram tabNgramType node.label
259

260 261
    pt :: NTC.NgramsTablePatch
    pt = NTC.fromNgramsPatches np
262

263 264
    np :: NTC.NgramsPatches
    np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list }
265

266
    patch_list :: NTC.Replace TermList
267
    patch_list = NTC.Replace { new: termList, old: MapTerm }
268

269 270
query :: SearchType
      -> Frontends
271 272 273 274 275
      -> GET.MetaData
      -> Session
      -> SigmaxT.NodesMap
      -> R.State SigmaxT.NodeIds
      -> R.Element
276 277
query _ _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} []
query searchType frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) =
278 279
  query' (head metaData.corpusId)
  where
280
    query' Nothing         = RH.div {} []
281 282 283 284 285 286 287 288
    query' (Just corpusId) =
      CGT.tabs { frontends
               , session
               , query: SearchQuery { query : concat $ toQuery <$> Set.toUnfoldable selectedNodeIds
                                    , expected: searchType
                                    }
               , sides: [side corpusId]
               }
289 290

    toQuery id = case Map.lookup id nodesMap of
291 292
      Nothing -> []
      Just n -> words n.label
293 294 295 296 297

    side corpusId = GET.GraphSideCorpus { corpusId
                                        , listId     : metaData.list.listId
                                        , corpusLabel: metaData.title
                                        }
298 299 300 301 302 303 304 305 306 307 308 309

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

            {-, RH.div { className: "col-md-12", id: "horizontal-checkbox" }
              [ RH.ul {}
                [ checkbox "Pubs"
                , checkbox "Projects"
                , checkbox "Patents"
                , checkbox "Others"
                ]
              ]
              -}
310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344
--------------------------------------------------------------------------


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