Skip to content

P
purescript-gargantext
Commit 5b4d25b2 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[charts] automatic chart refresh works

parent c26a1fee
Show whitespace changes
Inline Side-by-side
Showing with 54 additions and 48 deletions
src/Gargantext/Components/NgramsTable.purs
View file @ 5b4d25b2
......@@ -275,7 +275,7 @@ tableContainerCpt { dispatch
-- NEXT
type Props =
( afterSync :: Unit -> Effect Unit
( afterSync :: Unit -> Aff Unit
, path :: R.State PageParams
, state :: R.State State
, tabNgramType :: CTabNgramType
......@@ -328,16 +328,17 @@ loadedNgramsTableCpt = R2.hooksComponent thisModule "loadedNgramsTable" cpt
where
autoUpdate :: Array R.Element
autoUpdate = if withAutoUpdate then
[ R2.buff $ autoUpdateElt { duration: 5000, effect: performAction Synchronize } ]
[ R2.buff $ autoUpdateElt {
duration: 5000
, effect: performAction $ Synchronize { afterSync }
} ]
else []
resetButton :: Boolean -> R.Element
resetButton active = H.button { className: "btn btn-primary " <> if active then "" else " disabled"
, on: { click: \_ -> performAction ResetPatches } } [ H.text "Reset" ]
syncButton :: R.Element
syncButton = H.button { className: "btn btn-primary"
, on: { click: \_ -> do
performAction Synchronize
afterSync unit
, on: { click: \_ -> performAction $ Synchronize { afterSync }
}
} [ H.text "Sync" ]
-- I would rather have the two buttons always here and make the reset button inactive when the patch is empty.
......@@ -364,9 +365,9 @@ loadedNgramsTableCpt = R2.hooksComponent thisModule "loadedNgramsTable" cpt
s { ngramsSelection = Set.empty :: Set NgramsTerm }
else
s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
performAction Synchronize = syncPatchesR path' (state /\ setState)
performAction (Synchronize { afterSync }) = syncPatches path' (state /\ setState) afterSync
performAction (CommitPatch pt) =
commitPatchR (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
commitPatch (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
performAction ResetPatches =
setState $ \s -> s { ngramsLocalPatch = { ngramsPatches: mempty } }
performAction AddTermChildren =
......@@ -379,7 +380,7 @@ loadedNgramsTableCpt = R2.hooksComponent thisModule "loadedNgramsTable" cpt
pe = NgramsPatch { patch_list: mempty, patch_children: pc }
pt = singletonNgramsTablePatch parent pe
setState $ setParentResetChildren Nothing
commitPatchR (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
commitPatch (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
totalRecords = L.length rows
filteredConvertedRows :: T.Rows
......@@ -491,7 +492,7 @@ selectNgramsOnFirstPage rows = Set.fromFoldable $ (view $ _NgramsElement <<< _ng
type MainNgramsTableProps =
( afterSync :: Unit -> Effect Unit
( afterSync :: Unit -> Aff Unit
, cacheState :: R.State NT.CacheState
, defaultListId :: Int
, nodeId :: Int
......@@ -561,7 +562,7 @@ mainNgramsTableCpt = R2.hooksComponent thisModule "mainNgramsTable" cpt
, termListFilter = Nothing }
type MainNgramsTablePaintProps =
( afterSync :: Unit -> Effect Unit
( afterSync :: Unit -> Aff Unit
, path :: PageParams
, tabNgramType :: CTabNgramType
, versioned :: VersionedNgramsTable
......
src/Gargantext/Components/NgramsTable/Core.purs
View file @ 5b4d25b2
......@@ -48,9 +48,9 @@ module Gargantext.Components.NgramsTable.Core
, _root
, _ngrams_repo_elements
, _ngrams_scores
, commitPatchR
, commitPatch
, putNgramsPatches
, syncPatchesR
, syncPatches
, addNewNgram
, Action(..)
, Dispatch
......@@ -101,6 +101,7 @@ import Data.Traversable (for, traverse_)
import Data.TraversableWithIndex (traverseWithIndex)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff_)
import Effect (Effect)
import Effect.Class (liftEffect)
......@@ -869,34 +870,38 @@ putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff Vers
putNgramsPatches {session, nodeId, listIds, tabType} = put session putNgrams
where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId)
-- TODO rename syncPatches
syncPatchesR :: forall p s. CoreParams p -> R.State (CoreState s) -> Effect Unit
syncPatchesR props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
syncPatches :: forall p s. CoreParams p -> R.State (CoreState s) -> (Unit -> Aff Unit) -> Effect Unit
syncPatches props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
, ngramsStagePatch
, ngramsValidPatch
, ngramsVersion
} /\ setState) = do
} /\ setState) callback = do
when (isEmptyNgramsTablePatch ngramsStagePatch) $ do
setState $ \s ->
s { ngramsLocalPatch = fromNgramsPatches mempty
, ngramsStagePatch = ngramsLocalPatch
}
let pt = Versioned { version: ngramsVersion, data: ngramsPatches }
-- setState $ \s ->
-- s { ngramsLocalPatch = fromNgramsPatches mempty
-- , ngramsStagePatch = ngramsLocalPatch
-- }
let pt = Versioned { data: ngramsPatches, version: ngramsVersion }
launchAff_ $ do
Versioned {version: newVersion, data: newPatch} <- putNgramsPatches props pt
liftEffect $ setState $ \s ->
Versioned { data: newPatch, version: newVersion } <- putNgramsPatches props pt
-- callback unit
liftEffect $ do
log2 "[syncPatches] setting state, newVersion" newVersion
setState $ \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.
s { ngramsVersion = newVersion
s {
ngramsLocalPatch = fromNgramsPatches mempty
, ngramsStagePatch = fromNgramsPatches mempty
, ngramsValidPatch = fromNgramsPatches newPatch <> ngramsLocalPatch <> s.ngramsValidPatch
-- First the already valid patch, then the local patch, then the newly received newPatch.
, ngramsStagePatch = fromNgramsPatches mempty
, ngramsVersion = newVersion
}
log2 "[syncPatches] ngramsVersion" newVersion
-- TODO rename as commitPatch
commitPatchR :: forall s. Versioned NgramsTablePatch -> R.State (CoreState s) -> Effect Unit
commitPatchR (Versioned {version, data: tablePatch}) (_ /\ setState) = do
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 }
-- First we apply the patches we have locally and then the new patch (tablePatch).
......@@ -952,7 +957,7 @@ data Action
-- If the `Boolean` is `true` it means we want to add it if it is not here,
-- if it is `false` it is meant to be removed if not here.
| AddTermChildren
| Synchronize
| Synchronize { afterSync :: Unit -> Aff Unit }
| ToggleSelect NgramsTerm
-- ^ Toggles the NgramsTerm in the `Set` `ngramsSelection`.
| ToggleSelectAll
......
src/Gargantext/Components/Nodes/Corpus/Document.purs
View file @ 5b4d25b2
module Gargantext.Components.Nodes.Corpus.Document where
import Prelude (class Show, bind, mempty, pure, show, ($), (<>), Unit)
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
......@@ -11,13 +10,15 @@ import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.AutoUpdate ( autoUpdate)
import Gargantext.Components.Search (SearchType(..))
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.NgramsTable.Core
( CoreState, NgramsPatch(..), NgramsTerm, Replace, Versioned(..)
, VersionedNgramsTable, addNewNgram, applyNgramsTablePatch, commitPatchR
, loadNgramsTable, replace, singletonNgramsTablePatch, syncPatchesR )
, VersionedNgramsTable, addNewNgram, applyNgramsTablePatch, commitPatch
, loadNgramsTable, replace, singletonNgramsTablePatch, syncPatches )
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..))
......@@ -353,18 +354,18 @@ docViewCpt = R2.hooksComponent thisModule "docView" cpt
where
dispatch :: Action -> Effect Unit
dispatch (AddNewNgram ngram termList) = do
commitPatchR (Versioned {version, data: pt}) state
commitPatch (Versioned {version, data: pt}) state
where
({ ngramsVersion: version } /\ _) = state
pt = addNewNgram ngram termList
dispatch (SetTermListItem ngram termList) = do
commitPatchR (Versioned {version, data: pt}) state
commitPatch (Versioned {version, data: pt}) state
where
({ ngramsVersion: version } /\ _) = state
pe = NgramsPatch { patch_list: termList, patch_children: mempty }
pt = singletonNgramsTablePatch ngram pe
dispatch Synchronize = do
syncPatchesR props.path props.state
syncPatches props.path props.state (\_ -> pure unit)
annotate state text = AnnotatedField.annotatedField { ngrams: ngramsTable state
, setTermList: setTermList state
......
src/Gargantext/Components/Nodes/Lists/Tabs.purs
View file @ 5b4d25b2
......@@ -84,9 +84,8 @@ ngramsViewCpt = R2.hooksComponent thisModule "ngramsView" cpt
afterSync chartType (_ /\ setChartsReload) _ = do
case mNgramsType of
Just ngramsType -> do
launchAff_ $ do
recomputeChart session chartType ngramsType corpusId listId
setChartsReload $ (+) 1
_ <- recomputeChart session chartType ngramsType corpusId listId
liftEffect $ setChartsReload $ (+) 1
Nothing -> pure unit
tabNgramType = modeTabType mode
......
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