Commit 68298c5b authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[toestand] ngramsTable: state is a box now

parent c5b11698
This diff is collapsed.
...@@ -974,12 +974,12 @@ putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff Vers ...@@ -974,12 +974,12 @@ putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff Vers
putNgramsPatches { listIds, nodeId, session, tabType } = put session putNgrams putNgramsPatches { listIds, nodeId, session, tabType } = put session putNgrams
where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId) 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 :: forall p s. CoreParams p -> T.Box (CoreState s) -> (Unit -> Aff Unit) -> Effect Unit
syncPatches props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches } syncPatches props state callback = do
{ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
, ngramsStagePatch , ngramsStagePatch
, ngramsValidPatch , ngramsValidPatch
, ngramsVersion , ngramsVersion } <- T.read state
} /\ setState) callback = do
when (isEmptyNgramsTablePatch ngramsStagePatch) $ do when (isEmptyNgramsTablePatch ngramsStagePatch) $ do
let pt = Versioned { data: ngramsPatches, version: ngramsVersion } let pt = Versioned { data: ngramsPatches, version: ngramsVersion }
launchAff_ $ do launchAff_ $ do
...@@ -987,7 +987,7 @@ syncPatches props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches } ...@@ -987,7 +987,7 @@ syncPatches props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
callback unit callback unit
liftEffect $ do liftEffect $ do
log2 "[syncPatches] setting state, newVersion" newVersion log2 "[syncPatches] setting state, newVersion" newVersion
setState $ \s -> T.modify_ (\s ->
-- I think that sometimes this setState does not fully go through. -- 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 -- This is an issue because the version number does not get updated and the subsequent calls
-- can mess up the patches. -- can mess up the patches.
...@@ -997,7 +997,7 @@ syncPatches props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches } ...@@ -997,7 +997,7 @@ syncPatches props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
, ngramsValidPatch = fromNgramsPatches newPatch <> ngramsLocalPatch <> s.ngramsValidPatch , ngramsValidPatch = fromNgramsPatches newPatch <> ngramsLocalPatch <> s.ngramsValidPatch
-- First the already valid patch, then the local patch, then the newly received newPatch. -- First the already valid patch, then the local patch, then the newly received newPatch.
, ngramsVersion = newVersion , ngramsVersion = newVersion
} }) state
log2 "[syncPatches] ngramsVersion" newVersion log2 "[syncPatches] ngramsVersion" newVersion
pure unit pure unit
...@@ -1027,10 +1027,9 @@ syncPatchesAsync props@{ listIds, tabType } ...@@ -1027,10 +1027,9 @@ syncPatchesAsync props@{ listIds, tabType }
log2 "[syncPatches] ngramsVersion" newVersion log2 "[syncPatches] ngramsVersion" newVersion
-} -}
commitPatch :: forall s. Versioned NgramsTablePatch -> R.State (CoreState s) -> Effect Unit commitPatch :: forall s. NgramsTablePatch -> T.Box (CoreState s) -> Effect Unit
commitPatch (Versioned {version, data: tablePatch}) (_ /\ setState) = do commitPatch tablePatch state = do
setState $ \s -> T.modify_ (\s -> s { ngramsLocalPatch = tablePatch <> s.ngramsLocalPatch }) state
s { ngramsLocalPatch = tablePatch <> s.ngramsLocalPatch }
-- First we apply the patches we have locally and then the new patch (tablePatch). -- First we apply the patches we have locally and then the new patch (tablePatch).
loadNgramsTable :: PageParams -> Aff VersionedNgramsTable loadNgramsTable :: PageParams -> Aff VersionedNgramsTable
...@@ -1096,13 +1095,13 @@ data Action ...@@ -1096,13 +1095,13 @@ data Action
type CoreDispatch = CoreAction -> Effect Unit type CoreDispatch = CoreAction -> Effect Unit
type Dispatch = Action -> 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 }) = coreDispatch path state (Synchronize { afterSync }) =
syncPatches path state afterSync syncPatches path state afterSync
coreDispatch _ state@({ngramsVersion} /\ _) (CommitPatch pt) = coreDispatch _ state (CommitPatch pt) =
commitPatch (Versioned {version: ngramsVersion, data: pt}) state commitPatch pt state
coreDispatch _ (_ /\ setState) ResetPatches = coreDispatch _ state ResetPatches =
setState $ \s -> s { ngramsLocalPatch = { ngramsPatches: mempty } } T.modify_ (\s -> s { ngramsLocalPatch = { ngramsPatches: mempty } }) state
isSingleNgramsTerm :: NgramsTerm -> Boolean isSingleNgramsTerm :: NgramsTerm -> Boolean
isSingleNgramsTerm nt = isSingleTerm $ ngramsTermText nt isSingleNgramsTerm nt = isSingleTerm $ ngramsTermText nt
......
...@@ -9,6 +9,7 @@ import Effect.Aff (Aff) ...@@ -9,6 +9,7 @@ import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Record as Record import Record as Record
import Toestand as T
import Gargantext.Prelude (bind, pure, show, unit, ($), (<>), (<$>), (<<<)) import Gargantext.Prelude (bind, pure, show, unit, ($), (<>), (<$>), (<<<))
...@@ -43,12 +44,12 @@ docViewWrapperCpt :: R.Component Props ...@@ -43,12 +44,12 @@ docViewWrapperCpt :: R.Component Props
docViewWrapperCpt = here.component "docViewWrapper" cpt docViewWrapperCpt = here.component "docViewWrapper" cpt
where where
cpt props@{ loaded } _ = do cpt props@{ loaded } _ = do
state <- R.useState' $ initialState { loaded } state <- T.useBox $ initialState { loaded }
pure $ docView (Record.merge props { state }) [] pure $ docView (Record.merge props { state }) []
type DocViewProps = ( type DocViewProps = (
state :: R.State State state :: T.Box State
| Props | Props
) )
...@@ -60,8 +61,9 @@ docViewCpt = here.component "docView" cpt ...@@ -60,8 +61,9 @@ docViewCpt = here.component "docView" cpt
where where
cpt { path cpt { path
, loaded: loaded@{ ngramsTable: Versioned { data: initTable }, document } , loaded: loaded@{ ngramsTable: Versioned { data: initTable }, document }
, state: state@({ ngramsVersion: version, ngramsLocalPatch } /\ _) , state
} _children = do } _children = do
state'@{ ngramsLocalPatch, ngramsVersion: version } <- T.useLive T.unequal state
let let
afterSync = \_ -> pure unit afterSync = \_ -> pure unit
...@@ -74,6 +76,13 @@ docViewCpt = here.component "docView" cpt ...@@ -74,6 +76,13 @@ docViewCpt = here.component "docView" cpt
then [ autoUpdate { duration: 5000, effect: dispatch $ Synchronize { afterSync } } ] then [ autoUpdate { duration: 5000, effect: dispatch $ Synchronize { afterSync } } ]
else [] 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 {} $ pure $ H.div {} $
autoUpd <> syncResetBtns <> autoUpd <> syncResetBtns <>
--DEBUG --DEBUG
...@@ -95,17 +104,12 @@ docViewCpt = here.component "docView" cpt ...@@ -95,17 +104,12 @@ docViewCpt = here.component "docView" cpt
]]]] ]]]]
where where
dispatch = coreDispatch path state 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 ] badge s = H.span { className: "badge badge-default badge-pill" } [ H.text s ]
badgeLi s = badgeLi s =
H.span { className: "list-group-item-heading" } H.span { className: "list-group-item-heading" }
[ H.span { className: "badge-container" } [ H.span { className: "badge-container" }
[ H.span { className: "badge badge-default badge-pill" } [ H.text s ] ]] [ H.span { className: "badge badge-default badge-pill" } [ H.text s ] ]]
li' = H.li { className: "list-group-item justify-content-between" } 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. -- 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 ] text' x = H.span { className: "list-group-item-text" } [ H.text $ fromMaybe "Nothing" x ]
NodePoly {hyperdata: Document doc} = document NodePoly {hyperdata: Document doc} = document
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment