NgramsTable.purs 39.7 KB
Newer Older
1 2
module Gargantext.Components.NgramsTable
  ( MainNgramsTableProps
3
  , CommonProps
4
  , TreeEdit
5
  , NgramsTreeEditProps
6
  , getNgramsChildrenAff
7
  , initialTreeEdit
8 9
  , mainNgramsTable
  ) where
10

11 12
import Gargantext.Prelude

13
import Data.Array as A
14
import Data.Either (Either(..))
15
import Data.FunctorWithIndex (mapWithIndex)
16
import Data.Lens (to, view, (.~), (^.), (^?))
17
import Data.Lens.At (at)
18
import Data.Lens.Common (_Just)
19
import Data.Lens.Fold (folded)
20
import Data.Lens.Index (ix)
21
import Data.List (List, intercalate)
22
import Data.List as List
23 24
import Data.Map (Map)
import Data.Map as Map
25
import Data.Maybe (Maybe(..), fromMaybe, isNothing, maybe)
26
import Data.Ord.Down (Down(..))
27
import Data.Sequence as Seq
28 29
import Data.Set (Set)
import Data.Set as Set
30
import Data.Tuple (Tuple(..))
31
import Data.Tuple.Nested ((/\))
32
import Effect (Effect)
33
import Effect.Aff (Aff)
arturo's avatar
arturo committed
34
import Gargantext.Components.App.Store (Boxes)
35
import Gargantext.Components.Bootstrap as B
36 37
import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), Sizing(..), Variant(..))
import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
38 39
import Gargantext.Components.NgramsTable.Search as NTS
import Gargantext.Components.NgramsTable.SelectionCheckbox as NTSC
40
import Gargantext.Components.NgramsTable.SyncResetButton (syncResetButtons)
41
import Gargantext.Components.NgramsTable.Tree (renderNgramsItem, renderNgramsTree)
42
import Gargantext.Components.Nodes.Lists.Types as NT
43
import Gargantext.Components.Table (changePage)
44
import Gargantext.Components.Table as TT
45
import Gargantext.Components.Table.Types (Params)
46
import Gargantext.Components.Table.Types as TT
47
import Gargantext.Config.REST (AffRESTError, RESTError, logRESTError)
48 49
import Gargantext.Core.NgramsTable.Functions (addNewNgramA, applyNgramsPatches, chartsAfterSync, commitPatch, convOrderBy, coreDispatch, filterTermSize, ngramsRepoElementToNgramsElement, normNgram, patchSetFromMap, singletonNgramsTablePatch, tablePatchHasNgrams, toVersioned)
import Gargantext.Core.NgramsTable.Types (Action(..), CoreAction(..), CoreState, Dispatch, NgramsActionRef, NgramsClick, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTablePatch(..), NgramsTerm(..), PageParams, PatchMap(..), Versioned(..), VersionedNgramsTable, VersionedWithCountNgramsTable, _NgramsElement, _NgramsRepoElement, _NgramsTable, _children, _list, _ngrams, _ngrams_repo_elements, _ngrams_scores, _occurrences, _root, applyPatchSet, ngramsTermText, replace)
50
import Gargantext.Hooks.Loader (useLoaderBox)
51
import Gargantext.Routes (SessionRoute(..)) as Routes
52
import Gargantext.Sessions (Session, get)
53
import Gargantext.Types (CTabNgramType, ListId, NodeID, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
54
import Gargantext.Utils (nbsp, queryExactMatchesLabel, queryMatchesLabel, sortWith, toggleSet)
55
import Gargantext.Utils.CacheAPI as GUC
56
import Gargantext.Utils.Reactix as R2
57
import Gargantext.Utils.Seq as Seq
James Laver's avatar
James Laver committed
58
import Gargantext.Utils.Toestand as T2
59 60
import Reactix as R
import Reactix.DOM.HTML as H
61
import Record as Record
62 63
import Toestand as T
import Unsafe.Coerce (unsafeCoerce)
64

James Laver's avatar
James Laver committed
65 66
here :: R2.Here
here = R2.here "Gargantext.Components.NgramsTable"
67

68
type TreeEdit =
69 70
  { isEditing          :: Boolean
  , ngramsChildren     :: List NgramsTerm
71 72 73 74 75 76 77 78 79 80
                       -- ^ Root children, as were originally present
                       --   in the table, before editing
  , ngramsChildrenDiff :: 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.
  , ngramsParent       :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
  }

81 82
type State =
  CoreState (
83
    ngramsSelection  :: Set NgramsTerm
84 85 86
                     -- ^ The set of selected checkboxes of the first column.
  )

87 88
initialTreeEdit :: TreeEdit
initialTreeEdit =
89 90
  { isEditing         : false
  , ngramsChildren    : List.Nil
91 92 93
  , ngramsChildrenDiff: Map.empty
  , ngramsParent      : Nothing }

94 95 96
initialState :: State
initialState =
  { ngramsLocalPatch: mempty
97
  , ngramsSelection:  mempty
98 99
  , ngramsStagePatch: mempty
  , ngramsValidPatch: mempty
100
  , ngramsVersion:    0
101 102
  }

103 104 105
initialStateWithVersion :: VersionedNgramsTable -> State
initialStateWithVersion (Versioned { version }) = initialState { ngramsVersion = version }

106 107
setTermListSetA :: NgramsTable -> Set NgramsTerm -> TermList -> Action
setTermListSetA ngramsTable ns new_list =
108
  CoreAction $ CommitPatch $ NgramsTablePatch $ PatchMap $ mapWithIndex f $ toMap ns
109 110
  where
    f :: NgramsTerm -> Unit -> NgramsPatch
111
    f n _unit = NgramsPatch { patch_list, patch_children: mempty }
112
      where
113
        cur_list = ngramsTable ^? at n <<< _Just <<< _NgramsRepoElement <<< _list
114 115 116 117
        --patch_list = maybe mempty (replace new_list) cur_list
        patch_list = case cur_list of
          Nothing -> mempty
          Just cl -> replace cl new_list
118 119 120
    toMap :: forall a. Set a -> Map a Unit
    toMap = unsafeCoerce
    -- TODO https://github.com/purescript/purescript-ordered-collections/pull/21
121
    --      https://github.com/purescript/purescript-ordered-collections/pull/31
122 123
    -- toMap = Map.fromFoldable

124
type PreConversionRows = Seq.Seq NgramsElement
125

126
type TableContainerProps =
127 128 129
  ( addCallback       :: String -> Effect Unit
  , dispatch          :: Dispatch
  , getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
130 131 132
  , ngramsSelection   :: Set NgramsTerm
  , ngramsTable       :: NgramsTable
  , path              :: T.Box PageParams
133
  , queryExactMatches :: Boolean
134 135
  , syncResetButton   :: Array R.Element
  , tabNgramType      :: CTabNgramType
136
  )
137

138
tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps -> R.Element
139
tableContainer p q = R.createElement (tableContainerCpt p) q []
140
tableContainerCpt :: Record TableContainerProps -> R.Component TT.TableContainerProps
141 142 143
tableContainerCpt { addCallback
                  , dispatch
                  , getNgramsChildren
144 145
                  , ngramsSelection
                  , ngramsTable: ngramsTableCache
146
                  , path
147
                  , queryExactMatches
148
                  , syncResetButton
149
                  , tabNgramType
150 151 152 153 154 155 156
                  } = here.component "tableContainer" cpt where
  cpt props _ = do
    -- | States
    -- |
    { searchQuery
    , termListFilter
    , termSizeFilter
157
    , params
158
    } <- T.useLive T.unequal path
159
    params <- T.useFocused (_.params) (\a b -> b { params = a }) path
160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186

    -- | Computed
    -- |
    let
      showAddNewTerm =
        (
          (not queryExactMatches || A.null props.tableBody)
        &&
          (searchQuery /= "")
        )

    -- | Render
    -- |
    pure $

      H.div
      { className: intercalate " "
        [ "ngrams-table-container"
        , "card"
        ]
      }
      [

        H.div
        { className: intercalate " "
            [ "ngrams-table-container__header"
            , "card-header"
187
            ]
188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215
        }
        [
        --   H.div
        --   { className: "col-md-2"
        --   , style: { marginTop: "6px" }
        --   }
        --   [
        --     H.li
        --     { className: "list-group-item" }
        --     syncResetButton
        --   ,
        --     -- , if (not $ Set.member (normNgram tabNgramType searchQuery) ngramsSelection) && searchQuery /= "" then
        --
        --   ]
        -- ,

          H.div
          { className: intercalate " "
              [ "ngrams-table-container__header__item"
              , "card"
              ]
          }
          syncResetButton
        ,
          H.div
          { className: intercalate " "
              [ "ngrams-table-container__header__item"
              , "card"
216
              ]
217 218 219 220 221 222
          }
          [
            R2.select
            { id: "picklistmenu"
            , className: "form-control custom-select"
            , defaultValue: (maybe "" show termListFilter)
223
            , on: {change: changeTermList params}
224 225 226 227 228 229 230 231
            }
            (map optps1 termLists)
          ]
        ,
          H.div
          { className: intercalate " "
              [ "ngrams-table-container__header__item"
              , "card"
232
              ]
233 234 235 236 237 238
          }
          [
            R2.select
            { id: "picktermtype"
            , className: "form-control custom-select"
            , defaultValue: (maybe "" show termSizeFilter)
239
            , on: {change: changeTermSize params}
240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349
            }
            (map optps1 termSizes)
          ]
        ,
          H.div
          { className: intercalate " "
              [ "ngrams-table-container__header__item"
              , "card"
              ]
          }
          [
            B.wad
            [ "d-flex", "align-items-center" ]
            [
              props.pageSizeControl
            ,
              B.wad_ [ "mr-2", "d-inline-block" ]
            ,
              B.label_ "items"
              --   H.div { className: "col-md-6" } [ props.pageSizeControl ]
              -- , H.div { className: "col-md-6" } [
              --    ]
            ]
          ]
        ,
          H.div
          { className: intercalate " "
              [ "ngrams-table-container__header__item"
              , "card"
              , "flex-grow-1"
              ]
          }
          [
            props.pageSizeDescription
          ,
            props.paginationLinks
          ]
        ]
      ,
        R2.when (selectionsExist ngramsSelection) $

          H.li
          { className: "card" }
          [
            selectButtons true
          ]
      ,
        H.div
        { id: "terms_table"
        , className: "card-body"
        }
        [
          R2.when showAddNewTerm $

            H.div
            { className: "ngrams-table-container__add-term" }
            [
              B.button
              { variant: ButtonVariant Light
              , callback: const $ addCallback searchQuery
              }
              [
                B.icon
                { name: "circle"
                , className: "mr-1 graph-term"
                }
              ,
                H.text "Add"
              ,
                H.text $ nbsp 1
              ,
                B.b_ $ "« " <> searchQuery <> " »"
              ,
                H.text $ nbsp 1
              ,
                H.text "to Map terms"
              ]
            ]
        ,
          H.table
          { className: "table able" }
          [
            H.thead
            {}
            [
              props.tableHead
            ]
          ,
            H.tbody
            {}
            props.tableBody
          ]
        ,
          H.li
          { className: intercalate " "
              [ "ngrams-table-container__footer"
              , "card"
              ]
          }
          [
            H.div
            { className: "ngrams-table-container__footer__item" }
            [
              selectButtons (selectionsExist ngramsSelection)
            ]
          ,
            H.div
            { className: "ngrams-table-container__footer__item" }
            [
              props.paginationLinks
350 351 352 353
            ]
          ]
        ]
      ]
354 355 356 357 358 359

  -- WHY setPath     f = origSetPageParams (const $ f path)
  setTermListFilter x = T.modify (_ { termListFilter = x }) path
  setTermSizeFilter x = T.modify (_ { termSizeFilter = x }) path
  setSelection term = dispatch $ setTermListSetA ngramsTableCache ngramsSelection term

360 361 362 363 364 365 366 367
  changeTermList params e = do
    _ <- setTermListFilter $ read $ R.unsafeEventValue e
    changePage 1 params

  changeTermSize params e = do
    _ <- setTermSizeFilter $ read $ R.unsafeEventValue e
    changePage 1 params

368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383
  selectionsExist :: Set NgramsTerm -> Boolean
  selectionsExist = not <<< Set.isEmpty

  selectButtons false = H.div {} []
  selectButtons true =
    H.div {} [
      H.button { className: "btn btn-primary"
              , on: { click: const $ setSelection MapTerm }
              } [ H.text "Map" ]
      , H.button { className: "btn btn-primary"
                , on: { click: const $ setSelection StopTerm }
                } [ H.text "Stop" ]
      , H.button { className: "btn btn-primary"
                , on: { click: const $ setSelection CandidateTerm }
                } [ H.text "Candidate" ]
    ]
384

385
-- NEXT
386

387
type CommonProps =
388 389 390 391
  ( afterSync         :: Unit -> Aff Unit
  , boxes             :: Boxes
  , tabNgramType      :: CTabNgramType
  , withAutoUpdate    :: Boolean -- (?) not used
392 393
  )

394
type PropsNoReload =
395 396 397 398 399 400
  ( cacheState        :: NT.CacheState
  , mTotalRows        :: Maybe Int
  , path              :: T.Box PageParams
  , state             :: T.Box State
  , treeEdit          :: Record NgramsTreeEditProps
  , versioned         :: VersionedNgramsTable
401
  | CommonProps
402 403
  )

404
type Props =
405 406 407 408
  ( reloadForest   :: T2.ReloadS
  , reloadRoot     :: T2.ReloadS
  | PropsNoReload )

409
type LoadedNgramsTableHeaderProps =
410
  ( searchQuery :: T.Box SearchQuery, params :: T.Box Params )
411

412 413
loadedNgramsTableHeader :: R2.Leaf LoadedNgramsTableHeaderProps
loadedNgramsTableHeader = R2.leaf loadedNgramsTableHeaderCpt
414 415
loadedNgramsTableHeaderCpt :: R.Component LoadedNgramsTableHeaderProps
loadedNgramsTableHeaderCpt = here.component "loadedNgramsTableHeader" cpt where
416
  cpt { searchQuery, params } _ = pure $
417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432

    R.fragment
    [
      H.div
      { className: "loaded-ngrams-table-header" }
      [
        B.icon
        { name: "hand-o-down"
        , className: "loaded-ngrams-table-header__icon"
        }
      ,
        B.wad_ [ "mr-1", "d-inline-block" ]
      ,
        B.span'
        { className: "loaded-ngrams-table-header__text" } $
        "Extracted Terms"
433
      ]
434 435 436 437
    ,
      NTS.searchInput
      { key: "search-input"
      , searchQuery
438
      , params
439 440
      }
    ]
441 442 443 444 445

loadedNgramsTableBody :: R2.Component PropsNoReload
loadedNgramsTableBody = R.createElement loadedNgramsTableBodyCpt
loadedNgramsTableBodyCpt :: R.Component PropsNoReload
loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
446
  cpt { afterSync
447 448
      , boxes: { errors
               , tasks }
449 450 451 452 453
      , cacheState
      , mTotalRows
      , path
      , state
      , tabNgramType
454
      , treeEdit: treeEdit@{ getNgramsChildren }
455
      , versioned: Versioned { data: initTable }
456
      } _ = do
457
    treeEdit'@{ ngramsParent } <- T.useLive T.unequal treeEdit.box
458
    state'@{ ngramsLocalPatch, ngramsSelection } <- T.useLive T.unequal state
459
    path'@{ scoreType, termListFilter, termSizeFilter } <- T.useLive T.unequal path
460 461
    params <- T.useFocused (_.params) (\a b -> b { params = a }) path
    params'@{ orderBy } <- T.useLive T.unequal params
462 463
    searchQueryFocused <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path
    searchQuery <- T.useLive T.unequal searchQueryFocused
464
    isEditing <- T.useFocused (_.isEditing) (\a b -> b { isEditing = a}) treeEdit.box
465

466 467
    let ngramsTable = applyNgramsPatches state' initTable
        rowMap (Tuple ng nre) =
468
          let ng_scores :: Map NgramsTerm (Set Int)
469
              ng_scores = ngramsTable ^. _NgramsTable <<< _ngrams_scores
470
              s = ng_scores ^. at ng <<< _Just
471
              addOcc ne =
472
                let occurrences = sumOccurrences ngramsTable (ngramsElementToNgramsOcc ne) in
473 474 475 476
                ne # _NgramsElement <<< _occurrences .~ occurrences
          in
          addOcc <$> rowsFilter (ngramsRepoElementToNgramsElement ng s nre)
        rows :: PreConversionRows
477 478 479 480 481 482 483
        rows = ngramsTableOrderWith orderBy (Seq.mapMaybe rowMap nres)
        nres = Map.toUnfoldable (ngramsTable ^. _NgramsTable <<< _ngrams_repo_elements)
        rootOfMatch (Tuple ng nre) =
          if queryMatchesLabel searchQuery (ngramsTermText ng)
          then Just (fromMaybe ng (nre ^. _NgramsRepoElement <<< _root))
          else Nothing
        rootsWithMatches = Set.fromFoldable (Seq.mapMaybe rootOfMatch nres)
484 485 486 487
        exactMatches :: Boolean
        exactMatches = not $ Seq.null $ Seq.filter fltr nres
          where
            fltr (Tuple ng _) = queryExactMatchesLabel searchQuery (ngramsTermText ng)
488
        rowsFilter :: NgramsElement -> Maybe NgramsElement
489 490 491
        rowsFilter ngramsElement =
          if displayRow { ngramsElement
                        , ngramsParentRoot
492
                        , rootsWithMatches
493 494
                        , state: state'
                        , termListFilter
495 496
                        , termSizeFilter
                        , treeEdit: treeEdit' } then
497 498 499 500 501 502 503
            Just ngramsElement
          else
            Nothing

        performAction = mkDispatch { filteredRows
                                   , path: path'
                                   , state
504
                                   , treeEdit }
505

506 507 508 509 510 511 512
        -- 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 =
513 514
          { row: renderNgramsItem { dispatch: performAction
                                  , getNgramsChildren
515
                                  , isEditing
516 517 518 519 520
                                  , ngrams: ngramsElement ^. _NgramsElement <<< _ngrams
                                  , ngramsElement
                                  , ngramsLocalPatch
                                  , ngramsSelection
                                  , ngramsTable } []
521 522 523 524 525
          , delete: false
          }

        allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows

526 527
        totalRecords = fromMaybe (Seq.length rows) mTotalRows

528
        afterSync' _ = do
529
          chartsAfterSync path' errors tasks unit
530
          afterSync unit
531

532 533 534
        syncResetButton = syncResetButtons { afterSync: afterSync'
                                           , ngramsLocalPatch
                                           , performAction: performAction <<< CoreAction }
535

536 537 538 539 540 541 542 543 544
        addCallback searchQuery = do
          -- add new ngram as a "Map Term"
          performAction
            $ CoreAction
            $ addNewNgramA (normNgram tabNgramType searchQuery) MapTerm
          -- then sync the ngram list
          performAction
            $ CoreAction
            $ Synchronize { afterSync: afterSync' }
545
          changePage 1 params
546 547


548
        -- autoUpdate :: Array R.Element
549 550 551 552 553 554 555 556
--         autoUpdate = if withAutoUpdate then
--                        [ R2.buff
--                        $ autoUpdateElt
--                          { duration: 5000
--                          , effect: performAction $ CoreAction $ Synchronize { afterSync: afterSync' }
--                          }
--                        ]
--                      else []
557

558 559 560 561 562 563 564 565
        ngramsParentRoot :: Maybe NgramsTerm
        ngramsParentRoot =
          (\np -> ngramsTable ^? at np
                            <<< _Just
                            <<< _NgramsRepoElement
                            <<< _root
                            <<< _Just
            ) =<< ngramsParent
566

567 568 569
    R.useEffect' $ do
      R.setRef treeEdit.onCancelRef $ Just $ const $ performAction ClearTreeEdit
      R.setRef treeEdit.onSaveRef $ Just $ const $ performAction AddTermChildren
570
      let ngramsClick { depth: 1, ngrams: child } = Just $ performAction $ ToggleChild  false child
571 572 573
          ngramsClick  _ = Nothing
      R.setRef treeEdit.onNgramsClickRef $ Just ngramsClick

574 575 576 577
    pure $ R.fragment
      [ TT.table
        { colNames
        , container: tableContainer
578 579 580
          { addCallback
          , dispatch: performAction
          , getNgramsChildren
581 582 583
          , ngramsSelection
          , ngramsTable
          , path
584
          , queryExactMatches: exactMatches
585
          , syncResetButton: [ syncResetButton ]
586 587
          , tabNgramType
          }
588 589 590 591 592 593 594
        , params
        , rows: filteredConvertedRows
        , syncResetButton: [ syncResetButton ]
        , totalRecords
        , wrapColElts:
          wrapColElts { allNgramsSelected, dispatch: performAction, ngramsSelection } scoreType
        }
595 596 597 598 599 600
      ,
        B.wad
        [ "mt-2", "d-inline-block" ]
        [
          syncResetButton
        ]
James Laver's avatar
James Laver committed
601
      ]
602
      where
603
        colNames = TT.ColumnName <$> ["Show", "Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy
604

605 606 607 608 609 610 611
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
612

613
-- This is used to *decorate* the Select header with the checkbox.
614
wrapColElts scProps _         (TT.ColumnName "Select") = const [NTSC.selectionCheckbox scProps]
615 616
wrapColElts _       scoreType (TT.ColumnName "Score")  = (_ <> [H.text ("(" <> show scoreType <> ")")])
wrapColElts _       _         _                        = identity
617

618 619 620
type MkDispatchProps = (
    filteredRows :: PreConversionRows
  , path         :: PageParams
621
  , state        :: T.Box State
622
  , treeEdit     :: Record NgramsTreeEditProps
623 624 625 626 627
  )

mkDispatch :: Record MkDispatchProps -> (Action -> Effect Unit)
mkDispatch { filteredRows
           , path
628
           , state
629
           , treeEdit } = performAction
630 631
  where
    performAction :: Action -> Effect Unit
632 633
    performAction ClearTreeEdit = do
      T.write_ initialTreeEdit treeEdit.box
634
    performAction (SetParentResetChildren ngramsParent ngramsChildren) = do
635 636
      T.write_ { isEditing: true
               , ngramsChildren
637
               , ngramsChildrenDiff: Map.empty
638 639 640
               , ngramsParent } treeEdit.box
    performAction (ToggleChild b c) = do
      T.modify_ (\g@{ ngramsChildrenDiff: ncd } -> g { ngramsChildrenDiff = newNC ncd }) treeEdit.box
641
      where
642
        newNC ncd = Map.alter (maybe (Just b) (const Nothing)) c ncd
643
    performAction (ToggleSelect c) =
644
      T.modify_ (\s@{ ngramsSelection: ns } -> s { ngramsSelection = toggleSet c ns }) state
645 646 647
    performAction ToggleSelectAll = do
      { ngramsSelection } <- T.read state
      T.modify_ (toggler ngramsSelection) state
648
      where
649 650
        toggler ngramsSelection s =
          if allNgramsSelectedOnFirstPage ngramsSelection filteredRows then
651 652 653
            s { ngramsSelection = Set.empty :: Set NgramsTerm }
          else
            s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
654
    performAction AddTermChildren = do
655
      { ngramsChildren, ngramsChildrenDiff, ngramsParent } <- T.read treeEdit.box
656 657 658 659 660
      case ngramsParent of
        Nothing ->
          -- impossible but harmless
          pure unit
        Just parent -> do
661
          let pc = patchSetFromMap ngramsChildrenDiff
662 663
              pe = NgramsPatch { patch_list: mempty, patch_children: pc }
              pt = singletonNgramsTablePatch parent pe
664 665 666 667 668 669 670 671 672
          performAction ClearTreeEdit
          -- let ppt = case (A.head $ Set.toUnfoldable $ Map.keys ngramsChildrenDiff) of
          --       Nothing -> mempty
          --       Just h  ->
          --         let pp = NgramsPatch { patch_list: mempty
          --                              , patch_children: patchSetFromMap $ Map.mapMaybe (\v -> Just $ not v) ngramsChildrenDiff }
          --         in
          --         singletonNgramsTablePatch h pp
          -- here.log2 "[performAction] pt with patchSetFromMap" $ pt <> ppt
673
          commitPatch (pt {-<> ppt-}) state
674 675 676 677 678
    performAction (CoreAction a) = coreDispatch path state a


displayRow :: { ngramsElement    :: NgramsElement
              , ngramsParentRoot :: Maybe NgramsTerm
679
              , rootsWithMatches :: Set NgramsTerm
680 681
              , state            :: State
              , termListFilter   :: Maybe TermList
682 683
              , termSizeFilter   :: Maybe TermSize
              , treeEdit         :: TreeEdit } -> Boolean
684 685
displayRow { ngramsElement: NgramsElement {ngrams, root, list}
           , ngramsParentRoot
686
           , state: { ngramsLocalPatch }
687
           , rootsWithMatches
688
           , termListFilter
689 690 691 692
           , termSizeFilter
           , treeEdit: { ngramsChildren
                       , ngramsChildrenDiff
                       , ngramsParent } } =
693 694 695 696 697 698 699 700
    -- See these issues about the evolution of this filtering.
    -- * https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/340
    -- * https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/87
       isNothing root
    -- ^ Display only nodes without parents.
    && Set.member ngrams rootsWithMatches
    -- ^ and which matches the search query.
    && maybe true (_ == list) termListFilter
701
    -- ^ and which matches the ListType filter.
702
    && ngramsChildrenDiff ^. at ngrams /= Just true
703 704 705 706 707
    -- ^ 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
708 709
    && filterTermSize termSizeFilter ngrams
    -- ^ and which satisfies the chosen term size
710
    || ngramsChildrenDiff ^. at ngrams == Just false
711
    -- ^ unless they are scheduled to be removed.
712
    || tablePatchHasNgrams ngramsLocalPatch ngrams
713
    -- ^ unless they are being processed at the moment.
714

715 716 717 718
allNgramsSelectedOnFirstPage :: Set NgramsTerm -> PreConversionRows -> Boolean
allNgramsSelectedOnFirstPage selected rows = selected == (selectNgramsOnFirstPage rows)

selectNgramsOnFirstPage :: PreConversionRows -> Set NgramsTerm
719
selectNgramsOnFirstPage rows = Set.fromFoldable $ (view $ _NgramsElement <<< _ngrams) <$> rows
720 721


722
type MainNgramsTableProps = (
723 724
    cacheState    :: T.Box NT.CacheState
  , defaultListId :: Int
725
    -- ^ This node can be a corpus or contact.
726 727 728
  , path          :: T.Box PageParams
  , session       :: Session
  , tabType       :: TabType
729
  , treeEdit      :: Record NgramsTreeEditProps
730
  | CommonProps
731
  )
732

733 734
getNgramsChildrenAff :: Session -> NodeID -> Array ListId -> TabType -> NgramsTerm -> Aff (Array NgramsTerm)
getNgramsChildrenAff session nodeId listIds tabType (NormNgramsTerm ngrams) = do
735
  res :: Either RESTError ({ data :: Array { children :: Array String, ngrams :: String }}) <- get session $ Routes.GetNgrams params (Just nodeId)
736 737
  case res of
    Left err -> pure []
738 739 740
    Right { data: lst } -> case A.uncons (A.filter (\d -> d.ngrams == ngrams) lst) of
      Nothing -> pure []
      Just { head } -> pure $ NormNgramsTerm <$> head.children
741 742
  where
    params = { limit: 10
743
             , listIds
744 745
             , offset: Nothing
             , orderBy: Nothing
746
             , searchQuery: ngrams
747 748 749 750
             , tabType
             , termListFilter: Nothing
             , termSizeFilter: Nothing }

751 752
mainNgramsTable :: R2.Component MainNgramsTableProps
mainNgramsTable = R.createElement mainNgramsTableCpt
753
mainNgramsTableCpt :: R.Component MainNgramsTableProps
James Laver's avatar
James Laver committed
754
mainNgramsTableCpt = here.component "mainNgramsTable" cpt
755
  where
756
    cpt props@{ cacheState, path, treeEdit } _ = do
757
      searchQuery <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path
758
      params <- T.useFocused (_.params) (\a b -> b { params = a }) path
759
      cacheState' <- T.useLive T.unequal cacheState
760 761 762
      -- onCancelRef <- R.useRef Nothing
      -- onNgramsClickRef <- R.useRef Nothing
      -- onSaveRef   <- R.useRef Nothing
763
      state <- T.useBox initialState
764
      -- ngramsLocalPatch <- T.useFocused (_.ngramsLocalPatch) (\a b -> b { ngramsLocalPatch = a }) state
765

766 767
      -- nodeId <- T.useFocused (_.nodeId) (\a b -> b { nodeId = a }) path
      -- nodeId' <- T.useLive T.unequal nodeId
768 769 770 771 772

      -- let treeEdit = { box: treeEditBox
      --                , getNgramsChildren: getNgramsChildrenAff session nodeId' tabType
      --                , onCancelRef
      --                , onNgramsClickRef
773
      --                , onSaveRef
774
      --                }
775 776

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

778
      case cacheState' of
779
        NT.CacheOn  -> pure $ R.fragment
780
          [ loadedNgramsTableHeader { searchQuery, params }
781 782
          , ngramsTreeEdit (treeEdit)
          , mainNgramsTableCacheOn (Record.merge props { state })
783 784
          ]
        NT.CacheOff -> pure $ R.fragment
785
          [loadedNgramsTableHeader { searchQuery, params}
786 787
          , ngramsTreeEdit (treeEdit)
          , mainNgramsTableCacheOff (Record.merge props { state })
788 789
          ]

790

791
type NgramsTreeEditProps =
792 793
  ( box               :: T.Box TreeEdit
  , getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
794
  --, ngramsLocalPatch  :: T.Box NgramsTablePatch
795 796 797 798
  , onCancelRef       :: NgramsActionRef
  , onNgramsClickRef  :: R.Ref (Maybe NgramsClick)
  , onSaveRef         :: NgramsActionRef
  )
799

800 801
ngramsTreeEdit :: R2.Leaf NgramsTreeEditProps
ngramsTreeEdit = R2.leaf ngramsTreeEditCpt
802 803
ngramsTreeEditCpt :: R.Component NgramsTreeEditProps
ngramsTreeEditCpt = here.component "ngramsTreeEdit" cpt where
804
  cpt props@{ box } _ = do
805 806 807
    isEditingFocused <- T.useFocused (_.isEditing) (\a b -> b { isEditing = a }) box
    isEditingFocused' <- T.useLive T.unequal isEditingFocused
    ngramsParentFocused <- T.useFocused (_.ngramsParent) (\a b -> b { ngramsParent = a}) box
808
    ngramsParentFocused' <- T.useLive T.unequal ngramsParentFocused
809

810 811 812
    let
      gutter = B.wad_ [ "mb-2", "d-inline-block" ]

813 814
    pure $ if isEditingFocused'
      then case ngramsParentFocused' of
815
                Nothing -> gutter
816
                Just ngramsParent' -> ngramsTreeEditReal (Record.merge props { ngramsParent' })
817
      else gutter
818

819 820 821
type NgramsTreeEditRealProps =
  ( ngramsParent' :: NgramsTerm
  | NgramsTreeEditProps )
822

823 824
ngramsTreeEditReal :: R2.Leaf NgramsTreeEditRealProps
ngramsTreeEditReal = R2.leaf ngramsTreeEditRealCpt
825
ngramsTreeEditRealCpt :: R.Component NgramsTreeEditRealProps
826
ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where
827 828 829 830 831
  cpt { box
      , getNgramsChildren
      , ngramsParent'
      , onCancelRef
      , onNgramsClickRef
832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913
      , onSaveRef
      } _ = do
    -- | States
    -- |
    { ngramsChildren
    , ngramsChildrenDiff
    } <- T.useLive T.unequal box

    -- | Computed
    -- |
    let
      ngramsDepth = { depth: 0, ngrams: ngramsParent' }

      ngramsChildrenPatched :: Set NgramsTerm
      ngramsChildrenPatched = applyPatchSet (patchSetFromMap ngramsChildrenDiff) $ Set.fromFoldable ngramsChildren
      -- A patched version of getNgramsChildren. This is used
      -- because we're editing the tree and so won't fetch the API
      -- ngrams children.
      gnc ngrams =
        if ngrams == ngramsParent'
        then do
          pure $ A.fromFoldable ngramsChildrenPatched
        else do
          pure []


    -- | Render
    -- |
    pure $

      H.div
      { className: intercalate " "
          [ "ngrams-tree-edit-real"
          , "card"
          ]
      }
      [
        H.div
        { className: "card-header" }
        [
          B.icon
          { name: "pencil-square-o"
          }
        ,
          B.wad_
          [ "mr-1", "d-inline-block" ]
        ,
          B.b_ $ ngramsTermText ngramsDepth.ngrams
        ]
      ,
        H.div
        { className: "card-body" }
        [
          renderNgramsTree
          { getNgramsChildren: gnc
          , ngramsClick
          , ngramsDepth
          , ngramsEdit
          , ngramsStyle: []
          , key: show ngramsParent'
                  <> "-" <> show ngramsChildren
                  <> "-" <> show ngramsChildrenDiff
          }
        ,
          H.div
          { className: "ngrams-tree-edit-real__actions" }
          [
            B.button
            { variant: ButtonVariant Light
            , callback: onCancelClick --(const $ dispatch ClearTreeEdit)}
            , size: SmallSize
            }
            [ H.text "Cancel" ]
          ,
            B.button
            { variant: ButtonVariant Primary
            , callback: onSaveClick --(const $ dispatch AddTermChildren)}
            , size: SmallSize
            }
            [ H.text "Save" ]
          ]
        ]
914
      ]
915 916
      -- | Helpers
      -- |
917 918 919
      where
        --ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
        --ngramsClick _ = Nothing
920
        ngramsClick :: NgramsClick
921 922 923
        ngramsClick nd = case R.readRef onNgramsClickRef of
          Nothing  -> Nothing
          Just ngc -> ngc nd
924
        ngramsEdit :: NgramsClick
925
        ngramsEdit  _ = Nothing
926
        onCancelClick :: Unit -> Effect Unit
927
        onCancelClick _ = case R.readRef onCancelRef of
928
          Nothing -> pure unit
929
          Just onCancel -> onCancel unit
930
        onSaveClick :: Unit -> Effect Unit
931
        onSaveClick _ = case R.readRef onSaveRef of
932
          Nothing -> pure unit
933
          Just onSave -> onSave unit
934

935 936 937 938
type MainNgramsTableCacheProps =
  ( state :: T.Box State
  | MainNgramsTableProps )

939 940
mainNgramsTableCacheOn :: R2.Leaf MainNgramsTableCacheProps
mainNgramsTableCacheOn = R2.leaf mainNgramsTableCacheOnCpt
941
mainNgramsTableCacheOnCpt :: R.Component MainNgramsTableCacheProps
942 943 944 945 946
mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where
  cpt { afterSync
      , boxes
      , defaultListId
      , path
947
      , state
948
      , tabNgramType
949
      , treeEdit
950
      , withAutoUpdate } _ = do
951

952 953 954 955 956 957 958
    -- let path = initialPageParams session nodeId [defaultListId] tabType

    path' <- T.useLive T.unequal path
    let render versioned = mainNgramsTablePaint { afterSync
                                                , boxes
                                                , cacheState: NT.CacheOn
                                                , path
959
                                                , state
960
                                                , tabNgramType
961
                                                , treeEdit
962 963 964 965 966 967 968 969 970
                                                , versioned
                                                , withAutoUpdate } []
    useLoaderWithCacheAPI {
        cacheEndpoint: versionEndpoint { defaultListId, path: path' }
      , errorHandler
      , handleResponse
      , mkRequest
      , path: path'
      , renderer: render
971
      , spinnerClass: Nothing
972
      }
973
  versionEndpoint { defaultListId, path: { nodeId, tabType, session } } _ = get session $ Routes.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId)
974
  errorHandler = logRESTError here "[mainNgramsTableCacheOn]"
975 976 977 978 979 980
  mkRequest :: PageParams -> GUC.Request
  mkRequest path@{ session } = GUC.makeGetRequest session $ url path
    where
      url { listIds
          , nodeId
          , tabType
981
          } = Routes.GetNgramsTableAll { listIds
982 983 984 985
                                  , tabType } (Just nodeId)
  handleResponse :: VersionedNgramsTable -> VersionedNgramsTable
  handleResponse v = v

986 987
mainNgramsTableCacheOff :: R2.Leaf MainNgramsTableCacheProps
mainNgramsTableCacheOff = R2.leaf mainNgramsTableCacheOffCpt
988
mainNgramsTableCacheOffCpt :: R.Component MainNgramsTableCacheProps
989 990 991 992
mainNgramsTableCacheOffCpt = here.component "mainNgramsTableCacheOff" cpt where
  cpt { afterSync
      , boxes
      , path
993
      , state
994
      , tabNgramType
995
      , treeEdit
996 997 998 999 1000
      , withAutoUpdate } _ = do
    let render versionedWithCount = mainNgramsTablePaintNoCache { afterSync
                                                                , boxes
                                                                , cacheState: NT.CacheOff
                                                                , path
1001
                                                                , state
1002
                                                                , tabNgramType
1003
                                                                , treeEdit
1004 1005 1006 1007 1008 1009 1010
                                                                , versionedWithCount
                                                                , withAutoUpdate } []
    useLoaderBox { errorHandler
                 , loader
                 , path
                 , render }

1011
  errorHandler = logRESTError here "[mainNgramsTableCacheOff]"
1012 1013

  -- NOTE With cache off
1014
  loader :: PageParams -> AffRESTError VersionedWithCountNgramsTable
1015 1016 1017 1018 1019 1020 1021 1022 1023
  loader { listIds
         , nodeId
         , params: { limit, offset }
         , searchQuery
         , session
         , tabType
         , termListFilter
         , termSizeFilter
         } =
1024
    get session $ Routes.GetNgrams params (Just nodeId)
1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035
    where
      params = { limit
               , listIds
               , offset: Just offset
               , orderBy: Nothing  -- TODO
               , searchQuery
               , tabType
               , termListFilter
               , termSizeFilter
               }

1036

1037
type MainNgramsTablePaintProps = (
1038 1039
    cacheState        :: NT.CacheState
  , path              :: T.Box PageParams
1040
  , state             :: T.Box State
1041 1042
  , treeEdit          :: Record NgramsTreeEditProps
  , versioned         :: VersionedNgramsTable
1043
  | CommonProps
1044 1045
  )

1046 1047
mainNgramsTablePaint :: R2.Component MainNgramsTablePaintProps
mainNgramsTablePaint = R.createElement mainNgramsTablePaintCpt
1048
mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
James Laver's avatar
James Laver committed
1049
mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
1050
  where
1051
    cpt { afterSync
1052
        , boxes
1053 1054
        , cacheState
        , path
1055
        , state
1056
        , tabNgramType
1057
        , treeEdit
1058 1059
        , versioned
        , withAutoUpdate } _ = do
1060 1061 1062
      R.useEffectOnce' $ do
        let (Versioned { version }) = versioned
        T.modify_ (_ { ngramsVersion = version }) state
1063

1064 1065 1066 1067 1068 1069 1070 1071 1072
      pure $
        loadedNgramsTableBody
        { afterSync
        , boxes
        , cacheState
        , mTotalRows: Nothing
        , path
        , state
        , tabNgramType
1073
        , treeEdit
1074 1075 1076
        , versioned
        , withAutoUpdate
        } []
1077

1078 1079
type MainNgramsTablePaintNoCacheProps = (
    cacheState         :: NT.CacheState
1080
  , path               :: T.Box PageParams
1081
  , state              :: T.Box State
1082
  , treeEdit           :: Record NgramsTreeEditProps
1083
  , versionedWithCount :: VersionedWithCountNgramsTable
1084
  | CommonProps
1085 1086
  )

1087 1088
mainNgramsTablePaintNoCache :: R2.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCache = R.createElement mainNgramsTablePaintNoCacheCpt
1089
mainNgramsTablePaintNoCacheCpt :: R.Component MainNgramsTablePaintNoCacheProps
James Laver's avatar
James Laver committed
1090
mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cpt
1091
  where
1092
    cpt { afterSync
1093
        , boxes
1094 1095
        , cacheState
        , path
1096
        , state
1097
        , tabNgramType
1098
        , treeEdit
1099 1100
        , versionedWithCount
        , withAutoUpdate } _ = do
1101
      -- TODO This is lame, make versionedWithCount a proper box?
1102 1103
      let count /\ versioned = toVersioned versionedWithCount

1104 1105 1106
      R.useEffectOnce' $ do
        let (Versioned { version }) = versioned
        T.modify_ (_ { ngramsVersion = version }) state
1107

1108 1109 1110 1111 1112 1113 1114 1115 1116
      pure $
        loadedNgramsTableBody
        { afterSync
        , boxes
        , cacheState
        , mTotalRows: Just count
        , path
        , state
        , tabNgramType
1117
        , treeEdit
1118 1119
        , versioned
        , withAutoUpdate } []
1120

1121
type NgramsOcc = { occurrences :: Set Int, children :: Set NgramsTerm }
Nicolas Pouillard's avatar
Nicolas Pouillard committed
1122 1123

ngramsElementToNgramsOcc :: NgramsElement -> NgramsOcc
1124
ngramsElementToNgramsOcc (NgramsElement {occurrences, children}) = {occurrences, children}
Nicolas Pouillard's avatar
Nicolas Pouillard committed
1125

1126
sumOccurrences :: NgramsTable -> NgramsOcc -> Set Int
1127
sumOccurrences nt = sumOccChildren mempty
1128
    where
1129
      sumOccTerm :: Set NgramsTerm -> NgramsTerm -> Set Int
1130
      sumOccTerm seen label
1131
        | Set.member label seen = Set.empty -- TODO: Should not happen, emit a warning/error.
1132 1133 1134 1135 1136
        | otherwise =
            sumOccChildren (Set.insert label seen)
                           { occurrences: nt ^. _NgramsTable <<< _ngrams_scores <<< ix label
                           , children:    nt ^. ix label <<< _NgramsRepoElement <<< _children
                           }
1137
      sumOccChildren :: Set NgramsTerm -> NgramsOcc -> Set Int
1138 1139
      sumOccChildren seen {occurrences, children} =
        occurrences <> children ^. folded <<< to (sumOccTerm seen)
1140

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