NgramsTable.purs 29.6 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 as R
29
import Reactix.DOM.HTML as H
James Laver's avatar
James Laver committed
30 31
import Toestand as T

32 33
import Unsafe.Coerce (unsafeCoerce)

34
import Gargantext.Prelude
35

36
import Gargantext.AsyncTasks as GAT
37
import Gargantext.Components.AutoUpdate (autoUpdateElt)
38
import Gargantext.Hooks.Loader (useLoader)
39 40
import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT
41
import Gargantext.Components.NgramsTable.Components as NTC
42
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)
43
import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
44
import Gargantext.Components.Nodes.Lists.Types as NT
Alexandre Delanoë's avatar
Alexandre Delanoë committed
45
import Gargantext.Routes (SessionRoute(..)) as R
46
import Gargantext.Sessions (Session, get)
47
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
48
import Gargantext.Utils (queryMatchesLabel, toggleSet, sortWith)
49
import Gargantext.Utils.CacheAPI as GUC
50
import Gargantext.Utils.Reactix as R2
51
import Gargantext.Utils.Seq as Seq
James Laver's avatar
James Laver committed
52
import Gargantext.Utils.Toestand as T2
53

James Laver's avatar
James Laver committed
54 55
here :: R2.Here
here = R2.here "Gargantext.Components.NgramsTable"
56

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

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

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

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

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

101
type PreConversionRows = Seq.Seq NgramsElement
102

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

114
tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps -> R.Element
115 116
tableContainer p q = R.createElement (tableContainerCpt p) q []

117
tableContainerCpt :: Record TableContainerProps -> R.Component TT.TableContainerProps
118 119 120 121 122
tableContainerCpt { dispatch
                  , ngramsChildren
                  , ngramsParent
                  , ngramsSelection
                  , ngramsTable: ngramsTableCache
123
                  , path
124
                  , tabNgramType
125
                  , syncResetButton
James Laver's avatar
James Laver committed
126
                  } = here.component "tableContainer" cpt
127
  where
128
    cpt props _ = do
129 130
      { searchQuery, termListFilter, termSizeFilter } <- T.useLive T.unequal path

131 132 133 134 135 136 137 138 139 140 141 142 143 144
      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)
145
                                              MapTerm
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 172 173 174 175
                                            }
                                      }
                             [ 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" } [
                               --    ]
176 177
                             ]
                           ]
178 179 180 181 182 183 184 185 186 187 188 189 190 191 192
                         ]
                       ]
                     , 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 {} []
193
          , H.div {id: "terms_table", className: "card-body"}
194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209
            [ 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]
                ]
              ]
            ]
          ]
        ]
      ]
210
    -- WHY setPath     f = origSetPageParams (const $ f path)
211 212
    setTermListFilter x = T.modify (_ { termListFilter = x }) path
    setTermSizeFilter x = T.modify (_ { termSizeFilter = x }) path
213
    setSelection = dispatch <<< setTermListSetA ngramsTableCache ngramsSelection
214

215 216
    editor = H.div {} $ maybe [] f ngramsParent
      where
217 218 219 220 221 222 223 224 225 226
        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"]
227
                   , H.button { className: "btn btn-primary"
228 229 230
                              , on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}
                              } [H.text "Cancel"]
                   ]
231 232 233
          where
            ngramsTable = ngramsTableCache # at ngrams
                          <<< _Just
234
                          <<< _NgramsRepoElement
235 236
                          <<< _children
                          %~ applyPatchSet (patchSetFromMap ngramsChildren)
237
            ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
238 239 240
            ngramsClick _ = Nothing
            ngramsEdit  _ = Nothing

241 242 243 244 245
    selectionsExist :: Set NgramsTerm -> Boolean
    selectionsExist = not <<< Set.isEmpty

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

258
-- NEXT
259

260 261
type CommonProps = (
    afterSync         :: Unit -> Aff Unit
262 263
  , reloadForest      :: T2.ReloadS
  , reloadRoot        :: T2.ReloadS
264
  , tabNgramType      :: CTabNgramType
265
  , tasks             :: T.Box GAT.Storage
266 267 268
  , withAutoUpdate    :: Boolean
  )

James Laver's avatar
James Laver committed
269 270 271
type Props =
  ( cacheState :: NT.CacheState
  , mTotalRows :: Maybe Int
272
  , path       :: T.Box PageParams
273
  , state      :: T.Box State
James Laver's avatar
James Laver committed
274
  , versioned  :: VersionedNgramsTable
275
  | CommonProps
276 277
  )

278 279
loadedNgramsTable :: R2.Component Props
loadedNgramsTable = R.createElement loadedNgramsTableCpt
280

James Laver's avatar
James Laver committed
281 282 283 284 285
loadedNgramsTableCpt :: R.Component Props
loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where
  cpt props@{ afterSync
            , cacheState
            , mTotalRows
286
            , path
287 288
            , reloadForest
            , reloadRoot
289
            , state
James Laver's avatar
James Laver committed
290
            , tabNgramType
291
            , tasks
James Laver's avatar
James Laver committed
292 293
            , versioned: Versioned { data: initTable }
            , withAutoUpdate } _ = do
294
    state'@{ ngramsChildren, ngramsLocalPatch, ngramsParent, ngramsSelection, ngramsVersion } <- T.useLive T.unequal state
295 296 297 298 299 300
    path'@{ listIds, params, scoreType, termListFilter, termSizeFilter } <- T.useLive T.unequal path
    params <- T.useFocused (_.params) (\a b -> b { params = a }) path
    params'@{ orderBy } <- T.useLive T.unequal params
    searchQuery <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path
    searchQuery' <- T.useLive T.unequal searchQuery

301 302 303 304 305 306 307 308 309 310 311 312 313 314 315
    let ngramsTable = applyNgramsPatches state' initTable
        roots = rootsOf ngramsTable

        rowMap (Tuple ng nre) =
          let ng_scores :: Map NgramsTerm (Additive Int)
              ng_scores = ngramsTable ^. _NgramsTable <<< _ngrams_scores
              Additive s = ng_scores ^. at ng <<< _Just
              addOcc ne =
                let Additive occurrences = sumOccurrences ngramsTable (ngramsElementToNgramsOcc ne) in
                ne # _NgramsElement <<< _occurrences .~ occurrences
          in
          addOcc <$> rowsFilter (ngramsRepoElementToNgramsElement ng s nre)
        rows :: PreConversionRows
        rows = ngramsTableOrderWith orderBy (
                 Seq.mapMaybe rowMap $
316 317 318
                   Map.toUnfoldable (ngramsTable ^. _NgramsTable <<< _ngrams_repo_elements)
               )
        rowsFilter :: NgramsElement -> Maybe NgramsElement
319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334
        rowsFilter ngramsElement =
          if displayRow { ngramsElement
                        , ngramsParentRoot
                        , ngramsTable
                        , searchQuery: searchQuery'
                        , state: state'
                        , termListFilter
                        , termSizeFilter } then
            Just ngramsElement
          else
            Nothing

        performAction = mkDispatch { filteredRows
                                   , path: path'
                                   , state
                                   , state' }
335

336 337 338 339 340 341 342 343 344 345 346 347 348
        -- filteredRows :: PreConversionRows
        -- no need to filter offset if cache is off
        filteredRows = if cacheState == NT.CacheOn then TT.filterRows { params: params' } rows else rows
        filteredConvertedRows :: TT.Rows
        filteredConvertedRows = convertRow <$> filteredRows

        convertRow ngramsElement =
          { row: NTC.renderNgramsItem { dispatch: performAction
                                      , ngrams: ngramsElement ^. _NgramsElement <<< _ngrams
                                      , ngramsElement
                                      , ngramsLocalPatch
                                      , ngramsParent
                                      , ngramsSelection
349
                                      , ngramsTable } []
350 351 352 353 354
          , delete: false
          }

        allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows

355 356
        totalRecords = fromMaybe (Seq.length rows) mTotalRows

357
        afterSync' _ = do
358
          chartsAfterSync path' tasks unit
359
          afterSync unit
360

361 362 363
        syncResetButton = syncResetButtons { afterSync: afterSync'
                                           , ngramsLocalPatch
                                           , performAction: performAction <<< CoreAction }
364 365 366 367 368 369

        -- autoUpdate :: Array R.Element
        autoUpdate path' = if withAutoUpdate then
                       [ R2.buff
                       $ autoUpdateElt
                         { duration: 5000
370
                         , effect: performAction $ CoreAction $ Synchronize { afterSync: afterSync' }
371 372 373 374
                         }
                       ]
                     else []

375 376 377 378 379 380 381 382
        ngramsParentRoot :: Maybe NgramsTerm
        ngramsParentRoot =
          (\np -> ngramsTable ^? at np
                            <<< _Just
                            <<< _NgramsRepoElement
                            <<< _root
                            <<< _Just
            ) =<< ngramsParent
383

James Laver's avatar
James Laver committed
384
    pure $ R.fragment $
385
      autoUpdate path' <>
James Laver's avatar
James Laver committed
386 387 388
      [ H.h4 {style: {textAlign : "center"}}
        [ H.span {className: "fa fa-hand-o-down"} []
        , H.text "Extracted Terms" ]
389 390 391
      , NTC.searchInput { key: "search-input"
                        , searchQuery }
      , TT.table
392 393 394 395 396 397 398 399
          { colNames
          , container: tableContainer
              { dispatch: performAction
              , ngramsChildren
              , ngramsParent
              , ngramsSelection
              , ngramsTable
              , path
400
              , syncResetButton: [ syncResetButton ]
401 402 403
              , tabNgramType }
          , params
          , rows: filteredConvertedRows
404
          , syncResetButton: [ syncResetButton ]
405 406
          , totalRecords
          , wrapColElts:
407
            wrapColElts { allNgramsSelected, dispatch: performAction, ngramsSelection } scoreType
408
          }
409
      , syncResetButton
James Laver's avatar
James Laver committed
410
      ]
411
      where
412
        colNames = TT.ColumnName <$> ["Show", "Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy
413

414 415 416 417 418 419 420
ngramsTableOrderWith orderBy =
  case convOrderBy <$> orderBy of
    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
    _              -> identity -- the server ordering is enough here
421

422 423 424 425
-- This is used to *decorate* the Select header with the checkbox.
wrapColElts scProps _         (TT.ColumnName "Select") = const [NTC.selectionCheckbox scProps]
wrapColElts _       scoreType (TT.ColumnName "Score")  = (_ <> [H.text ("(" <> show scoreType <> ")")])
wrapColElts _       _         _                        = identity
426

427 428 429
type MkDispatchProps = (
    filteredRows :: PreConversionRows
  , path         :: PageParams
430 431
  , state        :: T.Box State
  , state'       :: State
432 433 434 435 436
  )

mkDispatch :: Record MkDispatchProps -> (Action -> Effect Unit)
mkDispatch { filteredRows
           , path
437 438 439 440 441 442
           , state
           , state': state'@{ ngramsChildren
                            , ngramsLocalPatch
                            , ngramsParent
                            , ngramsSelection
                            , ngramsVersion } } = performAction
443 444 445 446 447 448 449 450
  where
    allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows

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

    performAction :: Action -> Effect Unit
    performAction (SetParentResetChildren p) =
451
      T.modify_ (setParentResetChildren p) state
452
    performAction (ToggleChild b c) =
453
      T.modify_ (\s@{ ngramsChildren: nc } -> s { ngramsChildren = newNC nc }) state
454 455 456
      where
        newNC nc = Map.alter (maybe (Just b) (const Nothing)) c nc
    performAction (ToggleSelect c) =
457
      T.modify_ (\s@{ ngramsSelection: ns } -> s { ngramsSelection = toggleSet c ns }) state
458
    performAction ToggleSelectAll =
459
      T.modify_ toggler state
460 461 462 463 464 465 466 467 468 469 470 471 472 473 474
      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
475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495
          T.modify_ (setParentResetChildren Nothing) state
          commitPatch pt state
    performAction (CoreAction a) = coreDispatch path state a


displayRow :: { ngramsElement    :: NgramsElement
              , ngramsParentRoot :: Maybe NgramsTerm
              , ngramsTable      :: NgramsTable
              , searchQuery      :: SearchQuery
              , state            :: State
              , termListFilter   :: Maybe TermList
              , termSizeFilter   :: Maybe TermSize } -> Boolean
displayRow { ngramsElement: NgramsElement {ngrams, root, list}
           , ngramsParentRoot
           , ngramsTable
           , state: state@{ ngramsChildren
                          , ngramsLocalPatch
                          , ngramsParent }
           , searchQuery
           , termListFilter
           , termSizeFilter } =
496 497 498 499 500 501 502 503 504 505 506
  (
      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
507 508
    && filterTermSize termSizeFilter ngrams
    -- ^ and which satisfies the chosen term size
509 510 511 512 513 514 515
    || 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.
516

517

518 519 520 521
allNgramsSelectedOnFirstPage :: Set NgramsTerm -> PreConversionRows -> Boolean
allNgramsSelectedOnFirstPage selected rows = selected == (selectNgramsOnFirstPage rows)

selectNgramsOnFirstPage :: PreConversionRows -> Set NgramsTerm
522
selectNgramsOnFirstPage rows = Set.fromFoldable $ (view $ _NgramsElement <<< _ngrams) <$> rows
523 524


525
type MainNgramsTableProps = (
526
    cacheState        :: T.Box NT.CacheState
527
  , defaultListId     :: Int
528
    -- ^ This node can be a corpus or contact.
529
  , path              :: T.Box PageParams
530 531 532
  , session           :: Session
  , tabType           :: TabType
  | CommonProps
533
  )
534

535 536
mainNgramsTable :: R2.Component MainNgramsTableProps
mainNgramsTable = R.createElement mainNgramsTableCpt
James Laver's avatar
James Laver committed
537

538
mainNgramsTableCpt :: R.Component MainNgramsTableProps
James Laver's avatar
James Laver committed
539
mainNgramsTableCpt = here.component "mainNgramsTable" cpt
540
  where
541 542 543
    cpt props@{ afterSync
              , cacheState
              , defaultListId
James Laver's avatar
James Laver committed
544
              , path
545 546
              , reloadForest
              , reloadRoot
547
              , tabNgramType
548
              , tasks
549
              , withAutoUpdate } _ = do
550
      cacheState' <- T.useLive T.unequal cacheState
551
      path'@{ nodeId, tabType, session } <- T.useLive T.unequal path
552 553

      -- let path = initialPageParams session nodeId [defaultListId] tabType
554

555 556
      case cacheState' of
        NT.CacheOn -> do
557
          let render versioned = mainNgramsTablePaint { afterSync
558
                                                      , cacheState: cacheState'
559
                                                      , path
560 561
                                                      , reloadForest
                                                      , reloadRoot
562
                                                      , tabNgramType
563
                                                      , tasks
564
                                                      , versioned
565
                                                      , withAutoUpdate } []
566
          useLoaderWithCacheAPI {
567
              cacheEndpoint: versionEndpoint { defaultListId, path: path' }
568 569
            , handleResponse
            , mkRequest
570
            , path: path'
571 572
            , renderer: render
            }
573
        NT.CacheOff -> do
James Laver's avatar
James Laver committed
574
          -- path <- R.useState' path
575
          let render versionedWithCount = mainNgramsTablePaintNoCache { afterSync
576
                                                                      , cacheState: cacheState'
James Laver's avatar
James Laver committed
577
                                                                      , path
578 579
                                                                      , reloadForest
                                                                      , reloadRoot
580
                                                                      , tabNgramType
581
                                                                      , tasks
582 583
                                                                      , versionedWithCount
                                                                      , withAutoUpdate } []
584
          useLoader path' loader render
585

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

590
    -- NOTE With cache off
591
    loader :: PageParams -> Aff VersionedWithCountNgramsTable
592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613
    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
614 615 616 617 618 619 620 621 622 623 624
    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
625 626
            } = R.GetNgramsTableAll { listIds
                                    , tabType } (Just nodeId)
627 628 629 630

    handleResponse :: VersionedNgramsTable -> VersionedNgramsTable
    handleResponse v = v

631
type MainNgramsTablePaintProps = (
632 633
    cacheState        :: NT.CacheState
  , path              :: T.Box PageParams
634 635
  , versioned         :: VersionedNgramsTable
  | CommonProps
636 637
  )

638 639
mainNgramsTablePaint :: R2.Component MainNgramsTablePaintProps
mainNgramsTablePaint = R.createElement mainNgramsTablePaintCpt
640

641
mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
James Laver's avatar
James Laver committed
642
mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
643
  where
644
    cpt props@{ afterSync
645
              , cacheState
646
              , path
647 648
              , reloadForest
              , reloadRoot
649
              , tabNgramType
650
              , tasks
651 652
              , versioned
              , withAutoUpdate } _ = do
653
      state <- T.useBox $ initialState versioned
654

655
      pure $ loadedNgramsTable { afterSync
656
                               , cacheState
657
                               , mTotalRows: Nothing
658
                               , path
659 660
                               , reloadForest
                               , reloadRoot
661 662
                               , state
                               , tabNgramType
663
                               , tasks
664 665
                               , versioned
                               , withAutoUpdate
666
                               } []
667

668 669
type MainNgramsTablePaintNoCacheProps = (
    cacheState         :: NT.CacheState
670
  , path               :: T.Box PageParams
671
  , versionedWithCount :: VersionedWithCountNgramsTable
672
  | CommonProps
673 674
  )

675 676 677
mainNgramsTablePaintNoCache :: R2.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCache = R.createElement mainNgramsTablePaintNoCacheCpt

678
mainNgramsTablePaintNoCacheCpt :: R.Component MainNgramsTablePaintNoCacheProps
James Laver's avatar
James Laver committed
679
mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cpt
680
  where
681
    cpt props@{ afterSync
682
              , cacheState
James Laver's avatar
James Laver committed
683
              , path
684 685
              , reloadForest
              , reloadRoot
686
              , tabNgramType
687
              , tasks
688
              , versionedWithCount
689
              , withAutoUpdate } _ = do
690 691
      let count /\ versioned = toVersioned versionedWithCount

692
      state <- T.useBox $ initialState versioned
693 694 695

      pure $ loadedNgramsTable {
        afterSync
696
      , cacheState
697
      , mTotalRows: Just count
James Laver's avatar
James Laver committed
698
      , path: path
699 700
      , reloadForest
      , reloadRoot
701 702
      , state
      , tabNgramType
703
      , tasks
704 705
      , versioned
      , withAutoUpdate
706
      } []
707

Nicolas Pouillard's avatar
Nicolas Pouillard committed
708 709 710 711 712 713
type NgramsOcc = { occurrences :: Additive Int, children :: Set NgramsTerm }

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

sumOccurrences :: NgramsTable -> NgramsOcc -> Additive Int
714
sumOccurrences nt = sumOccChildren mempty
715
    where
716 717 718 719 720 721 722 723 724 725 726
      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)
727

728
optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> R.Element
729
optps1 { desc, mval } = H.option { value: value } [H.text desc]
730
  where value = maybe "" show mval
731 732 733