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

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

31
import Gargantext.Components.AutoUpdate (autoUpdateElt)
32
import Gargantext.Hooks.Loader (useLoader)
33
import Gargantext.Components.NgramsTable.Components as NTC
34
import Gargantext.Components.NgramsTable.Core
35
import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
36
import Gargantext.Components.Nodes.Lists.Types as NT
37
import Gargantext.Components.Table as T
38
import Gargantext.Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (/=), (<$>), (<<<), (<>), (=<<), (==), (||), read, otherwise)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
39
import Gargantext.Routes (SessionRoute(..)) as R
40
import Gargantext.Sessions (Session, get)
41
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
42
import Gargantext.Utils (queryMatchesLabel, toggleSet)
43
import Gargantext.Utils.CacheAPI as GUC
44
import Gargantext.Utils.Reactix as R2
45
import Gargantext.Utils.Seq as Seq
46

47 48
thisModule = "Gargantext.Components.NgramsTable"

49
type State' =
50 51
  CoreState
  ( ngramsParent     :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
52 53 54 55 56
  , ngramsChildren   :: Map NgramsTerm Boolean
                     -- ^ Used only when grouping.
                     --   This updates the children of `ngramsParent`,
                     --   ngrams set to `true` are to be added, and `false` to
                     --   be removed.
57 58
  , ngramsSelection  :: Set NgramsTerm
                     -- ^ The set of selected checkboxes of the first column.
59
  )
60

61
_ngramsChildren :: forall row. Lens' { ngramsChildren :: Map NgramsTerm Boolean | row } (Map NgramsTerm Boolean)
62 63
_ngramsChildren = prop (SProxy :: SProxy "ngramsChildren")

64 65 66
_ngramsSelection :: forall row. Lens' { ngramsSelection :: Set NgramsTerm | row } (Set NgramsTerm)
_ngramsSelection = prop (SProxy :: SProxy "ngramsSelection")

67 68
initialState' :: VersionedNgramsTable -> State'
initialState' (Versioned {version}) =
69 70 71 72
  { ngramsChildren:   mempty
  , ngramsLocalPatch: mempty
  , ngramsParent:     Nothing
  , ngramsSelection:  mempty
73 74
  , ngramsStagePatch: mempty
  , ngramsValidPatch: mempty
75
  , ngramsVersion:    version
76 77
  }

78 79
type State =
  CoreState (
80
    ngramsChildren   :: Map NgramsTerm Boolean
81 82 83 84
                     -- ^ Used only when grouping.
                     --   This updates the children of `ngramsParent`,
                     --   ngrams set to `true` are to be added, and `false` to
                     --   be removed.
85
  , ngramsParent     :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
86 87 88 89 90 91
  , ngramsSelection  :: Set NgramsTerm
                     -- ^ The set of selected checkboxes of the first column.
  )

initialState :: VersionedNgramsTable -> State
initialState (Versioned {version}) = {
92 93 94 95
    ngramsChildren:   mempty
  , ngramsLocalPatch: mempty
  , ngramsParent:     Nothing
  , ngramsSelection:  mempty
96 97 98 99 100
  , ngramsStagePatch: mempty
  , ngramsValidPatch: mempty
  , ngramsVersion:    version
  }

101 102 103 104 105 106 107
setTermListSetA :: NgramsTable -> Set NgramsTerm -> TermList -> Action
setTermListSetA ngramsTable ns new_list =
  CommitPatch $ fromNgramsPatches $ PatchMap $ mapWithIndex f $ toMap ns
  where
    f :: NgramsTerm -> Unit -> NgramsPatch
    f n unit = NgramsPatch { patch_list, patch_children: mempty }
      where
108
        cur_list = ngramsTable ^? at n <<< _Just <<< _NgramsRepoElement <<< _list
109
        patch_list = maybe mempty (\c -> replace c new_list) cur_list
110 111 112
    toMap :: forall a. Set a -> Map a Unit
    toMap = unsafeCoerce
    -- TODO https://github.com/purescript/purescript-ordered-collections/pull/21
113
    --      https://github.com/purescript/purescript-ordered-collections/pull/31
114 115 116 117
    -- toMap = Map.fromFoldable

addNewNgramA :: NgramsTerm -> Action
addNewNgramA ngram = CommitPatch $ addNewNgram ngram CandidateTerm
118

119
type PreConversionRows = Seq.Seq NgramsElement
120

121
type TableContainerProps =
122 123 124 125 126 127 128
  ( dispatch         :: Dispatch
  , ngramsChildren   :: Map NgramsTerm Boolean
  , ngramsParent     :: Maybe NgramsTerm
  , ngramsSelection  :: Set NgramsTerm
  , ngramsTable      :: NgramsTable
  , path             :: R.State PageParams
  , tabNgramType     :: CTabNgramType
129
  )
130

131 132 133 134 135 136 137 138 139 140 141
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
142
                  } = R2.hooksComponent thisModule "tableContainer" cpt
143
  where
144
    cpt props _ = do
145 146 147 148
      pure $ H.div {className: "container-fluid"} [
        H.div {className: "jumbotron1"}
        [ R2.row
          [ H.div {className: "panel panel-default"}
149 150 151 152 153 154
            [ H.div {className: "panel-heading"} [
              R2.row
              [ H.div {className: "col-md-2", style: {marginTop: "6px"}}
                [
                  if A.null props.tableBody && searchQuery /= "" then
                    H.li { className: "list-group-item" } [
155
                      H.button { className: "btn btn-primary"
156 157 158 159 160
                                , on: { click: const $ dispatch
                                      $ addNewNgramA
                                      $ normNgram tabNgramType searchQuery
                                      }
                                }
161
                      [ H.text ("Add " <> searchQuery) ]
162 163 164 165 166 167 168
                    ] 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)
169
                              , on: {change: setTermListFilter <<< read <<< R2.unsafeEventValue}}
170 171 172 173 174 175 176
                    (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)
177
                              , on: {change: setTermSizeFilter <<< read <<< R2.unsafeEventValue}}
178 179 180 181 182 183 184 185 186 187 188 189 190
                    (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" } [
                    --    ]
                    ]
                    ]
191
                  ]
192
                ]
193 194 195 196 197 198 199
              , H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}} [
                   H.li {className: "list-group-item"} [
                        props.pageSizeDescription
                      , props.paginationLinks
                      ]
                   ]
              ]
200
              ]
201
            , editor
202 203 204 205 206
            , if (selectionsExist ngramsSelection) then
                H.li {className: "list-group-item"} [
                  selectButtons true
                ] else
                H.div {} []
207 208 209
            , H.div {id: "terms_table", className: "panel-body"}
              [ H.table {className: "table able"}
                [ H.thead {className: "tableHeader"} [props.tableHead]
210 211
                , H.tbody {} props.tableBody
                ]
212

213 214 215 216 217 218 219 220 221 222 223
              , 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
                      ]
                    ]
                 ]
              ]
224 225
            ]
          ]
226 227
        ]
      ]
228 229 230
    -- WHY setPath     f = origSetPageParams (const $ f path)
    setTermListFilter x = setPath $ _ { termListFilter = x }
    setTermSizeFilter x = setPath $ _ { termSizeFilter = x }
231
    setSelection = dispatch <<< setTermListSetA ngramsTableCache ngramsSelection
232

233 234
    editor = H.div {} $ maybe [] f ngramsParent
      where
235 236 237 238 239 240 241 242 243 244 245 246 247 248
        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"]
                   , H.button { className: "btn btn-secondary"
                              , on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}
                              } [H.text "Cancel"]
                   ]
249 250 251
          where
            ngramsTable = ngramsTableCache # at ngrams
                          <<< _Just
252
                          <<< _NgramsRepoElement
253 254
                          <<< _children
                          %~ applyPatchSet (patchSetFromMap ngramsChildren)
255
            ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
256 257 258
            ngramsClick _ = Nothing
            ngramsEdit  _ = Nothing

259 260 261 262 263
    selectionsExist :: Set NgramsTerm -> Boolean
    selectionsExist = not <<< Set.isEmpty

    selectButtons false = H.div {} []
    selectButtons true =
264
      H.div {} [
265
        H.button { className: "btn btn-primary"
266
                , on: { click: const $ setSelection MapTerm }
267
                } [ H.text "Map" ]
268
        , H.button { className: "btn btn-primary"
269
                  , on: { click: const $ setSelection StopTerm }
270
                  } [ H.text "Stop" ]
271
        , H.button { className: "btn btn-primary"
272
                  , on: { click: const $ setSelection CandidateTerm }
273
                  } [ H.text "Candidate" ]
274 275
      ]

276
-- NEXT
277
type Props =
278 279
  ( afterSync    :: Unit -> Effect Unit
  , path         :: R.State PageParams
280
  , state        :: R.State State
281
  , tabNgramType :: CTabNgramType
282
  , versioned    :: VersionedNgramsTable
283
  , withAutoUpdate :: Boolean
284 285
  )

286 287
loadedNgramsTable :: Record Props -> R.Element
loadedNgramsTable p = R.createElement loadedNgramsTableCpt p []
288

289
loadedNgramsTableCpt :: R.Component Props
290
loadedNgramsTableCpt = R2.hooksComponent thisModule "loadedNgramsTable" cpt
291
  where
292 293
    cpt { afterSync
        , path: path@(path'@{ searchQuery, scoreType, params, termListFilter, termSizeFilter } /\ setPath)
294 295 296 297 298 299
        , state: (state@{ ngramsChildren
                        , ngramsLocalPatch
                        , ngramsParent
                        , ngramsSelection
                        , ngramsVersion } /\ setState)
        , tabNgramType
300
        , versioned: Versioned { data: initTable }
301
        , withAutoUpdate } _ = do
302

303
      pure $ R.fragment $
304
        autoUpdate <> syncResetButtons <> [
305 306 307 308 309
          H.h4 {style: {textAlign : "center"}} [
              H.span {className: "glyphicon glyphicon-hand-down"} []
            , H.text "Extracted Terms"
            ]
        , search
310
        , T.table { colNames
311 312 313 314 315 316 317 318
                  , container: tableContainer { dispatch: performAction
                                              , ngramsChildren
                                              , ngramsParent
                                              , ngramsSelection
                                              , ngramsTable
                                              , path
                                              , tabNgramType
                                              }
319
                  , params: params /\ setParams -- TODO-LENS
320
                  , rows: filteredConvertedRows
321
                  , totalRecords
322 323 324 325
                  , wrapColElts: wrapColElts { allNgramsSelected
                                             , dispatch: performAction
                                             , ngramsSelection
                                             }
326
                  }
327
        ] <> syncResetButtons
328
      where
329
        autoUpdate :: Array R.Element
330 331 332
        autoUpdate = if withAutoUpdate then
                       [ R2.buff $ autoUpdateElt { duration: 5000, effect: performAction Synchronize } ]
                     else []
333 334 335 336 337
        resetButton :: Boolean -> R.Element
        resetButton active = H.button { className: "btn btn-primary " <> if active then "" else " disabled"
                                      , on: { click: \_ -> performAction ResetPatches } } [ H.text "Reset" ]
        syncButton :: R.Element
        syncButton = H.button { className: "btn btn-primary"
338 339 340 341 342
                              , on: { click: \_ -> do
                                         performAction Synchronize
                                         afterSync unit
                                    }
                              } [ H.text "Sync" ]
343 344 345
        -- I would rather have the two buttons always here and make the reset button inactive when the patch is empty.
        syncResetButtons :: Array R.Element
        syncResetButtons = [ H.div {} [ resetButton (ngramsLocalPatch /= mempty), syncButton ] ]
346

347 348 349 350 351 352 353 354 355
        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
356
            newNC nc = Map.alter (maybe (Just b) (const Nothing)) c nc
357 358 359 360 361
        performAction (ToggleSelect c) =
          setState $ \s@{ ngramsSelection: ns } -> s { ngramsSelection = toggleSet c ns }
        performAction ToggleSelectAll =
          setState toggler
          where
362
            toggler s =
363 364 365 366
              if allNgramsSelected then
                s { ngramsSelection = Set.empty :: Set NgramsTerm }
              else
                s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
367 368 369 370
        performAction Synchronize = syncPatchesR path' (state /\ setState)
        performAction (CommitPatch pt) =
          commitPatchR (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
        performAction ResetPatches =
371
          setState $ \s -> s { ngramsLocalPatch = { ngramsPatches: mempty } }
372 373 374 375 376 377 378 379 380 381 382 383
        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
              commitPatchR (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)

384
        totalRecords = Seq.length rows
385 386 387 388
        filteredConvertedRows :: T.Rows
        filteredConvertedRows = convertRow <$> filteredRows
        filteredRows :: PreConversionRows
        filteredRows = T.filterRows { params } rows
Nicolas Pouillard's avatar
Nicolas Pouillard committed
389 390
        ng_scores :: Map NgramsTerm (Additive Int)
        ng_scores = ngramsTable ^. _NgramsTable <<< _ngrams_scores
391
        rows :: PreConversionRows
392
        rows = orderWith (
393 394 395
                 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
396
                   Map.toUnfoldable (ngramsTable ^. _NgramsTable <<< _ngrams_repo_elements)
397 398 399 400 401 402 403 404
               )
        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
405
          let Additive occurrences = sumOccurrences ngramsTable (ngramsElementToNgramsOcc ngramsElement) in
406
          ngramsElement # _NgramsElement <<< _occurrences .~ occurrences
407

408 409
        allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows

410
        ngramsTable = applyNgramsPatches state initTable
411
        roots = rootsOf ngramsTable
412 413 414 415
        ngramsParentRoot :: Maybe NgramsTerm
        ngramsParentRoot =
          (\np -> ngramsTable ^? at np
                            <<< _Just
416
                            <<< _NgramsRepoElement
417 418 419
                            <<< _root
                            <<< _Just
            ) =<< ngramsParent
420

421
        convertRow ngramsElement =
422
          { row: NTC.renderNgramsItem { dispatch: performAction
423
                                      , ngrams: ngramsElement ^. _NgramsElement <<< _ngrams
424 425 426 427 428
                                      , ngramsElement
                                      , ngramsLocalPatch
                                      , ngramsParent
                                      , ngramsSelection
                                      , ngramsTable }
429 430
          , delete: false
          }
431 432
        orderWith =
          case convOrderBy <$> params.orderBy of
433 434 435 436
            Just ScoreAsc  -> Seq.sortWith \x -> x        ^. _NgramsElement <<< _occurrences
            Just ScoreDesc -> Seq.sortWith \x -> Down $ x ^. _NgramsElement <<< _occurrences
            Just TermAsc   -> Seq.sortWith \x -> x        ^. _NgramsElement <<< _ngrams
            Just TermDesc  -> Seq.sortWith \x -> Down $ x ^. _NgramsElement <<< _ngrams
437 438 439 440
            _              -> identity -- the server ordering is enough here

        colNames = T.ColumnName <$> ["Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy
        -- This is used to *decorate* the Select header with the checkbox.
441
        wrapColElts scProps (T.ColumnName "Select") = const [NTC.selectionCheckbox scProps]
442 443
        wrapColElts _       (T.ColumnName "Score")  = (_ <> [H.text ("(" <> show scoreType <> ")")])
        wrapColElts _       _                       = identity
444 445
        setParams f = setPath $ \p@{params: ps} -> p {params = f ps}

446
        search :: R.Element
447 448 449
        search = NTC.searchInput { key: "search-input"
                                 , onSearch: setSearchQuery
                                 , searchQuery: searchQuery }
450 451 452
        setSearchQuery :: String -> Effect Unit
        setSearchQuery x    = setPath $ _ { searchQuery    = x }

453

454
displayRow :: State -> SearchQuery -> NgramsTable -> Maybe NgramsTerm -> Maybe TermList -> Maybe TermSize -> NgramsElement -> Boolean
455 456 457 458
displayRow state@{ ngramsChildren
                 , ngramsLocalPatch
                 , ngramsParent }
           searchQuery
459
           ngramsTable
460
           ngramsParentRoot
461
           termListFilter
462
           termSizeFilter
463
           (NgramsElement {ngrams, root, list}) =
464 465 466 467 468 469 470 471 472 473 474
  (
      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
475 476
    && filterTermSize termSizeFilter ngrams
    -- ^ and which satisfies the chosen term size
477 478 479 480 481 482 483
    || 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.
484

485

486 487 488 489
allNgramsSelectedOnFirstPage :: Set NgramsTerm -> PreConversionRows -> Boolean
allNgramsSelectedOnFirstPage selected rows = selected == (selectNgramsOnFirstPage rows)

selectNgramsOnFirstPage :: PreConversionRows -> Set NgramsTerm
490
selectNgramsOnFirstPage rows = Set.fromFoldable $ (view $ _NgramsElement <<< _ngrams) <$> rows
491 492


493
type MainNgramsTableProps =
494
  ( afterSync     :: Unit -> Effect Unit
495
  , cacheState    :: R.State NT.CacheState
496
  , defaultListId :: Int
497 498
  , nodeId        :: Int
    -- ^ This node can be a corpus or contact.
499
  , session       :: Session
500
  , tabNgramType  :: CTabNgramType
501
  , tabType       :: TabType
502
  , withAutoUpdate :: Boolean
503
  )
504

505 506
mainNgramsTable :: Record MainNgramsTableProps -> R.Element
mainNgramsTable props = R.createElement mainNgramsTableCpt props []
507

508
mainNgramsTableCpt :: R.Component MainNgramsTableProps
509
mainNgramsTableCpt = R2.hooksComponent thisModule "mainNgramsTable" cpt
510
  where
511 512 513 514 515 516 517 518
    cpt props@{ afterSync
              , cacheState
              , defaultListId
              , nodeId
              , session
              , tabNgramType
              , tabType
              , withAutoUpdate } _ = do
519
      let path = initialPageParams session nodeId [defaultListId] tabType
520

521
      let render versioned = mainNgramsTablePaint { afterSync, path, tabNgramType, versioned, withAutoUpdate }
522 523 524 525 526 527 528 529 530 531 532 533

      case cacheState of
        (NT.CacheOn /\ _) ->
          useLoaderWithCacheAPI {
              cacheEndpoint: versionEndpoint props
            , handleResponse
            , mkRequest
            , path
            , renderer: render
            }
        (NT.CacheOff /\ _) ->
          useLoader path loader render
534

535 536 537
    versionEndpoint :: Record MainNgramsTableProps -> PageParams -> Aff Version
    versionEndpoint { defaultListId, nodeId, session, tabType } _ = get session $ R.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId)

538 539 540 541
    loader :: PageParams -> Aff VersionedNgramsTable
    loader path@{ listIds, nodeId, session, tabType } =
      get session $ R.GetNgramsTableAll { listIds, tabType } (Just nodeId)

542 543 544 545 546 547 548 549 550 551 552
    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
553 554
            } = R.GetNgramsTableAll { listIds
                                    , tabType } (Just nodeId)
555 556 557 558 559

    handleResponse :: VersionedNgramsTable -> VersionedNgramsTable
    handleResponse v = v

    pathNoLimit :: PageParams -> PageParams
560 561
    pathNoLimit path@{ params } = path { params = params { limit = 100000 }
                                       , termListFilter = Nothing }
562

563
type MainNgramsTablePaintProps =
564 565 566 567
  ( afterSync      :: Unit -> Effect Unit
  , path           :: PageParams
  , tabNgramType   :: CTabNgramType
  , versioned      :: VersionedNgramsTable
568 569 570 571 572 573 574
  , withAutoUpdate :: Boolean
  )

mainNgramsTablePaint :: Record MainNgramsTablePaintProps -> R.Element
mainNgramsTablePaint p = R.createElement mainNgramsTablePaintCpt p []

mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
575
mainNgramsTablePaintCpt = R2.hooksComponent thisModule "mainNgramsTablePaint" cpt
576
  where
577
    cpt { afterSync, path, tabNgramType, versioned, withAutoUpdate } _ = do
578
      pathS <- R.useState' path
579
      state <- R.useState' $ initialState versioned
580

581
      pure $ loadedNgramsTable {
582 583
        afterSync
      , path: pathS
584
      , state
585 586 587 588 589
      , tabNgramType
      , versioned
      , withAutoUpdate
      }

Nicolas Pouillard's avatar
Nicolas Pouillard committed
590 591 592 593 594 595
type NgramsOcc = { occurrences :: Additive Int, children :: Set NgramsTerm }

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

sumOccurrences :: NgramsTable -> NgramsOcc -> Additive Int
596
sumOccurrences nt = sumOccChildren mempty
597
    where
598 599 600 601 602 603 604 605 606 607 608
      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)
609

610
optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> R.Element
611
optps1 { desc, mval } = H.option { value: value } [H.text desc]
612
  where value = maybe "" show mval