[wip] some temp fixes

parent 02129e3d
Pipeline #4390 failed with stage
in 0 seconds
...@@ -14,6 +14,7 @@ import Data.Set as Set ...@@ -14,6 +14,7 @@ import Data.Set as Set
import Data.String (length) import Data.String (length)
import Data.String as String import Data.String as String
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Class (liftEffect)
import Gargantext.Components.Annotation.Field as AnnotatedField import Gargantext.Components.Annotation.Field as AnnotatedField
import Gargantext.Components.Annotation.Types as AFT import Gargantext.Components.Annotation.Types as AFT
import Gargantext.Components.AutoUpdate (autoUpdate) import Gargantext.Components.AutoUpdate (autoUpdate)
...@@ -25,8 +26,8 @@ import Gargantext.Components.GraphQL.Endpoints (getContextNgrams) ...@@ -25,8 +26,8 @@ import Gargantext.Components.GraphQL.Endpoints (getContextNgrams)
import Gargantext.Components.NgramsTable.AutoSync (useAutoSync) import Gargantext.Components.NgramsTable.AutoSync (useAutoSync)
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Config.REST (logRESTError) import Gargantext.Config.REST (logRESTError)
import Gargantext.Core.NgramsTable.Functions (addNewNgramA, applyNgramsPatches, coreDispatch, findNgramRoot, setTermListA, computeCache) import Gargantext.Core.NgramsTable.Functions (addNewNgramA, applyNgramsPatches, coreDispatch, findNgramRoot, setTermListA, computeCache, Cache)
import Gargantext.Core.NgramsTable.Types (CoreAction(..), NgramsTable(..), NgramsTerm, Versioned(..), replace) import Gargantext.Core.NgramsTable.Types (CoreAction(..), NgramsTable(..), NgramsTablePatch(..), NgramsTerm, Versioned(..), PatchMap(..), replace, State)
import Gargantext.Hooks.FirstEffect (useFirstEffect') import Gargantext.Hooks.FirstEffect (useFirstEffect')
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
...@@ -69,22 +70,30 @@ layoutCpt :: R.Component Props ...@@ -69,22 +70,30 @@ layoutCpt :: R.Component Props
layoutCpt = here.component "layout" cpt where layoutCpt = here.component "layout" cpt where
cpt props@{ path: path@{ listIds cpt props@{ path: path@{ listIds
, nodeId } , nodeId }
, loaded: loaded@{ ngramsTable: Versioned { data: initTable } }
, reload , reload
, session } _ = do , session } _ = do
reload' <- T.useLive T.unequal reload -- reload' <- T.useLive T.unequal reload
let reload' = 1
state <- T.useBox $ initialState { loaded }
state'@{ ngramsValidPatch } <- T.useLive T.unequal state
ngrams <- T.useBox initTable
ngrams' <- T.useLive T.unequal ngrams
case A.head listIds of case A.head listIds of
Nothing -> pure $ H.div {} [ H.text "No list supplied!" ] Nothing -> pure $ H.div {} [ H.text "No list supplied!" ]
Just listId -> Just listId ->
useLoader { errorHandler useLoader { errorHandler
, loader: \p -> getContextNgrams session p.contextId p.listId , loader: \p -> getContextNgrams session p.contextId p.listId
, path: { contextId: nodeId, listId, reload: reload' } , path: { contextId: nodeId, listId, reload: reload', state: state' }
, render: \contextNgrams -> , render: \contextNgrams ->
layoutWithContextNgrams $ Record.merge props { contextNgrams } } layoutWithContextNgrams $ Record.merge props { contextNgrams, ngrams, state } }
where where
errorHandler = logRESTError here "[layout]" errorHandler = logRESTError here "[layout]"
type WithContextNgramsProps = type WithContextNgramsProps =
( contextNgrams :: Array NgramsTerm ( contextNgrams :: Array NgramsTerm
, ngrams :: T.Box NgramsTable
, state :: T.Box State
| Props ) | Props )
layoutWithContextNgrams :: forall r. R2.OptLeaf Options WithContextNgramsProps r layoutWithContextNgrams :: forall r. R2.OptLeaf Options WithContextNgramsProps r
...@@ -93,32 +102,76 @@ layoutWithContextNgramsCpt :: R.Component WithContextNgramsProps ...@@ -93,32 +102,76 @@ layoutWithContextNgramsCpt :: R.Component WithContextNgramsProps
layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where
-- Component -- Component
cpt { contextNgrams cpt { contextNgrams
, ngrams
, path , path
, reload , reload
, loaded: , loaded
loaded@{ ngramsTable: Versioned { data: initTable }
, document: NodePoly { hyperdata: Document doc }
}
, sideControlsSlot , sideControlsSlot
, state
} _ = do } _ = do
-- | States -- | States
-- | -- |
reload' <- T.useLive T.unequal reload -- reload' <- T.useLive T.unequal reload
state'@{ ngramsLocalPatch } /\ state <- ngrams' <- T.useLive T.unequal ngrams
R2.useBox' $ initialState { loaded } state'@{ ngramsValidPatch } <- T.useLive T.unequal state
let (NgramsTable { ngrams_scores }) = ngrams'
let cache = computeCache (NgramsTable { ngrams_repo_elements: ngramsValidPatch
, ngrams_scores }) $ Set.fromFoldable contextNgrams
-- let cache = computeCache ngramsValidPatch $ Set.fromFoldable contextNgrams
R.useEffect' $ do
here.log2 "[layoutWithContextNgrams] cache" cache
pure $ layoutWithCache { cache
, ngrams
, path
, loaded
, reload
, sideControlsSlot
, state }
type WithCacheProps =
( cache :: Record Cache
, ngrams :: T.Box NgramsTable
, path :: DocPath
, loaded :: LoadedData
, reload :: T2.ReloadS
, sideControlsSlot :: Maybe R.Element
, state :: T.Box State )
layoutWithCache :: R2.Leaf WithCacheProps
layoutWithCache = R2.leaf layoutWithCacheCpt
layoutWithCacheCpt :: R.Component WithCacheProps
layoutWithCacheCpt = here.component "layoutWithCache" cpt where
-- Component
cpt { cache
, ngrams
, path
, loaded:
loaded@{ ngramsTable: Versioned { data: initTable }
, document: NodePoly { hyperdata: Document doc }
}
, reload
, sideControlsSlot
, state } _ = do
state'@{ ngramsLocalPatch } <- T.useLive T.unequal state
mode' /\ mode <- R2.useBox' AFT.EditionMode mode' /\ mode <- R2.useBox' AFT.EditionMode
let dispatch = coreDispatch path state let dispatch = coreDispatch path state
{ onPending, result } <- useAutoSync { state, action: dispatch } -- { onPending, result } <- useAutoSync { state, action: dispatch }
onPending' <- R2.useLive' onPending -- onPending' <- R2.useLive' onPending
result' <- R2.useLive' result -- result' <- R2.useLive' result
ngrams <- T.useBox initTable -- ngrams <- T.useBox initTable
ngrams' <- T.useLive T.unequal ngrams ngrams' <- T.useLive T.unequal ngrams
R.useEffect' $ do
here.log2 "[layoutWithCache] state'" state'
here.log2 "[layoutWithCache] ngrams'" ngrams'
-- | Computed -- | Computed
-- | -- |
let let
...@@ -127,7 +180,7 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where ...@@ -127,7 +180,7 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where
-- ngrams = applyNgramsPatches state' initTable -- ngrams = applyNgramsPatches state' initTable
cache = computeCache ngrams' $ Set.fromFoldable contextNgrams -- cache = computeCache ngrams' $ Set.fromFoldable contextNgrams
setTermListOrAddA ngram Nothing = setTermListOrAddA ngram Nothing =
addNewNgramA ngram addNewNgramA ngram
...@@ -136,14 +189,17 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where ...@@ -136,14 +189,17 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where
setTermList ngram mOldList termList = do setTermList ngram mOldList termList = do
let root = findNgramRoot ngrams' ngram let root = findNgramRoot ngrams' ngram
-- here.log2 "[setTermList] ngram" ngram here.log2 "[setTermList] ngram" ngram
-- here.log2 "[setTermList] root" root -- here.log2 "[setTermList] root" root
let patch = setTermListOrAddA root mOldList termList let patch = setTermListOrAddA root mOldList termList
-- here.log2 "[setTermList] patch" patch here.log2 "[setTermList] patch" patch
dispatch patch dispatch patch
T.write_ (applyNgramsPatches state' initTable) ngrams T.write_ (applyNgramsPatches state' initTable) ngrams
dispatch $ Synchronize { afterSync: \_ -> pure unit
, afterStateChange: \_ -> do
liftEffect $ T2.reload reload }
-- here.log2 "[setTermList] calling reload" reload' -- here.log2 "[setTermList] calling reload" reload'
T2.reload reload -- T2.reload reload
hasAbstract = maybe false (not String.null) doc.abstract hasAbstract = maybe false (not String.null) doc.abstract
...@@ -228,7 +284,10 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where ...@@ -228,7 +284,10 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where
autoUpdate autoUpdate
{ duration: 5000 { duration: 5000
, effect: dispatch $ Synchronize , effect: dispatch $ Synchronize
{ afterSync: \_ -> pure unit { afterSync: \e -> do
liftEffect $ here.log2 "[autoUpdate] synchronized" e
pure unit
, afterStateChange: \_ -> pure unit
} }
} }
-- @NOTE #386: revert manual for automatic sync -- @NOTE #386: revert manual for automatic sync
...@@ -244,25 +303,25 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where ...@@ -244,25 +303,25 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where
{ className: "document-layout__side-controls" } { className: "document-layout__side-controls" }
[ [
-- Saving informations -- Saving informations
H.div -- H.div
{ className: "document-layout__saving" } -- { className: "document-layout__saving" }
[ -- [
R2.when' onPending' -- R2.when' onPending'
[ -- [
B.spinner -- B.spinner
{ theme: GrowTheme -- { theme: GrowTheme
, className: "document-layout__saving__spinner" -- , className: "document-layout__saving__spinner"
} -- }
] -- ]
, -- ,
R2.when (not onPending' && isJust result') $ -- R2.when (not onPending' && isJust result') $
B.icon -- B.icon
{ name: "check" -- { name: "check"
, className: "document-layout__saving__icon" -- , className: "document-layout__saving__icon"
} -- }
] -- ]
, -- ,
R2.fromMaybe sideControlsSlot identity R2.fromMaybe sideControlsSlot identity
] ]
] ]
......
...@@ -599,7 +599,8 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where ...@@ -599,7 +599,8 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
-- then sync the ngram list -- then sync the ngram list
performAction performAction
$ CoreAction $ CoreAction
$ Synchronize { afterSync: afterSync' } $ Synchronize { afterSync: afterSync'
, afterStateChange: \_ -> pure unit }
changePage 1 params changePage 1 params
......
...@@ -49,6 +49,7 @@ useAutoSync { state, action } = do ...@@ -49,6 +49,7 @@ useAutoSync { state, action } = do
T.write_ Nothing result T.write_ Nothing result
action $ Synchronize action $ Synchronize
{ afterSync: onSuccess { afterSync: onSuccess
, afterStateChange: \_ -> pure unit
} }
onSuccess _ = liftEffect do onSuccess _ = liftEffect do
......
...@@ -49,7 +49,8 @@ syncResetButtonsCpt = here.component "syncResetButtons" cpt ...@@ -49,7 +49,8 @@ syncResetButtonsCpt = here.component "syncResetButtons" cpt
synchronizeClick _ = delay unit $ \_ -> do synchronizeClick _ = delay unit $ \_ -> do
T.write_ true synchronizing T.write_ true synchronizing
performAction $ Synchronize { afterSync: newAfterSync } performAction $ Synchronize { afterSync: newAfterSync
, afterStateChange: \_ -> pure unit }
performAction ResetPatches performAction ResetPatches
newAfterSync x = do newAfterSync x = do
...@@ -84,5 +85,5 @@ syncResetButtonsCpt = here.component "syncResetButtons" cpt ...@@ -84,5 +85,5 @@ syncResetButtonsCpt = here.component "syncResetButtons" cpt
H.text "Save changes (sync)" H.text "Save changes (sync)"
] ]
] ]
] ]
...@@ -75,7 +75,6 @@ textsLayoutCpt = here.component "textsLayout" cpt where ...@@ -75,7 +75,6 @@ textsLayoutCpt = here.component "textsLayout" cpt where
textsLayoutWithKey :: R2.Leaf ( key :: String | Props ) textsLayoutWithKey :: R2.Leaf ( key :: String | Props )
textsLayoutWithKey = R2.leaf textsLayoutWithKeyCpt textsLayoutWithKey = R2.leaf textsLayoutWithKeyCpt
textsLayoutWithKeyCpt :: R.Component ( key :: String | Props ) textsLayoutWithKeyCpt :: R.Component ( key :: String | Props )
textsLayoutWithKeyCpt = here.component "textsLayoutWithKey" cpt where textsLayoutWithKeyCpt = here.component "textsLayoutWithKey" cpt where
cpt { frontends cpt { frontends
...@@ -557,7 +556,8 @@ sideTextCpt = here.component "sideText" cpt where ...@@ -557,7 +556,8 @@ sideTextCpt = here.component "sideText" cpt where
-- here.log2 "[sideText] state'" state' -- here.log2 "[sideText] state'" state'
reload <- T.useBox T2.newReload reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload -- reload' <- T.useLive T.unequal reload
let reload' = 1
-- | Computed -- | Computed
-- | -- |
......
...@@ -414,8 +414,11 @@ putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> AffRESTE ...@@ -414,8 +414,11 @@ putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> AffRESTE
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 -> T.Box (CoreState s) -> (Unit -> Aff Unit) -> Effect Unit syncPatches :: forall p s. CoreParams p
syncPatches props state callback = do -> T.Box (CoreState s)
-> Record SyncPatchesCallbacks
-> Effect Unit
syncPatches props state { afterSync, afterStateChange } = do
{ ngramsLocalPatch: ngramsLocalPatch@(NgramsTablePatch ngramsPatches) { ngramsLocalPatch: ngramsLocalPatch@(NgramsTablePatch ngramsPatches)
, ngramsStagePatch , ngramsStagePatch
, ngramsVersion } <- T.read state , ngramsVersion } <- T.read state
...@@ -426,7 +429,7 @@ syncPatches props state callback = do ...@@ -426,7 +429,7 @@ syncPatches props state callback = do
case ePatches of case ePatches of
Left err -> liftEffect $ logRESTError here "[syncPatches]" err Left err -> liftEffect $ logRESTError here "[syncPatches]" err
Right (Versioned { data: newPatch, version: newVersion }) -> do Right (Versioned { data: newPatch, version: newVersion }) -> do
callback unit afterSync unit
liftEffect $ do liftEffect $ do
here.log2 "[syncPatches] setting state, newVersion" newVersion here.log2 "[syncPatches] setting state, newVersion" newVersion
T.modify_ (\s -> T.modify_ (\s ->
...@@ -441,6 +444,7 @@ syncPatches props state callback = do ...@@ -441,6 +444,7 @@ syncPatches props state callback = do
, ngramsVersion = newVersion , ngramsVersion = newVersion
}) state }) state
here.log2 "[syncPatches] ngramsVersion" newVersion here.log2 "[syncPatches] ngramsVersion" newVersion
afterStateChange unit
pure unit pure unit
{- {-
...@@ -518,8 +522,8 @@ convOrderBy (T.ASC _) = TermAsc ...@@ -518,8 +522,8 @@ convOrderBy (T.ASC _) = TermAsc
convOrderBy (T.DESC _) = TermDesc convOrderBy (T.DESC _) = TermDesc
coreDispatch :: forall p s. CoreParams p -> T.Box State -> CoreDispatch coreDispatch :: forall p s. CoreParams p -> T.Box State -> CoreDispatch
coreDispatch path state (Synchronize { afterSync }) = coreDispatch path state (Synchronize { afterSync, afterStateChange }) =
syncPatches path state afterSync syncPatches path state { afterSync, afterStateChange }
coreDispatch _ state (CommitPatch pt) = coreDispatch _ state (CommitPatch pt) =
commitPatch pt state commitPatch pt state
coreDispatch _ state ResetPatches = coreDispatch _ state ResetPatches =
......
...@@ -521,9 +521,14 @@ type State = ...@@ -521,9 +521,14 @@ type State =
type NgramsListByTabType = Map GT.TabType VersionedNgramsTable type NgramsListByTabType = Map GT.TabType VersionedNgramsTable
type SyncPatchesCallbacks =
( afterSync :: Unit -> Aff Unit
, afterStateChange :: Unit -> Effect Unit )
data CoreAction data CoreAction
= CommitPatch NgramsTablePatch = CommitPatch NgramsTablePatch
| Synchronize { afterSync :: Unit -> Aff Unit } | Synchronize (Record SyncPatchesCallbacks)
| ResetPatches | ResetPatches
data Action data Action
......
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