NgramsTable.purs 30.5 KB
Newer Older
1 2
module Gargantext.Components.NgramsTable
  ( MainNgramsTableProps
3
  , CommonProps
4 5
  , mainNgramsTable
  ) where
6

7
import Data.Array as A
8
import Data.FunctorWithIndex (mapWithIndex)
9
import Data.Lens (Lens', to, (%~), (.~), (^.), (^?), view)
10
import Data.Lens.At (at)
11
import Data.Lens.Common (_Just)
12
import Data.Lens.Fold (folded)
13
import Data.Lens.Index (ix)
14 15 16
import Data.Lens.Record (prop)
import Data.Map (Map)
import Data.Map as Map
17
import Data.Maybe (Maybe(..), fromMaybe, isNothing, maybe)
18
import Data.Monoid.Additive (Additive(..))
19
import Data.Ord.Down (Down(..))
20
import Data.Sequence (Seq, length) as Seq
21 22
import Data.Set (Set)
import Data.Set as Set
23
import Data.Symbol (SProxy(..))
24
import Data.Tuple (Tuple(..), fst)
25
import Data.Tuple.Nested ((/\))
26
import Effect (Effect)
27
import Effect.Aff (Aff)
28
import Reactix (Component, Element, Ref, State, createElement, fragment, hooksComponentWithModule, unsafeEventValue, useState') as R
29 30 31
import Reactix.DOM.HTML as H
import Unsafe.Coerce (unsafeCoerce)

32
import Gargantext.Prelude
33

34
import Gargantext.AsyncTasks as GAT
35
import Gargantext.Components.AutoUpdate (autoUpdateElt)
36
import Gargantext.Hooks.Loader (useLoader)
37 38
import Gargantext.Components.Table as T
import Gargantext.Components.Table.Types as T
39
import Gargantext.Components.NgramsTable.Components as NTC
40
import Gargantext.Components.NgramsTable.Core (Action(..), CoreAction(..), CoreState, Dispatch, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm, PageParams, PatchMap(..), Version, Versioned(..), VersionedNgramsTable, VersionedWithCountNgramsTable, _NgramsElement, _NgramsRepoElement, _NgramsTable, _children, _list, _ngrams, _ngrams_repo_elements, _ngrams_scores, _occurrences, _root, addNewNgramA, applyNgramsPatches, applyPatchSet, chartsAfterSync, commitPatch, convOrderBy, coreDispatch, filterTermSize, fromNgramsPatches, ngramsRepoElementToNgramsElement, ngramsTermText, normNgram, patchSetFromMap, replace, rootsOf, singletonNgramsTablePatch, syncResetButtons, toVersioned)
41
import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
42
import Gargantext.Components.Nodes.Lists.Types as NT
Alexandre Delanoë's avatar
Alexandre Delanoë committed
43
import Gargantext.Routes (SessionRoute(..)) as R
44
import Gargantext.Sessions (Session, get)
45
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
46
import Gargantext.Utils (queryMatchesLabel, toggleSet, sortWith)
47
import Gargantext.Utils.CacheAPI as GUC
48
import Gargantext.Utils.Reactix as R2
49
import Gargantext.Utils.Reload as GUR
50
import Gargantext.Utils.Seq as Seq
51

52
thisModule :: String
53 54
thisModule = "Gargantext.Components.NgramsTable"

55
_ngramsChildren :: forall row. Lens' { ngramsChildren :: Map NgramsTerm Boolean | row } (Map NgramsTerm Boolean)
56 57
_ngramsChildren = prop (SProxy :: SProxy "ngramsChildren")

58 59 60
_ngramsSelection :: forall row. Lens' { ngramsSelection :: Set NgramsTerm | row } (Set NgramsTerm)
_ngramsSelection = prop (SProxy :: SProxy "ngramsSelection")

61 62
type State =
  CoreState (
63
    ngramsChildren   :: Map NgramsTerm Boolean
64 65 66 67
                     -- ^ Used only when grouping.
                     --   This updates the children of `ngramsParent`,
                     --   ngrams set to `true` are to be added, and `false` to
                     --   be removed.
68
  , ngramsParent     :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
69 70 71 72 73 74
  , ngramsSelection  :: Set NgramsTerm
                     -- ^ The set of selected checkboxes of the first column.
  )

initialState :: VersionedNgramsTable -> State
initialState (Versioned {version}) = {
75 76 77 78
    ngramsChildren:   mempty
  , ngramsLocalPatch: mempty
  , ngramsParent:     Nothing
  , ngramsSelection:  mempty
79 80 81 82 83
  , ngramsStagePatch: mempty
  , ngramsValidPatch: mempty
  , ngramsVersion:    version
  }

84 85
setTermListSetA :: NgramsTable -> Set NgramsTerm -> TermList -> Action
setTermListSetA ngramsTable ns new_list =
86
  CoreAction $ CommitPatch $ fromNgramsPatches $ PatchMap $ mapWithIndex f $ toMap ns
87 88 89 90
  where
    f :: NgramsTerm -> Unit -> NgramsPatch
    f n unit = NgramsPatch { patch_list, patch_children: mempty }
      where
91
        cur_list = ngramsTable ^? at n <<< _Just <<< _NgramsRepoElement <<< _list
92
        patch_list = maybe mempty (\c -> replace c new_list) cur_list
93 94 95
    toMap :: forall a. Set a -> Map a Unit
    toMap = unsafeCoerce
    -- TODO https://github.com/purescript/purescript-ordered-collections/pull/21
96
    --      https://github.com/purescript/purescript-ordered-collections/pull/31
97 98
    -- toMap = Map.fromFoldable

99
type PreConversionRows = Seq.Seq NgramsElement
100

101
type TableContainerProps =
102 103 104 105 106 107 108
  ( dispatch         :: Dispatch
  , ngramsChildren   :: Map NgramsTerm Boolean
  , ngramsParent     :: Maybe NgramsTerm
  , ngramsSelection  :: Set NgramsTerm
  , ngramsTable      :: NgramsTable
  , path             :: R.State PageParams
  , tabNgramType     :: CTabNgramType
109
  , syncResetButton  :: Array R.Element
110
  )
111

112 113 114 115 116 117 118 119 120 121 122
tableContainer :: Record TableContainerProps -> Record T.TableContainerProps -> R.Element
tableContainer p q = R.createElement (tableContainerCpt p) q []

tableContainerCpt :: Record TableContainerProps -> R.Component T.TableContainerProps
tableContainerCpt { dispatch
                  , ngramsChildren
                  , ngramsParent
                  , ngramsSelection
                  , ngramsTable: ngramsTableCache
                  , path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
                  , tabNgramType
123
                  , syncResetButton
124
                  } = R.hooksComponentWithModule thisModule "tableContainer" cpt
125
  where
126
    cpt props _ = do
127 128 129 130 131 132 133 134 135 136 137 138 139 140
      pure $ H.div {className: "container-fluid"} [
        R2.row
        [ H.div {className: "card col-12"}
          [ H.div {className: "card-header"}
            [
              R2.row [ H.div {className: "col-md-2", style: {marginTop: "6px"}}
                       [ H.div {} syncResetButton
                       , if A.null props.tableBody && searchQuery /= "" then
                           H.li { className: "list-group-item" } [
                             H.button { className: "btn btn-primary"
                                      , on: { click: const $ dispatch
                                              $ CoreAction
                                              $ addNewNgramA
                                              (normNgram tabNgramType searchQuery)
141
                                              MapTerm
142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171
                                            }
                                      }
                             [ H.text ("Add " <> searchQuery) ]
                             ] else H.div {} []
                       ]
                     , H.div {className: "col-md-2", style: {marginTop : "6px"}}
                       [ H.li {className: "list-group-item"}
                         [ R2.select { id: "picklistmenu"
                                     , className: "form-control custom-select"
                                     , defaultValue: (maybe "" show termListFilter)
                                     , on: {change: setTermListFilter <<< read <<< R.unsafeEventValue}}
                           (map optps1 termLists)]
                       ]
                     , H.div {className: "col-md-2", style: {marginTop : "6px"}}
                       [ H.li {className: "list-group-item"}
                         [ R2.select {id: "picktermtype"
                                     , className: "form-control custom-select"
                                     , defaultValue: (maybe "" show termSizeFilter)
                                     , on: {change: setTermSizeFilter <<< read <<< R.unsafeEventValue}}
                           (map optps1 termSizes)]
                       ]
                     , H.div { className: "col-md-2", style: { marginTop: "6px" } }
                       [ H.li {className: "list-group-item"}
                         [ H.div { className: "form-inline" }
                           [ H.div { className: "form-group" }
                             [ props.pageSizeControl
                             , H.label {} [ H.text " items" ]
                               --   H.div { className: "col-md-6" } [ props.pageSizeControl ]
                               -- , H.div { className: "col-md-6" } [
                               --    ]
172 173
                             ]
                           ]
174 175 176 177 178 179 180 181 182 183 184 185 186 187 188
                         ]
                       ]
                     , H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}}
                       [ H.li {className: "list-group-item"}
                         [ props.pageSizeDescription
                         , props.paginationLinks
                         ]
                       ]
                     ]
            ]
          , editor
          , if (selectionsExist ngramsSelection)
            then H.li {className: "list-group-item"}
                 [selectButtons true]
            else H.div {} []
189
          , H.div {id: "terms_table", className: "card-body"}
190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205
            [ H.table {className: "table able"}
              [ H.thead {className: ""} [props.tableHead]
              , H.tbody {} props.tableBody
              ]
            , H.li {className: "list-group-item"}
              [ H.div { className: "row" }
                [ H.div { className: "col-md-4" }
                  [selectButtons (selectionsExist ngramsSelection)]
                , H.div {className: "col-md-4 col-md-offset-4"}
                  [props.paginationLinks]
                ]
              ]
            ]
          ]
        ]
      ]
206 207 208
    -- WHY setPath     f = origSetPageParams (const $ f path)
    setTermListFilter x = setPath $ _ { termListFilter = x }
    setTermSizeFilter x = setPath $ _ { termSizeFilter = x }
209
    setSelection = dispatch <<< setTermListSetA ngramsTableCache ngramsSelection
210

211 212
    editor = H.div {} $ maybe [] f ngramsParent
      where
213 214 215 216 217 218 219 220 221 222
        f ngrams = [ H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
                   , NTC.renderNgramsTree { ngramsTable
                                          , ngrams
                                          , ngramsStyle: []
                                          , ngramsClick
                                          , ngramsEdit
                                          }
                   , H.button { className: "btn btn-primary"
                              , on: {click: (const $ dispatch AddTermChildren)}
                              } [H.text "Save"]
223
                   , H.button { className: "btn btn-primary"
224 225 226
                              , on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}
                              } [H.text "Cancel"]
                   ]
227 228 229
          where
            ngramsTable = ngramsTableCache # at ngrams
                          <<< _Just
230
                          <<< _NgramsRepoElement
231 232
                          <<< _children
                          %~ applyPatchSet (patchSetFromMap ngramsChildren)
233
            ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
234 235 236
            ngramsClick _ = Nothing
            ngramsEdit  _ = Nothing

237 238 239 240 241
    selectionsExist :: Set NgramsTerm -> Boolean
    selectionsExist = not <<< Set.isEmpty

    selectButtons false = H.div {} []
    selectButtons true =
242
      H.div {} [
243
        H.button { className: "btn btn-primary"
244
                , on: { click: const $ setSelection MapTerm }
245
                } [ H.text "Map" ]
246
        , H.button { className: "btn btn-primary"
247
                  , on: { click: const $ setSelection StopTerm }
248
                  } [ H.text "Stop" ]
249
        , H.button { className: "btn btn-primary"
250
                  , on: { click: const $ setSelection CandidateTerm }
251
                  } [ H.text "Candidate" ]
252 253
      ]

254
-- NEXT
255 256 257

type CommonProps = (
    afterSync         :: Unit -> Aff Unit
258
  , appReload         :: GUR.ReloadS
259 260 261
  , asyncTasksRef     :: R.Ref (Maybe GAT.Reductor)
  , sidePanelTriggers :: Record NT.SidePanelTriggers
  , tabNgramType      :: CTabNgramType
262
  , treeReloadRef     :: GUR.ReloadWithInitializeRef
263 264 265
  , withAutoUpdate    :: Boolean
  )

266
type Props = (
267 268
    cacheState        :: NT.CacheState
  , mTotalRows        :: Maybe Int
269
  , path              :: R.State PageParams
270 271 272
  , state             :: R.State State
  , versioned         :: VersionedNgramsTable
  | CommonProps
273 274
  )

275 276
loadedNgramsTable :: R2.Component Props
loadedNgramsTable = R.createElement loadedNgramsTableCpt
277 278
loadedNgramsTableCpt :: R.Component Props
loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable" cpt
279
  where
280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295
    cpt props@{ afterSync
              , appReload
              , asyncTasksRef
              , cacheState
              , mTotalRows
              , path: path@(path'@{ listIds, nodeId, params, searchQuery, scoreType, termListFilter, termSizeFilter } /\ setPath)
              , sidePanelTriggers
              , state: (state@{ ngramsChildren
                              , ngramsLocalPatch
                              , ngramsParent
                              , ngramsSelection
                              , ngramsVersion } /\ setState)
              , tabNgramType
              , treeReloadRef
              , versioned: Versioned { data: initTable }
              , withAutoUpdate } _ = do
296

297
      pure $ R.fragment $
298
        autoUpdate <> [
299
          H.h4 {style: {textAlign : "center"}}
300
               [ H.span {className: "fa fa-hand-o-down"} []
301 302
               , H.text "Extracted Terms"
               ]
303
        , search ]
304
        <>
305
        [ T.table { colNames
306 307 308 309 310 311
                  , container: tableContainer { dispatch: performAction
                                              , ngramsChildren
                                              , ngramsParent
                                              , ngramsSelection
                                              , ngramsTable
                                              , path
312
                                              , syncResetButton: [ syncResetButton ]
313
                                              , tabNgramType
314
                                              }
315
                  , params: paramsS -- TODO-LENS
316
                  , rows: filteredConvertedRows
317
                  , syncResetButton: [ syncResetButton ]
318
                  , totalRecords
319 320 321 322
                  , wrapColElts: wrapColElts { allNgramsSelected
                                             , dispatch: performAction
                                             , ngramsSelection
                                             }
323
                  }
324
        , syncResetButton ]
325

326
      where
327 328 329 330 331
        afterSync' _ = do
          chartsAfterSync path' asyncTasksRef nodeId treeReloadRef unit
          afterSync unit

        performAction = mkDispatch { filteredRows, path: path', state: state /\ setState }
332

333
        syncResetButton = syncResetButtons { afterSync: afterSync'
334 335
                                           , ngramsLocalPatch
                                           , performAction: performAction <<< CoreAction }
336

337
        autoUpdate :: Array R.Element
338
        autoUpdate = if withAutoUpdate then
339 340 341 342 343
                       [ R2.buff
                       $ autoUpdateElt
                         { duration: 5000
                         , effect: performAction
                         $ CoreAction
344
                         $ Synchronize { afterSync: afterSync' }
345 346
                         }
                       ]
347
                     else []
348

349
        totalRecords = fromMaybe (Seq.length rows) mTotalRows
350 351 352
        filteredConvertedRows :: T.Rows
        filteredConvertedRows = convertRow <$> filteredRows
        filteredRows :: PreConversionRows
353 354
        -- no need to filter offset if cache is off
        filteredRows = if cacheState == NT.CacheOn then T.filterRows { params } rows else rows
Nicolas Pouillard's avatar
Nicolas Pouillard committed
355 356
        ng_scores :: Map NgramsTerm (Additive Int)
        ng_scores = ngramsTable ^. _NgramsTable <<< _ngrams_scores
357
        rows :: PreConversionRows
358
        rows = orderWith (
359 360 361
                 Seq.mapMaybe (\(Tuple ng nre) ->
                                let Additive s = ng_scores ^. at ng <<< _Just in
                                addOcc <$> rowsFilter (ngramsRepoElementToNgramsElement ng s nre)) $
Nicolas Pouillard's avatar
Nicolas Pouillard committed
362
                   Map.toUnfoldable (ngramsTable ^. _NgramsTable <<< _ngrams_repo_elements)
363 364 365 366 367 368 369 370
               )
        rowsFilter :: NgramsElement -> Maybe NgramsElement
        rowsFilter ne =
           if displayRow state searchQuery ngramsTable ngramsParentRoot termListFilter termSizeFilter ne then
             Just ne
           else
             Nothing
        addOcc ngramsElement =
Nicolas Pouillard's avatar
Nicolas Pouillard committed
371
          let Additive occurrences = sumOccurrences ngramsTable (ngramsElementToNgramsOcc ngramsElement) in
372
          ngramsElement # _NgramsElement <<< _occurrences .~ occurrences
373

374 375
        allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows

376
        ngramsTable = applyNgramsPatches state initTable
377
        roots = rootsOf ngramsTable
378 379 380 381
        ngramsParentRoot :: Maybe NgramsTerm
        ngramsParentRoot =
          (\np -> ngramsTable ^? at np
                            <<< _Just
382
                            <<< _NgramsRepoElement
383 384 385
                            <<< _root
                            <<< _Just
            ) =<< ngramsParent
386

387
        convertRow ngramsElement =
388
          { row: NTC.renderNgramsItem { dispatch: performAction
389
                                      , ngrams: ngramsElement ^. _NgramsElement <<< _ngrams
390 391 392 393
                                      , ngramsElement
                                      , ngramsLocalPatch
                                      , ngramsParent
                                      , ngramsSelection
394 395
                                      , ngramsTable
                                      , sidePanelTriggers } []
396 397
          , delete: false
          }
398 399
        orderWith =
          case convOrderBy <$> params.orderBy of
400 401 402 403
            Just ScoreAsc  -> sortWith \x -> x        ^. _NgramsElement <<< _occurrences
            Just ScoreDesc -> sortWith \x -> Down $ x ^. _NgramsElement <<< _occurrences
            Just TermAsc   -> sortWith \x -> x        ^. _NgramsElement <<< _ngrams
            Just TermDesc  -> sortWith \x -> Down $ x ^. _NgramsElement <<< _ngrams
404 405
            _              -> identity -- the server ordering is enough here

406
        colNames = T.ColumnName <$> ["Show", "Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy
407
        -- This is used to *decorate* the Select header with the checkbox.
408
        wrapColElts scProps (T.ColumnName "Select") = const [NTC.selectionCheckbox scProps]
409 410
        wrapColElts _       (T.ColumnName "Score")  = (_ <> [H.text ("(" <> show scoreType <> ")")])
        wrapColElts _       _                       = identity
411
        setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
412
        paramsS = params /\ setParams
413

414
        search :: R.Element
415 416 417
        search = NTC.searchInput { key: "search-input"
                                 , onSearch: setSearchQuery
                                 , searchQuery: searchQuery }
418
        setSearchQuery :: String -> Effect Unit
419 420 421
        setSearchQuery x    = do
          setPath $ _ { searchQuery    = x }
          T.changePage 1 paramsS
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 460 461 462 463 464 465 466 467 468 469 470 471 472
type MkDispatchProps = (
    filteredRows :: PreConversionRows
  , path         :: PageParams
  , state :: R.State State
  )

mkDispatch :: Record MkDispatchProps -> (Action -> Effect Unit)
mkDispatch { filteredRows
           , path
           , state: (state@{ ngramsChildren
                           , ngramsLocalPatch
                           , ngramsParent
                           , ngramsSelection
                           , ngramsVersion } /\ setState) } = performAction
  where
    allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows

    setParentResetChildren :: Maybe NgramsTerm -> State -> State
    setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = mempty }

    performAction :: Action -> Effect Unit
    performAction (SetParentResetChildren p) =
      setState $ setParentResetChildren p
    performAction (ToggleChild b c) =
      setState $ \s@{ ngramsChildren: nc } -> s { ngramsChildren = newNC nc }
      where
        newNC nc = Map.alter (maybe (Just b) (const Nothing)) c nc
    performAction (ToggleSelect c) =
      setState $ \s@{ ngramsSelection: ns } -> s { ngramsSelection = toggleSet c ns }
    performAction ToggleSelectAll =
      setState toggler
      where
        toggler s =
          if allNgramsSelected then
            s { ngramsSelection = Set.empty :: Set NgramsTerm }
          else
            s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
    performAction AddTermChildren =
      case ngramsParent of
        Nothing ->
          -- impossible but harmless
          pure unit
        Just parent -> do
          let pc = patchSetFromMap ngramsChildren
              pe = NgramsPatch { patch_list: mempty, patch_children: pc }
              pt = singletonNgramsTablePatch parent pe
          setState $ setParentResetChildren Nothing
          commitPatch (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
    performAction (CoreAction a) = coreDispatch path (state /\ setState) a

473

474
displayRow :: State -> SearchQuery -> NgramsTable -> Maybe NgramsTerm -> Maybe TermList -> Maybe TermSize -> NgramsElement -> Boolean
475 476 477 478
displayRow state@{ ngramsChildren
                 , ngramsLocalPatch
                 , ngramsParent }
           searchQuery
479
           ngramsTable
480
           ngramsParentRoot
481
           termListFilter
482
           termSizeFilter
483
           (NgramsElement {ngrams, root, list}) =
484 485 486 487 488 489 490 491 492 493 494
  (
      isNothing root
    -- ^ Display only nodes without parents
    && maybe true (_ == list) termListFilter
    -- ^ and which matches the ListType filter.
    && ngramsChildren ^. at ngrams /= Just true
    -- ^ and which are not scheduled to be added already
    && Just ngrams /= ngramsParent
    -- ^ and which are not our new parent
    && Just ngrams /= ngramsParentRoot
    -- ^ and which are not the root of our new parent
495 496
    && filterTermSize termSizeFilter ngrams
    -- ^ and which satisfies the chosen term size
497 498 499 500 501 502 503
    || ngramsChildren ^. at ngrams == Just false
    -- ^ unless they are scheduled to be removed.
    || NTC.tablePatchHasNgrams ngramsLocalPatch ngrams
    -- ^ unless they are being processed at the moment.
  )
    && queryMatchesLabel searchQuery (ngramsTermText ngrams)
    -- ^ and which matches the search query.
504

505

506 507 508 509
allNgramsSelectedOnFirstPage :: Set NgramsTerm -> PreConversionRows -> Boolean
allNgramsSelectedOnFirstPage selected rows = selected == (selectNgramsOnFirstPage rows)

selectNgramsOnFirstPage :: PreConversionRows -> Set NgramsTerm
510
selectNgramsOnFirstPage rows = Set.fromFoldable $ (view $ _NgramsElement <<< _ngrams) <$> rows
511 512


513
type MainNgramsTableProps = (
514 515
    cacheState        :: R.State NT.CacheState
  , defaultListId     :: Int
516
    -- ^ This node can be a corpus or contact.
517
  , path              :: PageParams
518
  | CommonProps
519
  )
520

521 522
mainNgramsTable :: R2.Component MainNgramsTableProps
mainNgramsTable = R.createElement mainNgramsTableCpt
523 524
mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
525
  where
526
    cpt props@{ afterSync
527
              , appReload
528
              , asyncTasksRef
529 530
              , cacheState
              , defaultListId
531
              , path
532
              , sidePanelTriggers
533
              , tabNgramType
534
              , treeReloadRef
535
              , withAutoUpdate } _ = do
536 537

      -- let path = initialPageParams session nodeId [defaultListId] tabType
538 539

      case cacheState of
540
        (NT.CacheOn /\ _) -> do
541 542 543
          let render versioned = mainNgramsTablePaint { afterSync
                                                      , appReload
                                                      , asyncTasksRef
544
                                                      , cacheState: fst cacheState
545
                                                      , path
546
                                                      , sidePanelTriggers
547 548 549
                                                      , tabNgramType
                                                      , treeReloadRef
                                                      , versioned
550
                                                      , withAutoUpdate } []
551 552 553 554
          useLoaderWithCacheAPI {
              cacheEndpoint: versionEndpoint props
            , handleResponse
            , mkRequest
555
            , path
556 557
            , renderer: render
            }
558
        (NT.CacheOff /\ _) -> do
559
          pathS <- R.useState' path
560 561 562
          let render versionedWithCount = mainNgramsTablePaintNoCache { afterSync
                                                                      , appReload
                                                                      , asyncTasksRef
563
                                                                      , cacheState: fst cacheState
564 565 566 567 568 569
                                                                      , pathS
                                                                      , sidePanelTriggers
                                                                      , tabNgramType
                                                                      , treeReloadRef
                                                                      , versionedWithCount
                                                                      , withAutoUpdate } []
570
          useLoader (fst pathS) loader render
571

572
    -- NOTE With cache on
573
    versionEndpoint :: Record MainNgramsTableProps -> PageParams -> Aff Version
574
    versionEndpoint { defaultListId, path: { nodeId, tabType, session } } _ = get session $ R.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId)
575

576
    -- NOTE With cache off
577
    loader :: PageParams -> Aff VersionedWithCountNgramsTable
578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599
    loader path@{ listIds
                , nodeId
                , params: { limit, offset, orderBy }
                , searchQuery
                , session
                , tabType
                , termListFilter
                , termSizeFilter
                } =
      get session $ R.GetNgrams params (Just nodeId)
      where
        params = { limit
                 , listIds
                 , offset: Just offset
                 , orderBy: Nothing  -- TODO
                 , searchQuery
                 , tabType
                 , termListFilter
                 , termSizeFilter
                 }

    -- NOTE With cache on
600 601 602 603 604 605 606 607 608 609 610
    mkRequest :: PageParams -> GUC.Request
    mkRequest path@{ session } = GUC.makeGetRequest session $ url path
      where
        url { listIds
            , nodeId
            , params: { limit, offset, orderBy }
            , searchQuery
            , scoreType
            , tabType
            , termListFilter
            , termSizeFilter
611 612
            } = R.GetNgramsTableAll { listIds
                                    , tabType } (Just nodeId)
613 614 615 616

    handleResponse :: VersionedNgramsTable -> VersionedNgramsTable
    handleResponse v = v

617
type MainNgramsTablePaintProps = (
618 619
    cacheState         :: NT.CacheState
  , path              :: PageParams
620 621
  , versioned         :: VersionedNgramsTable
  | CommonProps
622 623
  )

624 625
mainNgramsTablePaint :: R2.Component MainNgramsTablePaintProps
mainNgramsTablePaint = R.createElement mainNgramsTablePaintCpt
626

627 628 629
mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
mainNgramsTablePaintCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaint" cpt
  where
630 631 632
    cpt props@{ afterSync
              , appReload
              , asyncTasksRef
633
              , cacheState
634 635 636 637 638 639
              , path
              , sidePanelTriggers
              , tabNgramType
              , treeReloadRef
              , versioned
              , withAutoUpdate } _ = do
640
      pathS <- R.useState' path
641
      state <- R.useState' $ initialState versioned
642 643 644
      pure $ loadedNgramsTable { afterSync
                               , appReload
                               , asyncTasksRef
645
                               , cacheState
646
                               , mTotalRows: Nothing
647 648 649 650 651 652 653
                               , path: pathS
                               , sidePanelTriggers
                               , state
                               , tabNgramType
                               , treeReloadRef
                               , versioned
                               , withAutoUpdate
654
                               } []
655

656 657 658
type MainNgramsTablePaintNoCacheProps = (
    cacheState         :: NT.CacheState
  , pathS              :: R.State PageParams
659
  , versionedWithCount :: VersionedWithCountNgramsTable
660
  | CommonProps
661 662
  )

663 664 665
mainNgramsTablePaintNoCache :: R2.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCache = R.createElement mainNgramsTablePaintNoCacheCpt

666 667 668
mainNgramsTablePaintNoCacheCpt :: R.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCacheCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaintNoCache" cpt
  where
669 670 671
    cpt props@{ afterSync
              , appReload
              , asyncTasksRef
672
              , cacheState
673 674 675 676
              , pathS
              , sidePanelTriggers
              , tabNgramType
              , treeReloadRef
677
              , versionedWithCount
678
              , withAutoUpdate } _ = do
679 680
      let count /\ versioned = toVersioned versionedWithCount

681 682 683 684 685 686
      state <- R.useState' $ initialState versioned

      pure $ loadedNgramsTable {
        afterSync
      , appReload
      , asyncTasksRef
687
      , cacheState
688
      , mTotalRows: Just count
689
      , path: pathS
690
      , sidePanelTriggers
691 692 693
      , state
      , tabNgramType
      , treeReloadRef
694 695
      , versioned
      , withAutoUpdate
696
      } []
697

Nicolas Pouillard's avatar
Nicolas Pouillard committed
698 699 700 701 702 703
type NgramsOcc = { occurrences :: Additive Int, children :: Set NgramsTerm }

ngramsElementToNgramsOcc :: NgramsElement -> NgramsOcc
ngramsElementToNgramsOcc (NgramsElement {occurrences, children}) = {occurrences: Additive occurrences, children}

sumOccurrences :: NgramsTable -> NgramsOcc -> Additive Int
704
sumOccurrences nt = sumOccChildren mempty
705
    where
706 707 708 709 710 711 712 713 714 715 716
      sumOccTerm :: Set NgramsTerm -> NgramsTerm -> Additive Int
      sumOccTerm seen label
        | Set.member label seen = Additive 0 -- TODO: Should not happen, emit a warning/error.
        | otherwise =
            sumOccChildren (Set.insert label seen)
                           { occurrences: nt ^. _NgramsTable <<< _ngrams_scores <<< ix label
                           , children:    nt ^. ix label <<< _NgramsRepoElement <<< _children
                           }
      sumOccChildren :: Set NgramsTerm -> NgramsOcc -> Additive Int
      sumOccChildren seen {occurrences, children} =
        occurrences <> children ^. folded <<< to (sumOccTerm seen)
717

718
optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> R.Element
719
optps1 { desc, mval } = H.option { value: value } [H.text desc]
720
  where value = maybe "" show mval
721 722 723