[toestand] ngramsTable: state is a box now

src/Gargantext/Components/NgramsTable.purs

@@ -271,7 +271,7 @@ type Props =
   ( cacheState :: NT.CacheState
   , mTotalRows :: Maybe Int
   , path       :: T.Box PageParams
-  , state      :: R.State State
+  , state      :: T.Box State
   , versioned  :: VersionedNgramsTable
   | CommonProps
   )
@@ -288,15 +288,12 @@ loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where
             , reloadForest
             , reloadRoot
             , sidePanelTriggers
-            , state: (state@{ ngramsChildren
-                            , ngramsLocalPatch
-                            , ngramsParent
-                            , ngramsSelection
-                            , ngramsVersion } /\ setState)
+            , state
             , tabNgramType
             , tasks
             , versioned: Versioned { data: initTable }
             , withAutoUpdate } _ = do
+    state'@{ ngramsChildren, ngramsLocalPatch, ngramsParent, ngramsSelection, ngramsVersion } <- T.useLive T.unequal state
     path'@{ listIds, params, scoreType, termListFilter, termSizeFilter } <- T.useLive T.unequal path
     params <- T.useFocused (_.params) (\a b -> b { params = a }) path
     params'@{ orderBy } <- T.useLive T.unequal params
@@ -306,26 +303,40 @@ loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where
     -- R.useEffectOnce' $ do
     --   T.listen (\_ -> TT.changePage 1 params) searchQuery
 
-    let rows :: PreConversionRows
-        rows = orderWith (
-                 Seq.mapMaybe (\(Tuple ng nre) ->
-                                let Additive s = ng_scores ^. at ng <<< _Just in
-                                addOcc <$> rowsFilter (ngramsRepoElementToNgramsElement ng s nre)) $
+    let ngramsTable = applyNgramsPatches state' initTable
+        roots = rootsOf ngramsTable
+
+        rowMap (Tuple ng nre) =
+          let ng_scores :: Map NgramsTerm (Additive Int)
+              ng_scores = ngramsTable ^. _NgramsTable <<< _ngrams_scores
+              Additive s = ng_scores ^. at ng <<< _Just
+              addOcc ne =
+                let Additive occurrences = sumOccurrences ngramsTable (ngramsElementToNgramsOcc ne) in
+                ne # _NgramsElement <<< _occurrences .~ occurrences
+          in
+          addOcc <$> rowsFilter (ngramsRepoElementToNgramsElement ng s nre)
+        rows :: PreConversionRows
+        rows = ngramsTableOrderWith orderBy (
+                 Seq.mapMaybe rowMap $
                    Map.toUnfoldable (ngramsTable ^. _NgramsTable <<< _ngrams_repo_elements)
                )
         rowsFilter :: NgramsElement -> Maybe NgramsElement
-        rowsFilter ne =
-           if displayRow state searchQuery' ngramsTable ngramsParentRoot termListFilter termSizeFilter ne then
-             Just ne
-           else
-             Nothing
-        orderWith =
-          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
+        rowsFilter ngramsElement =
+          if displayRow { ngramsElement
+                        , ngramsParentRoot
+                        , ngramsTable
+                        , searchQuery: searchQuery'
+                        , state: state'
+                        , termListFilter
+                        , termSizeFilter } then
+            Just ngramsElement
+          else
+            Nothing
+
+        performAction = mkDispatch { filteredRows
+                                   , path: path'
+                                   , state
+                                   , state' }
 
         -- filteredRows :: PreConversionRows
         -- no need to filter offset if cache is off
@@ -349,28 +360,32 @@ loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where
 
         totalRecords = fromMaybe (Seq.length rows) mTotalRows
 
-        performAction = mkDispatch { filteredRows
-                                   , path: path'
-                                   , state: state /\ setState }
+        afterSync' _ = do
+          chartsAfterSync path' tasks reloadForest unit
+          afterSync unit
 
-        syncResetButton path' = syncResetButtons { afterSync: afterSync' path'
-                                                 , ngramsLocalPatch
-                                                 , performAction: performAction <<< CoreAction }
+        syncResetButton = syncResetButtons { afterSync: afterSync'
+                                           , ngramsLocalPatch
+                                           , performAction: performAction <<< CoreAction }
 
         -- autoUpdate :: Array R.Element
         autoUpdate path' = if withAutoUpdate then
                        [ R2.buff
                        $ autoUpdateElt
                          { duration: 5000
-                         , effect: performAction $ CoreAction $ Synchronize { afterSync: afterSync' path' }
+                         , effect: performAction $ CoreAction $ Synchronize { afterSync: afterSync' }
                          }
                        ]
                      else []
 
-        -- This is used to *decorate* the Select header with the checkbox.
-        wrapColElts scProps (TT.ColumnName "Select") = const [NTC.selectionCheckbox scProps]
-        wrapColElts _       (TT.ColumnName "Score")  = (_ <> [H.text ("(" <> show scoreType <> ")")])
-        wrapColElts _       _                       = identity
+        ngramsParentRoot :: Maybe NgramsTerm
+        ngramsParentRoot =
+          (\np -> ngramsTable ^? at np
+                            <<< _Just
+                            <<< _NgramsRepoElement
+                            <<< _root
+                            <<< _Just
+            ) =<< ngramsParent
 
     pure $ R.fragment $
       autoUpdate path' <>
@@ -388,58 +403,49 @@ loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where
               , ngramsSelection
               , ngramsTable
               , path
-              , syncResetButton: [ syncResetButton path' ]
+              , syncResetButton: [ syncResetButton ]
               , tabNgramType }
           , params
           , rows: filteredConvertedRows
-          , syncResetButton: [ syncResetButton path' ]
+          , syncResetButton: [ syncResetButton ]
           , totalRecords
           , wrapColElts:
-            wrapColElts { allNgramsSelected, dispatch: performAction, ngramsSelection }
+            wrapColElts { allNgramsSelected, dispatch: performAction, ngramsSelection } scoreType
           }
-      , syncResetButton path'
+      , syncResetButton
       ]
-
       where
-        afterSync' path' _ = do
-          chartsAfterSync path' tasks reloadForest unit
-          afterSync unit
-
-
-        ng_scores :: Map NgramsTerm (Additive Int)
-        ng_scores = ngramsTable ^. _NgramsTable <<< _ngrams_scores
-        addOcc ngramsElement =
-          let Additive occurrences = sumOccurrences ngramsTable (ngramsElementToNgramsOcc ngramsElement) in
-          ngramsElement # _NgramsElement <<< _occurrences .~ occurrences
-
-        ngramsTable = applyNgramsPatches state initTable
-        roots = rootsOf ngramsTable
-        ngramsParentRoot :: Maybe NgramsTerm
-        ngramsParentRoot =
-          (\np -> ngramsTable ^? at np
-                            <<< _Just
-                            <<< _NgramsRepoElement
-                            <<< _root
-                            <<< _Just
-            ) =<< ngramsParent
+        colNames = TT.ColumnName <$> ["Show", "Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy
 
+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
 
-        colNames = TT.ColumnName <$> ["Show", "Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy
+-- This is used to *decorate* the Select header with the checkbox.
+wrapColElts scProps _         (TT.ColumnName "Select") = const [NTC.selectionCheckbox scProps]
+wrapColElts _       scoreType (TT.ColumnName "Score")  = (_ <> [H.text ("(" <> show scoreType <> ")")])
+wrapColElts _       _         _                        = identity
 
 type MkDispatchProps = (
     filteredRows :: PreConversionRows
   , path         :: PageParams
-  , state :: R.State State
+  , state        :: T.Box State
+  , state'       :: State
   )
 
 mkDispatch :: Record MkDispatchProps -> (Action -> Effect Unit)
 mkDispatch { filteredRows
            , path
-           , state: (state@{ ngramsChildren
-                           , ngramsLocalPatch
-                           , ngramsParent
-                           , ngramsSelection
-                           , ngramsVersion } /\ setState) } = performAction
+           , state
+           , state': state'@{ ngramsChildren
+                            , ngramsLocalPatch
+                            , ngramsParent
+                            , ngramsSelection
+                            , ngramsVersion } } = performAction
   where
     allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows
 
@@ -448,15 +454,15 @@ mkDispatch { filteredRows
 
     performAction :: Action -> Effect Unit
     performAction (SetParentResetChildren p) =
-      setState $ setParentResetChildren p
+      T.modify_ (setParentResetChildren p) state
     performAction (ToggleChild b c) =
-      setState $ \s@{ ngramsChildren: nc } -> s { ngramsChildren = newNC nc }
+      T.modify_ (\s@{ ngramsChildren: nc } -> s { ngramsChildren = newNC nc }) state
       where
         newNC nc = Map.alter (maybe (Just b) (const Nothing)) c nc
     performAction (ToggleSelect c) =
-      setState $ \s@{ ngramsSelection: ns } -> s { ngramsSelection = toggleSet c ns }
+      T.modify_ (\s@{ ngramsSelection: ns } -> s { ngramsSelection = toggleSet c ns }) state
     performAction ToggleSelectAll =
-      setState toggler
+      T.modify_ toggler state
       where
         toggler s =
           if allNgramsSelected then
@@ -472,21 +478,27 @@ mkDispatch { filteredRows
           let pc = patchSetFromMap ngramsChildren
               pe = NgramsPatch { patch_list: mempty, patch_children: pc }
               pt = singletonNgramsTablePatch parent pe
-          setState $ setParentResetChildren Nothing
-          commitPatch (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
-    performAction (CoreAction a) = coreDispatch path (state /\ setState) a
-
-
-displayRow :: State -> SearchQuery -> NgramsTable -> Maybe NgramsTerm -> Maybe TermList -> Maybe TermSize -> NgramsElement -> Boolean
-displayRow state@{ ngramsChildren
-                 , ngramsLocalPatch
-                 , ngramsParent }
-           searchQuery
-           ngramsTable
-           ngramsParentRoot
-           termListFilter
-           termSizeFilter
-           (NgramsElement {ngrams, root, list}) =
+          T.modify_ (setParentResetChildren Nothing) state
+          commitPatch pt state
+    performAction (CoreAction a) = coreDispatch path state a
+
+
+displayRow :: { ngramsElement    :: NgramsElement
+              , ngramsParentRoot :: Maybe NgramsTerm
+              , ngramsTable      :: NgramsTable
+              , searchQuery      :: SearchQuery
+              , state            :: State
+              , termListFilter   :: Maybe TermList
+              , termSizeFilter   :: Maybe TermSize } -> Boolean
+displayRow { ngramsElement: NgramsElement {ngrams, root, list}
+           , ngramsParentRoot
+           , ngramsTable
+           , state: state@{ ngramsChildren
+                          , ngramsLocalPatch
+                          , ngramsParent }
+           , searchQuery
+           , termListFilter
+           , termSizeFilter } =
   (
       isNothing root
     -- ^ Display only nodes without parents
@@ -652,7 +664,7 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
               , tasks
               , versioned
               , withAutoUpdate } _ = do
-      state <- R.useState' $ initialState versioned
+      state <- T.useBox $ initialState versioned
 
       pure $ loadedNgramsTable { afterSync
                                , cacheState
@@ -693,7 +705,7 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
               , withAutoUpdate } _ = do
       let count /\ versioned = toVersioned versionedWithCount
 
-      state <- R.useState' $ initialState versioned
+      state <- T.useBox $ initialState versioned
 
       pure $ loadedNgramsTable {
         afterSync

src/Gargantext/Components/NgramsTable/Core.purs

@@ -974,12 +974,12 @@ putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff Vers
 putNgramsPatches { listIds, nodeId, session, tabType } = put session putNgrams
   where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId)
 
-syncPatches :: forall p s. CoreParams p -> R.State (CoreState s) -> (Unit -> Aff Unit) -> Effect Unit
-syncPatches props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
-                   , ngramsStagePatch
-                   , ngramsValidPatch
-                   , ngramsVersion
-                   } /\ setState) callback = do
+syncPatches :: forall p s. CoreParams p -> T.Box (CoreState s) -> (Unit -> Aff Unit) -> Effect Unit
+syncPatches props state callback = do
+  { ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
+  , ngramsStagePatch
+  , ngramsValidPatch
+  , ngramsVersion } <- T.read state
   when (isEmptyNgramsTablePatch ngramsStagePatch) $ do
     let pt = Versioned { data: ngramsPatches, version: ngramsVersion }
     launchAff_ $ do
@@ -987,7 +987,7 @@ syncPatches props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
       callback unit
       liftEffect $ do
         log2 "[syncPatches] setting state, newVersion" newVersion
-        setState $ \s ->
+        T.modify_ (\s ->
           -- I think that sometimes this setState does not fully go through.
           -- This is an issue because the version number does not get updated and the subsequent calls
           -- can mess up the patches.
@@ -997,7 +997,7 @@ syncPatches props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
             , ngramsValidPatch = fromNgramsPatches newPatch <> ngramsLocalPatch <> s.ngramsValidPatch
                               -- First the already valid patch, then the local patch, then the newly received newPatch.
             , ngramsVersion    = newVersion
-            }
+            }) state
         log2 "[syncPatches] ngramsVersion" newVersion
     pure unit
 
@@ -1027,10 +1027,9 @@ syncPatchesAsync props@{ listIds, tabType }
         log2 "[syncPatches] ngramsVersion" newVersion
 -}
 
-commitPatch :: forall s. Versioned NgramsTablePatch -> R.State (CoreState s) -> Effect Unit
-commitPatch (Versioned {version, data: tablePatch}) (_ /\ setState) = do
-  setState $ \s ->
-    s { ngramsLocalPatch = tablePatch <> s.ngramsLocalPatch }
+commitPatch :: forall s. NgramsTablePatch -> T.Box (CoreState s) -> Effect Unit
+commitPatch tablePatch state = do
+  T.modify_ (\s -> s { ngramsLocalPatch = tablePatch <> s.ngramsLocalPatch }) state
     -- First we apply the patches we have locally and then the new patch (tablePatch).
 
 loadNgramsTable :: PageParams -> Aff VersionedNgramsTable
@@ -1096,13 +1095,13 @@ data Action
 type CoreDispatch = CoreAction -> Effect Unit
 type Dispatch = Action -> Effect Unit
 
-coreDispatch :: forall p s. CoreParams p -> R.State (CoreState s) -> CoreDispatch
+coreDispatch :: forall p s. CoreParams p -> T.Box (CoreState s) -> CoreDispatch
 coreDispatch path state (Synchronize { afterSync }) =
   syncPatches path state afterSync
-coreDispatch _ state@({ngramsVersion} /\ _) (CommitPatch pt) =
-  commitPatch (Versioned {version: ngramsVersion, data: pt}) state
-coreDispatch _ (_ /\ setState) ResetPatches =
-  setState $ \s -> s { ngramsLocalPatch = { ngramsPatches: mempty } }
+coreDispatch _ state (CommitPatch pt) =
+  commitPatch pt state
+coreDispatch _ state ResetPatches =
+  T.modify_ (\s -> s { ngramsLocalPatch = { ngramsPatches: mempty } }) state
 
 isSingleNgramsTerm :: NgramsTerm -> Boolean
 isSingleNgramsTerm nt = isSingleTerm $ ngramsTermText nt

src/Gargantext/Components/Nodes/Corpus/Document.purs

@@ -9,6 +9,7 @@ import Effect.Aff (Aff)
 import Reactix as R
 import Reactix.DOM.HTML as H
 import Record as Record
+import Toestand as T
 
 import Gargantext.Prelude (bind, pure, show, unit, ($), (<>), (<$>), (<<<))
 
@@ -43,12 +44,12 @@ docViewWrapperCpt :: R.Component Props
 docViewWrapperCpt = here.component "docViewWrapper" cpt
   where
     cpt props@{ loaded } _ = do
-      state <- R.useState' $ initialState { loaded }
+      state <- T.useBox $ initialState { loaded }
 
       pure $ docView (Record.merge props { state }) []
 
 type DocViewProps = (
-  state :: R.State State
+  state :: T.Box State
   | Props
   )
 
@@ -60,8 +61,9 @@ docViewCpt = here.component "docView" cpt
   where
     cpt { path
         , loaded: loaded@{ ngramsTable: Versioned { data: initTable }, document }
-        , state: state@({ ngramsVersion: version, ngramsLocalPatch } /\ _)
+        , state
         } _children = do
+      state'@{ ngramsLocalPatch, ngramsVersion: version } <- T.useLive T.unequal state
 
       let
         afterSync = \_ -> pure unit
@@ -74,6 +76,13 @@ docViewCpt = here.component "docView" cpt
           then [ autoUpdate { duration: 5000, effect: dispatch $ Synchronize { afterSync } } ]
           else []
 
+        ngrams = applyNgramsPatches state' initTable
+        annotate text = AnnotatedField.annotatedField { ngrams, setTermList, text }
+
+        setTermListOrAddA ngram Nothing        = addNewNgramA ngram
+        setTermListOrAddA ngram (Just oldList) = setTermListA ngram <<< replace oldList
+        setTermList ngram mOldList = dispatch <<< setTermListOrAddA (findNgramRoot ngrams ngram) mOldList
+
       pure $ H.div {} $
         autoUpd <> syncResetBtns <>
         --DEBUG
@@ -95,17 +104,12 @@ docViewCpt = here.component "docView" cpt
               ]]]]
       where
         dispatch = coreDispatch path state
-        ngrams = applyNgramsPatches (fst state) initTable
-        annotate text = AnnotatedField.annotatedField { ngrams, setTermList, text }
         badge s = H.span { className: "badge badge-default badge-pill" } [ H.text s ]
         badgeLi s =
           H.span { className: "list-group-item-heading" }
           [ H.span { className: "badge-container" }
             [ H.span { className: "badge badge-default badge-pill" } [ H.text s ] ]]
         li' = H.li { className: "list-group-item justify-content-between" }
-        setTermListOrAddA ngram Nothing        = addNewNgramA ngram
-        setTermListOrAddA ngram (Just oldList) = setTermListA ngram <<< replace oldList
-        setTermList ngram mOldList = dispatch <<< setTermListOrAddA (findNgramRoot ngrams ngram) mOldList
         -- Here the use of findNgramRoot makes that we always target the root of an ngram group.
         text' x = H.span { className: "list-group-item-text" } [ H.text $ fromMaybe "Nothing" x ]
         NodePoly {hyperdata: Document doc} = document