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

11 12
import Gargantext.Prelude

13
import Data.Array as A
14
import Data.Array as Array
15
import Data.Either (Either(..))
16
import Data.FunctorWithIndex (mapWithIndex)
17
import Data.Lens (to, view, (.~), (^.), (^?))
18
import Data.Lens.At (at)
19
import Data.Lens.Common (_Just)
20
import Data.Lens.Fold (folded)
21
import Data.Lens.Index (ix)
22
import Data.List (List, intercalate)
23
import Data.List as List
24 25
import Data.Map (Map)
import Data.Map as Map
26
import Data.Maybe (Maybe(..), fromMaybe, isNothing, maybe)
27
import Data.Ord.Down (Down(..))
28
import Data.Sequence as Seq
29 30
import Data.Set (Set)
import Data.Set as Set
31
import Data.Tuple (Tuple(..))
32
import Data.Tuple.Nested ((/\))
33
import Effect (Effect)
34
import Effect.Aff (Aff)
arturo's avatar
arturo committed
35
import Gargantext.Components.App.Store (Boxes)
36
import Gargantext.Components.Bootstrap as B
37 38
import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), Sizing(..), Variant(..))
import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
39 40
import Gargantext.Components.NgramsTable.Search as NTS
import Gargantext.Components.NgramsTable.SelectionCheckbox as NTSC
41
import Gargantext.Components.NgramsTable.SyncResetButton (syncResetButtons)
42
import Gargantext.Components.NgramsTable.Tree (renderNgramsItem, renderNgramsTree)
43
import Gargantext.Components.Nodes.Lists.Types as NT
44
import Gargantext.Components.Table (changePage)
45
import Gargantext.Components.Table as TT
46
import Gargantext.Components.Table.Types (Params, orderByToGTOrderBy)
47
import Gargantext.Components.Table.Types as TT
48
import Gargantext.Config.REST (AffRESTError, RESTError, logRESTError)
49 50
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)
51
import Gargantext.Hooks.Loader (useLoaderBox)
52
import Gargantext.Routes (SessionRoute(..)) as Routes
53
import Gargantext.Sessions (Session, get)
54
import Gargantext.Types (CTabNgramType, ListId, NodeID, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
55
import Gargantext.Utils (nbsp, queryExactMatchesLabel, queryMatchesLabel, sortWith, toggleSet, (?))
56
import Gargantext.Utils.CacheAPI as GUC
57
import Gargantext.Utils.Reactix as R2
58
import Gargantext.Utils.Seq as Seq
James Laver's avatar
James Laver committed
59
import Gargantext.Utils.Toestand as T2
60 61
import Reactix as R
import Reactix.DOM.HTML as H
62
import Record as Record
63 64
import Toestand as T
import Unsafe.Coerce (unsafeCoerce)
65

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

69
type TreeEdit =
70 71
  { isEditing          :: Boolean
  , ngramsChildren     :: List NgramsTerm
72 73 74 75 76 77 78 79 80 81
                       -- ^ 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
  }

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

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

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

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

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

125
type PreConversionRows = Seq.Seq NgramsElement
126

127
type TableContainerProps =
128 129
  ( addCallback       :: String -> Effect Unit
  , dispatch          :: Dispatch
130 131
  , getNgramsChildrenAff :: Maybe (NgramsTerm -> Aff (Array NgramsTerm))
  , getNgramsChildren :: Maybe (NgramsTerm -> Array NgramsTerm)
132 133 134
  , ngramsSelection   :: Set NgramsTerm
  , ngramsTable       :: NgramsTable
  , path              :: T.Box PageParams
135
  , queryExactMatches :: Boolean
136 137
  , syncResetButton   :: Array R.Element
  , tabNgramType      :: CTabNgramType
arturo's avatar
arturo committed
138
  , treeEdit          :: Record NgramsTreeEditProps
139
  )
140

141
tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps -> R.Element
142
tableContainer p q = R.createElement (tableContainerCpt p) q []
143
tableContainerCpt :: Record TableContainerProps -> R.Component TT.TableContainerProps
144 145
tableContainerCpt { addCallback
                  , dispatch
146 147
                  , ngramsSelection
                  , ngramsTable: ngramsTableCache
148
                  , path
149
                  , queryExactMatches
150
                  , syncResetButton
151
                  , tabNgramType
arturo's avatar
arturo committed
152
                  , treeEdit
153 154 155 156 157 158 159
                  } = here.component "tableContainer" cpt where
  cpt props _ = do
    -- | States
    -- |
    { searchQuery
    , termListFilter
    , termSizeFilter
160
    , params
161
    } <- T.useLive T.unequal path
162
    params <- T.useFocused (_.params) (\a b -> b { params = a }) path
163 164 165 166 167 168 169 170 171 172 173

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

174 175 176 177 178 179 180 181 182 183 184 185

    -- | Hooks
    -- |

    -- @TODO: add security →prepend portal key/id with an extra id
    filterPortalKey <- pure $ "portal-ngrams-table-filter"
    mFilterHost <- R.unsafeHooksEffect $ R2.getElementById "portal-ngrams-table-filter"

    -- @TODO: add security →prepend portal key/id with an extra id
    subfilterPortalKey <- pure $ "portal-ngrams-table-subfilter"
    mSubFilterHost <- R.unsafeHooksEffect $ R2.getElementById "portal-ngrams-table-subfilter"

186 187 188 189 190
    -- | Render
    -- |
    pure $

      H.div
arturo's avatar
arturo committed
191
      { className: "ngrams-table-container" }
192 193
      [

194 195
        -- Portal filters
        R2.createPortal' mFilterHost
196
        [
197
          R2.fragmentWithKey filterPortalKey
198 199
          [
            B.wad
200
            [ "d-flex", "ml-2", "gap-2" ]
201
            [
202 203 204 205 206 207 208
              R2.select
              { id: "picklistmenu"
              , className: "form-control custom-select"
              , defaultValue: (maybe "" show termListFilter)
              , on: {change: changeTermList params}
              }
              (map optps1 termLists)
209
            ,
210 211 212 213 214 215 216
              R2.select
              { id: "picktermtype"
              , className: "form-control custom-select"
              , defaultValue: (maybe "" show termSizeFilter)
              , on: {change: changeTermSize params}
              }
              (map optps1 termSizes)
217 218
            ]
          ]
219 220 221 222 223 224
        ]
      ,
        -- Portal subfilters
        R2.createPortal' mSubFilterHost
        [
          R2.fragmentWithKey subfilterPortalKey
225
          [
226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259
              R2.when showAddNewTerm $

                H.div
                { className: "ngrams-table-container__add-term" }
                [
                  B.wad
                  []
                  [
                    H.text "adding"
                  ,
                    H.text $ nbsp 1
                  ,
                    B.b_ $ "« " <> searchQuery <> " »"
                  ,
                    H.text $ nbsp 1
                  ,
                    H.text "to"
                  ]
                ,
                  B.button
                  { variant: ButtonVariant Light
                  , callback: const $ addCallback searchQuery
                  , size: SmallSize
                  }
                  [
                    B.icon
                    { name: "circle"
                    , className: "mr-1 graph-term"
                    }
                  ,
                    H.text "Map terms"
                  ]
                ]

260 261 262 263
          ]
        ]
      ,

264 265 266 267 268 269 270 271 272
        H.div
        { className: "ngrams-table-container__navigation" }
        [
          props.pageSizeDescription
        ,
          props.paginationLinks
        ,
          B.wad
          [ "d-flex", "align-items-center" ]
273
          [
274 275 276 277 278
            B.label_ "per page"
          ,
            B.wad_ [ "virtual-space", "w-1" ]
          ,
            props.pageSizeControl
279
          ]
280
        ]
281 282
      ,
        H.div
arturo's avatar
arturo committed
283
        { className: "ngrams-table-container__table-wrapper" }
284 285
        [

286 287
          H.div
          { className: intercalate " "
arturo's avatar
arturo committed
288
              [ "ngrams-table-container__actions"
289
              ]
290
          }
291
          [
arturo's avatar
arturo committed
292 293 294 295
            B.wad
            []
            syncResetButton
          ,
296 297
            B.wad
            []
298
            [
299 300 301
              R2.when (selectionsExist ngramsSelection) $

                selectButtons (selectionsLength ngramsSelection)
302 303 304
            ]
          ]
        ,
305
          H.div
306
          { className: intercalate " "
307
              [ "ngrams-table-container__table"
308 309 310
              ]
          }
          [
311 312
            H.table
            { className: "table able" }
313
            [
314 315 316 317 318 319 320 321 322
              H.thead
              {}
              [
                props.tableHead
              ]
            ,
              H.tbody
              {}
              props.tableBody
323
            ]
arturo's avatar
arturo committed
324 325
          ,
            ngramsTreeEdit (treeEdit)
326 327 328
          ]
        ]
      ]
329 330 331 332 333 334

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

335 336 337 338 339 340 341 342
  changeTermList params e = do
    _ <- setTermListFilter $ read $ R.unsafeEventValue e
    changePage 1 params

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

343 344 345
  selectionsExist :: Set NgramsTerm -> Boolean
  selectionsExist = not <<< Set.isEmpty

346 347 348 349 350 351 352
  selectionsLength :: Set NgramsTerm -> Int
  selectionsLength = Array.length <<< Set.toUnfoldable

  selectButtons :: Int -> R.Element
  selectButtons 0     = mempty
  selectButtons count =
    H.div
arturo's avatar
arturo committed
353
    { className: "ngrams-table-container__selection-cta" }
354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415
    [
      B.wad
      []
      [
        H.text $ show count
      ,
        H.text $ nbsp 1
      ,
        H.text (count > 1 ? "terms" $ "term")
      ,
        H.text $ nbsp 1
      ,
        H.text "selected"
      ]
    ,
      B.buttonGroup
      { collapse: false

      }
      [
        B.button
        { variant: ButtonVariant Light
        , callback: const $ setSelection MapTerm
        , size: SmallSize
        }
        [
          B.icon
          { name: "circle"
          , className: "mr-1 graph-term"
          }
        ,
          H.text "Map"
        ]
      ,
        B.button
        { variant: ButtonVariant Light
        , callback: const $ setSelection CandidateTerm
        , size: SmallSize
        }
        [
          B.icon
          { name: "circle"
          , className: "mr-1 candidate-term"
          }
        ,
          H.text "Candidate"
        ]
      ,
        B.button
        { variant: ButtonVariant Light
        , callback: const $ setSelection StopTerm
        , size: SmallSize
        }
        [
          B.icon
          { name: "circle"
          , className: "mr-1 stop-term"
          }
        ,
          H.text "Stop"
        ]
      ]
416
    ]
417

418
-- NEXT
419

420
type CommonProps =
421 422 423 424
  ( afterSync         :: Unit -> Aff Unit
  , boxes             :: Boxes
  , tabNgramType      :: CTabNgramType
  , withAutoUpdate    :: Boolean -- (?) not used
425 426
  )

427
type PropsNoReload =
428 429 430 431 432 433
  ( cacheState        :: NT.CacheState
  , mTotalRows        :: Maybe Int
  , path              :: T.Box PageParams
  , state             :: T.Box State
  , treeEdit          :: Record NgramsTreeEditProps
  , versioned         :: VersionedNgramsTable
434
  | CommonProps
435 436
  )

437
type Props =
438 439 440 441
  ( reloadForest   :: T2.ReloadS
  , reloadRoot     :: T2.ReloadS
  | PropsNoReload )

442
type LoadedNgramsTableHeaderProps =
443
  ( searchQuery :: T.Box SearchQuery, params :: T.Box Params )
444

445 446
loadedNgramsTableHeader :: R2.Leaf LoadedNgramsTableHeaderProps
loadedNgramsTableHeader = R2.leaf loadedNgramsTableHeaderCpt
447 448
loadedNgramsTableHeaderCpt :: R.Component LoadedNgramsTableHeaderProps
loadedNgramsTableHeaderCpt = here.component "loadedNgramsTableHeader" cpt where
449 450 451 452 453 454
  cpt { searchQuery
      , params
      } _ = do
    -- | Render
    -- |
    pure $
455

456
      R.fragment
457
      [
458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490
        -- 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"
        -- ]
      -- ,

        H.div
        { className: "loaded-ngrams-table-header" }
        [
          H.div
          { className: "loaded-ngrams-table-header__search" }
          [
            NTS.searchInput
            { key: "search-input"
            , searchQuery
            , params
            }
          ]
        ,
          -- @TODO: add security → prepend portal key/id with an extra id
          H.div
          { id: "portal-ngrams-table-filter" } []
        ]
491
      ,
492 493 494
        -- @TODO: add security → prepend portal key/id with an extra id
        H.div
        { id: "portal-ngrams-table-subfilter" } []
495 496 497 498 499 500
      ]

loadedNgramsTableBody :: R2.Component PropsNoReload
loadedNgramsTableBody = R.createElement loadedNgramsTableBodyCpt
loadedNgramsTableBodyCpt :: R.Component PropsNoReload
loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
501
  cpt { afterSync
502 503
      , boxes: { errors
               , tasks }
504 505 506 507 508
      , cacheState
      , mTotalRows
      , path
      , state
      , tabNgramType
509
      , treeEdit: treeEdit@{ getNgramsChildrenAff, getNgramsChildren }
510
      , versioned: Versioned { data: initTable }
511
      } _ = do
512
    treeEdit'@{ ngramsParent } <- T.useLive T.unequal treeEdit.box
513
    state'@{ ngramsLocalPatch, ngramsSelection } <- T.useLive T.unequal state
514
    path'@{ scoreType, termListFilter, termSizeFilter } <- T.useLive T.unequal path
515 516
    params <- T.useFocused (_.params) (\a b -> b { params = a }) path
    params'@{ orderBy } <- T.useLive T.unequal params
517 518
    searchQueryFocused <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path
    searchQuery <- T.useLive T.unequal searchQueryFocused
519
    isEditing <- T.useFocused (_.isEditing) (\a b -> b { isEditing = a}) treeEdit.box
520

521 522
    let ngramsTable = applyNgramsPatches state' initTable
        rowMap (Tuple ng nre) =
523
          let ng_scores :: Map NgramsTerm (Set Int)
524
              ng_scores = ngramsTable ^. _NgramsTable <<< _ngrams_scores
525
              s = ng_scores ^. at ng <<< _Just
526
              addOcc ne =
527
                let occurrences = sumOccurrences ngramsTable (ngramsElementToNgramsOcc ne) in
528 529 530 531
                ne # _NgramsElement <<< _occurrences .~ occurrences
          in
          addOcc <$> rowsFilter (ngramsRepoElementToNgramsElement ng s nre)
        rows :: PreConversionRows
532 533 534 535 536 537 538
        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)
539 540 541 542
        exactMatches :: Boolean
        exactMatches = not $ Seq.null $ Seq.filter fltr nres
          where
            fltr (Tuple ng _) = queryExactMatchesLabel searchQuery (ngramsTermText ng)
543
        rowsFilter :: NgramsElement -> Maybe NgramsElement
544 545 546
        rowsFilter ngramsElement =
          if displayRow { ngramsElement
                        , ngramsParentRoot
547
                        , rootsWithMatches
548 549
                        , state: state'
                        , termListFilter
550 551
                        , termSizeFilter
                        , treeEdit: treeEdit' } then
552 553 554 555 556 557 558
            Just ngramsElement
          else
            Nothing

        performAction = mkDispatch { filteredRows
                                   , path: path'
                                   , state
559
                                   , treeEdit }
560

561 562 563 564 565 566 567
        -- 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 =
568
          { row: renderNgramsItem { dispatch: performAction
569
                                  , getNgramsChildrenAff
570
                                  , getNgramsChildren
571
                                  , isEditing
572 573 574 575 576
                                  , ngrams: ngramsElement ^. _NgramsElement <<< _ngrams
                                  , ngramsElement
                                  , ngramsLocalPatch
                                  , ngramsSelection
                                  , ngramsTable } []
577 578 579 580 581
          , delete: false
          }

        allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows

582 583
        totalRecords = fromMaybe (Seq.length rows) mTotalRows

584
        afterSync' _ = do
585
          chartsAfterSync path' errors tasks unit
586
          afterSync unit
587

588 589 590
        syncResetButton = syncResetButtons { afterSync: afterSync'
                                           , ngramsLocalPatch
                                           , performAction: performAction <<< CoreAction }
591

592 593 594 595 596 597 598 599 600
        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' }
601
          changePage 1 params
602 603


604
        -- autoUpdate :: Array R.Element
605 606 607 608 609 610 611 612
--         autoUpdate = if withAutoUpdate then
--                        [ R2.buff
--                        $ autoUpdateElt
--                          { duration: 5000
--                          , effect: performAction $ CoreAction $ Synchronize { afterSync: afterSync' }
--                          }
--                        ]
--                      else []
613

614 615 616 617 618 619 620 621
        ngramsParentRoot :: Maybe NgramsTerm
        ngramsParentRoot =
          (\np -> ngramsTable ^? at np
                            <<< _Just
                            <<< _NgramsRepoElement
                            <<< _root
                            <<< _Just
            ) =<< ngramsParent
622

623 624 625
    R.useEffect' $ do
      R.setRef treeEdit.onCancelRef $ Just $ const $ performAction ClearTreeEdit
      R.setRef treeEdit.onSaveRef $ Just $ const $ performAction AddTermChildren
626
      let ngramsClick { depth: 1, ngrams: child } = Just $ performAction $ ToggleChild  false child
627 628 629
          ngramsClick  _ = Nothing
      R.setRef treeEdit.onNgramsClickRef $ Just ngramsClick

630 631 632 633 634 635 636
    pure $

      TT.table
      { colNames
      , container: tableContainer
        { addCallback
        , dispatch: performAction
637
        , getNgramsChildrenAff
638 639 640 641 642 643 644
        , getNgramsChildren
        , ngramsSelection
        , ngramsTable
        , path
        , queryExactMatches: exactMatches
        , syncResetButton: [ syncResetButton ]
        , tabNgramType
arturo's avatar
arturo committed
645
        , treeEdit
646 647 648 649 650 651 652 653
        }
      , params
      , rows: filteredConvertedRows
      , syncResetButton: [ syncResetButton ]
      , totalRecords
      , wrapColElts:
          wrapColElts
          { allNgramsSelected
654
          , dispatch: performAction
655
          , ngramsSelection
656
          }
657 658
          scoreType
      }
659
      where
arturo's avatar
arturo committed
660
        colNames = TT.ColumnName <$> [ "Select", "Score", "Terms"] -- see convOrderBy
661

662 663 664
ngramsTableOrderWith :: Maybe (TT.OrderByDirection TT.ColumnName)
                     -> Seq.Seq NgramsElement
                     -> Seq.Seq NgramsElement
665 666
ngramsTableOrderWith orderBy =
  case convOrderBy <$> orderBy of
667 668
    Just ScoreAsc  -> sortWith \x -> x        ^. _NgramsElement <<< _occurrences <<< to Set.size
    Just ScoreDesc -> sortWith \x -> Down $ x ^. _NgramsElement <<< _occurrences <<< to Set.size
669 670 671
    Just TermAsc   -> sortWith \x -> x        ^. _NgramsElement <<< _ngrams
    Just TermDesc  -> sortWith \x -> Down $ x ^. _NgramsElement <<< _ngrams
    _              -> identity -- the server ordering is enough here
672

673
-- This is used to *decorate* the Select header with the checkbox.
674
wrapColElts scProps _         (TT.ColumnName "Select") = const [NTSC.selectionCheckbox scProps]
675 676
wrapColElts _       scoreType (TT.ColumnName "Score")  = (_ <> [H.text ("(" <> show scoreType <> ")")])
wrapColElts _       _         _                        = identity
677

678 679
type MkDispatchProps =
  ( filteredRows :: PreConversionRows
680
  , path         :: PageParams
681
  , state        :: T.Box State
682
  , treeEdit     :: Record NgramsTreeEditProps
683 684 685 686 687
  )

mkDispatch :: Record MkDispatchProps -> (Action -> Effect Unit)
mkDispatch { filteredRows
           , path
688
           , state
689
           , treeEdit } = performAction
690 691
  where
    performAction :: Action -> Effect Unit
692 693
    performAction ClearTreeEdit = do
      T.write_ initialTreeEdit treeEdit.box
694
    performAction (SetParentResetChildren ngramsParent ngramsChildren) = do
695 696
      T.write_ { isEditing: true
               , ngramsChildren
697
               , ngramsChildrenDiff: Map.empty
698 699 700
               , ngramsParent } treeEdit.box
    performAction (ToggleChild b c) = do
      T.modify_ (\g@{ ngramsChildrenDiff: ncd } -> g { ngramsChildrenDiff = newNC ncd }) treeEdit.box
701
      where
702
        newNC ncd = Map.alter (maybe (Just b) (const Nothing)) c ncd
703
    performAction (ToggleSelect c) =
704
      T.modify_ (\s@{ ngramsSelection: ns } -> s { ngramsSelection = toggleSet c ns }) state
705 706 707
    performAction ToggleSelectAll = do
      { ngramsSelection } <- T.read state
      T.modify_ (toggler ngramsSelection) state
708
      where
709 710
        toggler ngramsSelection s =
          if allNgramsSelectedOnFirstPage ngramsSelection filteredRows then
711 712 713
            s { ngramsSelection = Set.empty :: Set NgramsTerm }
          else
            s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
714
    performAction AddTermChildren = do
715
      { ngramsChildren, ngramsChildrenDiff, ngramsParent } <- T.read treeEdit.box
716 717 718 719 720
      case ngramsParent of
        Nothing ->
          -- impossible but harmless
          pure unit
        Just parent -> do
721
          let pc = patchSetFromMap ngramsChildrenDiff
722 723
              pe = NgramsPatch { patch_list: mempty, patch_children: pc }
              pt = singletonNgramsTablePatch parent pe
724 725 726 727 728 729 730 731 732
          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
733
          commitPatch (pt {-<> ppt-}) state
734 735 736 737 738
    performAction (CoreAction a) = coreDispatch path state a


displayRow :: { ngramsElement    :: NgramsElement
              , ngramsParentRoot :: Maybe NgramsTerm
739
              , rootsWithMatches :: Set NgramsTerm
740 741
              , state            :: State
              , termListFilter   :: Maybe TermList
742 743
              , termSizeFilter   :: Maybe TermSize
              , treeEdit         :: TreeEdit } -> Boolean
744 745
displayRow { ngramsElement: NgramsElement {ngrams, root, list}
           , ngramsParentRoot
746
           , state: { ngramsLocalPatch }
747
           , rootsWithMatches
748
           , termListFilter
749 750 751 752
           , termSizeFilter
           , treeEdit: { ngramsChildren
                       , ngramsChildrenDiff
                       , ngramsParent } } =
753 754 755 756 757 758 759 760
    -- 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
761
    -- ^ and which matches the ListType filter.
762
    && ngramsChildrenDiff ^. at ngrams /= Just true
763 764 765 766 767
    -- ^ 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
768 769
    && filterTermSize termSizeFilter ngrams
    -- ^ and which satisfies the chosen term size
770
    || ngramsChildrenDiff ^. at ngrams == Just false
771
    -- ^ unless they are scheduled to be removed.
772
    || tablePatchHasNgrams ngramsLocalPatch ngrams
773
    -- ^ unless they are being processed at the moment.
774

775 776 777 778
allNgramsSelectedOnFirstPage :: Set NgramsTerm -> PreConversionRows -> Boolean
allNgramsSelectedOnFirstPage selected rows = selected == (selectNgramsOnFirstPage rows)

selectNgramsOnFirstPage :: PreConversionRows -> Set NgramsTerm
779
selectNgramsOnFirstPage rows = Set.fromFoldable $ (view $ _NgramsElement <<< _ngrams) <$> rows
780 781


782
type MainNgramsTableProps = (
783 784
    cacheState    :: T.Box NT.CacheState
  , defaultListId :: Int
785
    -- ^ This node can be a corpus or contact.
786 787 788
  , path          :: T.Box PageParams
  , session       :: Session
  , tabType       :: TabType
789
  , treeEdit      :: Record NgramsTreeEditProps
790
  | CommonProps
791
  )
792

793 794
getNgramsChildrenAffRequest :: Session -> NodeID -> Array ListId -> TabType -> NgramsTerm -> Aff (Array NgramsTerm)
getNgramsChildrenAffRequest session nodeId listIds tabType (NormNgramsTerm ngrams) = do
795
  res :: Either RESTError ({ data :: Array { children :: Array String, ngrams :: String }}) <- get session $ Routes.GetNgrams params (Just nodeId)
796 797
  case res of
    Left err -> pure []
798 799 800
    Right { data: lst } -> case A.uncons (A.filter (\d -> d.ngrams == ngrams) lst) of
      Nothing -> pure []
      Just { head } -> pure $ NormNgramsTerm <$> head.children
801 802
  where
    params = { limit: 10
803
             , listIds
804 805
             , offset: Nothing
             , orderBy: Nothing
806
             , searchQuery: ngrams
807 808 809 810
             , tabType
             , termListFilter: Nothing
             , termSizeFilter: Nothing }

811 812
mainNgramsTable :: R2.Component MainNgramsTableProps
mainNgramsTable = R.createElement mainNgramsTableCpt
813
mainNgramsTableCpt :: R.Component MainNgramsTableProps
James Laver's avatar
James Laver committed
814
mainNgramsTableCpt = here.component "mainNgramsTable" cpt
815
  where
816
    cpt props@{ cacheState, path } _ = do
817
      searchQuery <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path
818
      params <- T.useFocused (_.params) (\a b -> b { params = a }) path
819
      cacheState' <- T.useLive T.unequal cacheState
820 821 822
      -- onCancelRef <- R.useRef Nothing
      -- onNgramsClickRef <- R.useRef Nothing
      -- onSaveRef   <- R.useRef Nothing
823
      state <- T.useBox initialState
824
      -- ngramsLocalPatch <- T.useFocused (_.ngramsLocalPatch) (\a b -> b { ngramsLocalPatch = a }) state
825

826 827
      -- nodeId <- T.useFocused (_.nodeId) (\a b -> b { nodeId = a }) path
      -- nodeId' <- T.useLive T.unequal nodeId
828 829 830 831 832

      -- let treeEdit = { box: treeEditBox
      --                , getNgramsChildren: getNgramsChildrenAff session nodeId' tabType
      --                , onCancelRef
      --                , onNgramsClickRef
833
      --                , onSaveRef
834
      --                }
835 836

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

838
      case cacheState' of
839
        NT.CacheOn  -> pure $ R.fragment
840
          [ loadedNgramsTableHeader { searchQuery, params }
841
          , mainNgramsTableCacheOn (Record.merge props { state })
842 843
          ]
        NT.CacheOff -> pure $ R.fragment
844
          [loadedNgramsTableHeader { searchQuery, params}
845
          , mainNgramsTableCacheOff (Record.merge props { state })
846 847
          ]

848

849
type NgramsTreeEditProps =
850 851 852
  ( box                   :: T.Box TreeEdit
  , getNgramsChildrenAff  :: Maybe (NgramsTerm -> Aff (Array NgramsTerm))
  , getNgramsChildren  :: Maybe (NgramsTerm -> Array NgramsTerm)
853
  --, ngramsLocalPatch  :: T.Box NgramsTablePatch
854 855 856
  , onCancelRef           :: NgramsActionRef
  , onNgramsClickRef      :: R.Ref (Maybe NgramsClick)
  , onSaveRef             :: NgramsActionRef
857
  )
858

859 860
ngramsTreeEdit :: R2.Leaf NgramsTreeEditProps
ngramsTreeEdit = R2.leaf ngramsTreeEditCpt
861 862
ngramsTreeEditCpt :: R.Component NgramsTreeEditProps
ngramsTreeEditCpt = here.component "ngramsTreeEdit" cpt where
863
  cpt props@{ box } _ = do
864 865 866
    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
867
    ngramsParentFocused' <- T.useLive T.unequal ngramsParentFocused
868

869

arturo's avatar
arturo committed
870 871
    pure $
      if isEditingFocused'
872
      then case ngramsParentFocused' of
arturo's avatar
arturo committed
873
                Nothing -> mempty
874
                Just ngramsParent' -> ngramsTreeEditReal (Record.merge props { ngramsParent' })
arturo's avatar
arturo committed
875
      else mempty
876

877 878 879
type NgramsTreeEditRealProps =
  ( ngramsParent' :: NgramsTerm
  | NgramsTreeEditProps )
880

881 882
ngramsTreeEditReal :: R2.Leaf NgramsTreeEditRealProps
ngramsTreeEditReal = R2.leaf ngramsTreeEditRealCpt
883
ngramsTreeEditRealCpt :: R.Component NgramsTreeEditRealProps
884
ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where
885
  cpt { box
886
      , getNgramsChildrenAff
887 888 889 890
      , getNgramsChildren
      , ngramsParent'
      , onCancelRef
      , onNgramsClickRef
891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944
      , 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
945 946
          { getNgramsChildrenAff: Just gnc
          , getNgramsChildren: Nothing
947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973
          , 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" ]
          ]
        ]
974
      ]
975 976
      -- | Helpers
      -- |
977 978 979
      where
        --ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
        --ngramsClick _ = Nothing
980
        ngramsClick :: NgramsClick
981 982 983
        ngramsClick nd = case R.readRef onNgramsClickRef of
          Nothing  -> Nothing
          Just ngc -> ngc nd
984
        ngramsEdit :: NgramsClick
985
        ngramsEdit  _ = Nothing
986
        onCancelClick :: Unit -> Effect Unit
987
        onCancelClick _ = case R.readRef onCancelRef of
988
          Nothing -> pure unit
989
          Just onCancel -> onCancel unit
990
        onSaveClick :: Unit -> Effect Unit
991
        onSaveClick _ = case R.readRef onSaveRef of
992
          Nothing -> pure unit
993
          Just onSave -> onSave unit
994

995 996 997 998
type MainNgramsTableCacheProps =
  ( state :: T.Box State
  | MainNgramsTableProps )

999 1000
mainNgramsTableCacheOn :: R2.Leaf MainNgramsTableCacheProps
mainNgramsTableCacheOn = R2.leaf mainNgramsTableCacheOnCpt
1001
mainNgramsTableCacheOnCpt :: R.Component MainNgramsTableCacheProps
1002 1003 1004 1005 1006
mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where
  cpt { afterSync
      , boxes
      , defaultListId
      , path
1007
      , state
1008
      , tabNgramType
1009
      , treeEdit
1010
      , withAutoUpdate } _ = do
1011

1012 1013 1014 1015 1016 1017 1018
    -- let path = initialPageParams session nodeId [defaultListId] tabType

    path' <- T.useLive T.unequal path
    let render versioned = mainNgramsTablePaint { afterSync
                                                , boxes
                                                , cacheState: NT.CacheOn
                                                , path
1019
                                                , state
1020
                                                , tabNgramType
1021
                                                , treeEdit
1022 1023 1024 1025 1026 1027 1028 1029 1030
                                                , versioned
                                                , withAutoUpdate } []
    useLoaderWithCacheAPI {
        cacheEndpoint: versionEndpoint { defaultListId, path: path' }
      , errorHandler
      , handleResponse
      , mkRequest
      , path: path'
      , renderer: render
1031
      , spinnerClass: Nothing
1032
      }
1033
  versionEndpoint { defaultListId, path: { nodeId, tabType, session } } _ = get session $ Routes.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId)
1034
  errorHandler = logRESTError here "[mainNgramsTableCacheOn]"
1035 1036 1037 1038 1039 1040
  mkRequest :: PageParams -> GUC.Request
  mkRequest path@{ session } = GUC.makeGetRequest session $ url path
    where
      url { listIds
          , nodeId
          , tabType
1041
          } = Routes.GetNgramsTableAll { listIds
1042 1043 1044 1045
                                  , tabType } (Just nodeId)
  handleResponse :: VersionedNgramsTable -> VersionedNgramsTable
  handleResponse v = v

1046 1047
mainNgramsTableCacheOff :: R2.Leaf MainNgramsTableCacheProps
mainNgramsTableCacheOff = R2.leaf mainNgramsTableCacheOffCpt
1048
mainNgramsTableCacheOffCpt :: R.Component MainNgramsTableCacheProps
1049 1050 1051 1052
mainNgramsTableCacheOffCpt = here.component "mainNgramsTableCacheOff" cpt where
  cpt { afterSync
      , boxes
      , path
1053
      , state
1054
      , tabNgramType
1055
      , treeEdit
1056 1057 1058 1059 1060
      , withAutoUpdate } _ = do
    let render versionedWithCount = mainNgramsTablePaintNoCache { afterSync
                                                                , boxes
                                                                , cacheState: NT.CacheOff
                                                                , path
1061
                                                                , state
1062
                                                                , tabNgramType
1063
                                                                , treeEdit
1064 1065 1066 1067 1068 1069 1070
                                                                , versionedWithCount
                                                                , withAutoUpdate } []
    useLoaderBox { errorHandler
                 , loader
                 , path
                 , render }

1071
  errorHandler = logRESTError here "[mainNgramsTableCacheOff]"
1072 1073

  -- NOTE With cache off
1074
  loader :: PageParams -> AffRESTError VersionedWithCountNgramsTable
1075 1076
  loader { listIds
         , nodeId
1077
         , params: { limit, offset, orderBy }
1078 1079 1080 1081 1082
         , searchQuery
         , session
         , tabType
         , termListFilter
         , termSizeFilter
1083
         } = get session $ Routes.GetNgrams params (Just nodeId)
1084 1085 1086 1087
    where
      params = { limit
               , listIds
               , offset: Just offset
1088
               , orderBy: orderByToGTOrderBy orderBy
1089 1090 1091 1092 1093 1094
               , searchQuery
               , tabType
               , termListFilter
               , termSizeFilter
               }

1095

1096
type MainNgramsTablePaintProps = (
1097 1098
    cacheState        :: NT.CacheState
  , path              :: T.Box PageParams
1099
  , state             :: T.Box State
1100 1101
  , treeEdit          :: Record NgramsTreeEditProps
  , versioned         :: VersionedNgramsTable
1102
  | CommonProps
1103 1104
  )

1105 1106
mainNgramsTablePaint :: R2.Component MainNgramsTablePaintProps
mainNgramsTablePaint = R.createElement mainNgramsTablePaintCpt
1107
mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
James Laver's avatar
James Laver committed
1108
mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
1109
  where
1110
    cpt { afterSync
1111
        , boxes
1112 1113
        , cacheState
        , path
1114
        , state
1115
        , tabNgramType
1116
        , treeEdit
1117 1118
        , versioned
        , withAutoUpdate } _ = do
1119 1120 1121
      R.useEffectOnce' $ do
        let (Versioned { version }) = versioned
        T.modify_ (_ { ngramsVersion = version }) state
1122

1123 1124 1125 1126 1127 1128 1129 1130 1131
      pure $
        loadedNgramsTableBody
        { afterSync
        , boxes
        , cacheState
        , mTotalRows: Nothing
        , path
        , state
        , tabNgramType
1132
        , treeEdit
1133 1134 1135
        , versioned
        , withAutoUpdate
        } []
1136

1137 1138
type MainNgramsTablePaintNoCacheProps = (
    cacheState         :: NT.CacheState
1139
  , path               :: T.Box PageParams
1140
  , state              :: T.Box State
1141
  , treeEdit           :: Record NgramsTreeEditProps
1142
  , versionedWithCount :: VersionedWithCountNgramsTable
1143
  | CommonProps
1144 1145
  )

1146 1147
mainNgramsTablePaintNoCache :: R2.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCache = R.createElement mainNgramsTablePaintNoCacheCpt
1148
mainNgramsTablePaintNoCacheCpt :: R.Component MainNgramsTablePaintNoCacheProps
James Laver's avatar
James Laver committed
1149
mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cpt
1150
  where
1151
    cpt { afterSync
1152
        , boxes
1153 1154
        , cacheState
        , path
1155
        , state
1156
        , tabNgramType
1157
        , treeEdit
1158 1159
        , versionedWithCount
        , withAutoUpdate } _ = do
1160
      -- TODO This is lame, make versionedWithCount a proper box?
1161 1162
      let count /\ versioned = toVersioned versionedWithCount

1163 1164 1165
      R.useEffectOnce' $ do
        let (Versioned { version }) = versioned
        T.modify_ (_ { ngramsVersion = version }) state
1166

1167 1168 1169 1170 1171 1172 1173 1174 1175
      pure $
        loadedNgramsTableBody
        { afterSync
        , boxes
        , cacheState
        , mTotalRows: Just count
        , path
        , state
        , tabNgramType
1176
        , treeEdit
1177 1178
        , versioned
        , withAutoUpdate } []
1179

1180
type NgramsOcc = { occurrences :: Set Int, children :: Set NgramsTerm }
Nicolas Pouillard's avatar
Nicolas Pouillard committed
1181 1182

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

1185
sumOccurrences :: NgramsTable -> NgramsOcc -> Set Int
1186
sumOccurrences nt = sumOccChildren mempty
1187
    where
1188
      sumOccTerm :: Set NgramsTerm -> NgramsTerm -> Set Int
1189
      sumOccTerm seen label
1190
        | Set.member label seen = Set.empty -- TODO: Should not happen, emit a warning/error.
1191 1192 1193 1194 1195
        | otherwise =
            sumOccChildren (Set.insert label seen)
                           { occurrences: nt ^. _NgramsTable <<< _ngrams_scores <<< ix label
                           , children:    nt ^. ix label <<< _NgramsRepoElement <<< _children
                           }
1196
      sumOccChildren :: Set NgramsTerm -> NgramsOcc -> Set Int
1197 1198
      sumOccChildren seen {occurrences, children} =
        occurrences <> children ^. folded <<< to (sumOccTerm seen)
1199

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