NgramsTable.purs 39.8 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 DOM.Simple.Console (log)
14
import Data.Array as A
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
import Reactix (useEffect)
61 62
import Reactix as R
import Reactix.DOM.HTML as H
63
import Record as Record
64 65
import Toestand as T
import Unsafe.Coerce (unsafeCoerce)
66

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

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

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

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

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

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

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

126
type PreConversionRows = Seq.Seq NgramsElement
127

128
type TableContainerProps =
129 130 131
  ( addCallback       :: String -> Effect Unit
  , dispatch          :: Dispatch
  , getNgramsChildren :: NgramsTerm -> Aff (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
138
  )
139

140
tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps -> R.Element
141
tableContainer p q = R.createElement (tableContainerCpt p) q []
142
tableContainerCpt :: Record TableContainerProps -> R.Component TT.TableContainerProps
143 144 145
tableContainerCpt { addCallback
                  , dispatch
                  , getNgramsChildren
146 147
                  , ngramsSelection
                  , ngramsTable: ngramsTableCache
148
                  , path
149
                  , queryExactMatches
150
                  , syncResetButton
151
                  , tabNgramType
152 153 154 155 156 157 158
                  } = here.component "tableContainer" cpt where
  cpt props _ = do
    -- | States
    -- |
    { searchQuery
    , termListFilter
    , termSizeFilter
159
    , params
160
    } <- T.useLive T.unequal path
161
    params <- T.useFocused (_.params) (\a b -> b { params = a }) path
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 187 188

    -- | 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"
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 216 217
        }
        [
        --   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"
218
              ]
219 220 221 222 223 224
          }
          [
            R2.select
            { id: "picklistmenu"
            , className: "form-control custom-select"
            , defaultValue: (maybe "" show termListFilter)
225
            , on: {change: changeTermList params}
226 227 228 229 230 231 232 233
            }
            (map optps1 termLists)
          ]
        ,
          H.div
          { className: intercalate " "
              [ "ngrams-table-container__header__item"
              , "card"
234
              ]
235 236 237 238 239 240
          }
          [
            R2.select
            { id: "picktermtype"
            , className: "form-control custom-select"
            , defaultValue: (maybe "" show termSizeFilter)
241
            , on: {change: changeTermSize params}
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 350 351
            }
            (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
352 353 354 355
            ]
          ]
        ]
      ]
356 357 358 359 360 361

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

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

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

370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385
  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" ]
    ]
386

387
-- NEXT
388

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

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

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

411
type LoadedNgramsTableHeaderProps =
412
  ( searchQuery :: T.Box SearchQuery, params :: T.Box Params )
413

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

    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"
435
      ]
436 437 438 439
    ,
      NTS.searchInput
      { key: "search-input"
      , searchQuery
440
      , params
441 442
      }
    ]
443 444 445 446 447

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

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

        performAction = mkDispatch { filteredRows
                                   , path: path'
                                   , state
506
                                   , treeEdit }
507

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

        allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows

528 529
        totalRecords = fromMaybe (Seq.length rows) mTotalRows

530
        afterSync' _ = do
531
          chartsAfterSync path' errors tasks unit
532
          afterSync unit
533

534 535 536
        syncResetButton = syncResetButtons { afterSync: afterSync'
                                           , ngramsLocalPatch
                                           , performAction: performAction <<< CoreAction }
537

538 539 540 541 542 543 544 545 546
        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' }
547
          changePage 1 params
548 549


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

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

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

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

607 608 609 610 611 612 613
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
614

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

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

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


displayRow :: { ngramsElement    :: NgramsElement
              , ngramsParentRoot :: Maybe NgramsTerm
681
              , rootsWithMatches :: Set NgramsTerm
682 683
              , state            :: State
              , termListFilter   :: Maybe TermList
684 685
              , termSizeFilter   :: Maybe TermSize
              , treeEdit         :: TreeEdit } -> Boolean
686 687
displayRow { ngramsElement: NgramsElement {ngrams, root, list}
           , ngramsParentRoot
688
           , state: { ngramsLocalPatch }
689
           , rootsWithMatches
690
           , termListFilter
691 692 693 694
           , termSizeFilter
           , treeEdit: { ngramsChildren
                       , ngramsChildrenDiff
                       , ngramsParent } } =
695 696 697 698 699 700 701 702
    -- 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
703
    -- ^ and which matches the ListType filter.
704
    && ngramsChildrenDiff ^. at ngrams /= Just true
705 706 707 708 709
    -- ^ 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
710 711
    && filterTermSize termSizeFilter ngrams
    -- ^ and which satisfies the chosen term size
712
    || ngramsChildrenDiff ^. at ngrams == Just false
713
    -- ^ unless they are scheduled to be removed.
714
    || tablePatchHasNgrams ngramsLocalPatch ngrams
715
    -- ^ unless they are being processed at the moment.
716

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

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


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

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

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

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

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

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

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

792

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

802 803
ngramsTreeEdit :: R2.Leaf NgramsTreeEditProps
ngramsTreeEdit = R2.leaf ngramsTreeEditCpt
804 805
ngramsTreeEditCpt :: R.Component NgramsTreeEditProps
ngramsTreeEditCpt = here.component "ngramsTreeEdit" cpt where
806
  cpt props@{ box } _ = do
807 808 809
    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
810
    ngramsParentFocused' <- T.useLive T.unequal ngramsParentFocused
811

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

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

821 822 823
type NgramsTreeEditRealProps =
  ( ngramsParent' :: NgramsTerm
  | NgramsTreeEditProps )
824

825 826
ngramsTreeEditReal :: R2.Leaf NgramsTreeEditRealProps
ngramsTreeEditReal = R2.leaf ngramsTreeEditRealCpt
827
ngramsTreeEditRealCpt :: R.Component NgramsTreeEditRealProps
828
ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where
829 830 831 832 833
  cpt { box
      , getNgramsChildren
      , ngramsParent'
      , onCancelRef
      , onNgramsClickRef
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 914 915
      , 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" ]
          ]
        ]
916
      ]
917 918
      -- | Helpers
      -- |
919 920 921
      where
        --ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
        --ngramsClick _ = Nothing
922
        ngramsClick :: NgramsClick
923 924 925
        ngramsClick nd = case R.readRef onNgramsClickRef of
          Nothing  -> Nothing
          Just ngc -> ngc nd
926
        ngramsEdit :: NgramsClick
927
        ngramsEdit  _ = Nothing
928
        onCancelClick :: Unit -> Effect Unit
929
        onCancelClick _ = case R.readRef onCancelRef of
930
          Nothing -> pure unit
931
          Just onCancel -> onCancel unit
932
        onSaveClick :: Unit -> Effect Unit
933
        onSaveClick _ = case R.readRef onSaveRef of
934
          Nothing -> pure unit
935
          Just onSave -> onSave unit
936

937 938 939 940
type MainNgramsTableCacheProps =
  ( state :: T.Box State
  | MainNgramsTableProps )

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

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

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

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

1013
  errorHandler = logRESTError here "[mainNgramsTableCacheOff]"
1014 1015

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

1037

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

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

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

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

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

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

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

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

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

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

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