Commit 6fa5f971 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[ngrams] fix patch semigroup, remove auto update of ngrams table

parent a5b594f6
...@@ -26,7 +26,7 @@ import Effect (Effect) ...@@ -26,7 +26,7 @@ import Effect (Effect)
import Gargantext.Components.AutoUpdate (autoUpdateElt) import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.Loader (loader) import Gargantext.Components.Loader (loader)
import Gargantext.Components.LoadingSpinner (loadingSpinner) import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Components.NgramsTable.Core (CoreState, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTablePatch, NgramsTerm, PageParams, PatchMap(..), Replace, Versioned(..), VersionedNgramsTable, _NgramsElement, _NgramsTable, _PatchMap, _children, _list, _ngrams, _occurrences, _root, addNewNgram, applyNgramsPatches, applyPatchSet, commitPatch, convOrderBy, fromNgramsPatches, initialPageParams, loadNgramsTableAll, ngramsTermText, normNgram, patchSetFromMap, replace, rootsOf, singletonNgramsTablePatch, syncPatches) import Gargantext.Components.NgramsTable.Core (CoreState, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTablePatch, NgramsTerm, PageParams, PatchMap(..), Replace(..), Versioned(..), VersionedNgramsTable, _NgramsElement, _NgramsTable, _PatchMap, _children, _list, _ngrams, _occurrences, _root, addNewNgram, applyNgramsPatches, applyPatchSet, commitPatch, convOrderBy, fromNgramsPatches, initialPageParams, loadNgramsTableAll, ngramsTermText, normNgram, patchSetFromMap, replace, rootsOf, singletonNgramsTablePatch, syncPatches)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, OrderBy(..), TabType, TermList(..), readTermList, readTermSize, termLists, termSizes) import Gargantext.Types (CTabNgramType, OrderBy(..), TabType, TermList(..), readTermList, readTermSize, termLists, termSizes)
...@@ -151,7 +151,7 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath ...@@ -151,7 +151,7 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
, name: "search" , name: "search"
, placeholder: "Search" , placeholder: "Search"
, type: "value" , type: "value"
, value: searchQuery , defaultValue: searchQuery
, on: {input: setSearchQuery <<< R2.unsafeEventValue}} , on: {input: setSearchQuery <<< R2.unsafeEventValue}}
, H.div {} ( , H.div {} (
if A.null props.tableBody && searchQuery /= "" then [ if A.null props.tableBody && searchQuery /= "" then [
...@@ -167,14 +167,14 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath ...@@ -167,14 +167,14 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
[ H.li {className: " list-group-item"} [ H.li {className: " list-group-item"}
[ R2.select { id: "picklistmenu" [ R2.select { id: "picklistmenu"
, className: "form-control custom-select" , className: "form-control custom-select"
, value: (maybe "" show termListFilter) , defaultValue: (maybe "" show termListFilter)
, on: {change: setTermListFilter <<< readTermList <<< R2.unsafeEventValue}} , on: {change: setTermListFilter <<< readTermList <<< R2.unsafeEventValue}}
(map optps1 termLists)]] (map optps1 termLists)]]
, H.div {className: "col-md-2", style: {marginTop : "6px"}} , H.div {className: "col-md-2", style: {marginTop : "6px"}}
[ H.li {className: "list-group-item"} [ H.li {className: "list-group-item"}
[ R2.select {id: "picktermtype" [ R2.select {id: "picktermtype"
, className: "form-control custom-select" , className: "form-control custom-select"
, value: (maybe "" show termSizeFilter) , defaultValue: (maybe "" show termSizeFilter)
, on: {change: setTermSizeFilter <<< readTermSize <<< R2.unsafeEventValue}} , on: {change: setTermSizeFilter <<< readTermSize <<< R2.unsafeEventValue}}
(map optps1 termSizes)]] (map optps1 termSizes)]]
, H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}} , H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}}
...@@ -271,9 +271,10 @@ loadedNgramsTableCpt = R.hooksComponent "G.C.NgramsTable.loadedNgramsTable" cpt ...@@ -271,9 +271,10 @@ loadedNgramsTableCpt = R.hooksComponent "G.C.NgramsTable.loadedNgramsTable" cpt
performNgramsAction Synchronize' = pure -- TODO performNgramsAction Synchronize' = pure -- TODO
type LoadedNgramsTableProps = type LoadedNgramsTableProps =
( tabNgramType :: CTabNgramType ( path :: R.State PageParams
, path :: R.State PageParams , tabNgramType :: CTabNgramType
, versioned :: VersionedNgramsTable , versioned :: VersionedNgramsTable
, withAutoUpdate :: Boolean
) )
loadedNgramsTableSpec :: Thermite.Spec State (Record LoadedNgramsTableProps) Action loadedNgramsTableSpec :: Thermite.Spec State (Record LoadedNgramsTableProps) Action
...@@ -323,20 +324,22 @@ loadedNgramsTableSpec = Thermite.simpleSpec performAction render ...@@ -323,20 +324,22 @@ loadedNgramsTableSpec = Thermite.simpleSpec performAction render
render :: Thermite.Render State (Record LoadedNgramsTableProps) Action render :: Thermite.Render State (Record LoadedNgramsTableProps) Action
render dispatch { path: path@({searchQuery, scoreType, params, termListFilter} /\ setPath) render dispatch { path: path@({searchQuery, scoreType, params, termListFilter} /\ setPath)
, versioned: Versioned { data: initTable } , versioned: Versioned { data: initTable }
, tabNgramType } , tabNgramType
, withAutoUpdate }
state@{ ngramsParent, ngramsChildren, ngramsLocalPatch state@{ ngramsParent, ngramsChildren, ngramsLocalPatch
, ngramsSelection, ngramsSelectAll } , ngramsSelection, ngramsSelectAll }
_reactChildren = _reactChildren =
[ autoUpdateElt { duration: 5000, effect: dispatch Synchronize } (autoUpdate <> [
, R2.scuff $ T.table { colNames R2.scuff $ T.table { colNames
, container , container
, params: params /\ setParams -- TODO-LENS , params: params /\ setParams -- TODO-LENS
, rows: filteredRows , rows: filteredRows
, totalRecords , totalRecords
, wrapColElts , wrapColElts
} }
] ])
where where
autoUpdate = if withAutoUpdate then [ autoUpdateElt { duration: 5000, effect: dispatch Synchronize } ] else []
totalRecords = A.length rows totalRecords = A.length rows
filteredRows = T.filterRows { params } rows filteredRows = T.filterRows { params } rows
colNames = T.ColumnName <$> ["Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy colNames = T.ColumnName <$> ["Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy
...@@ -413,6 +416,7 @@ type MainNgramsTableProps = ...@@ -413,6 +416,7 @@ type MainNgramsTableProps =
, tabType :: TabType , tabType :: TabType
, session :: Session , session :: Session
, tabNgramType :: CTabNgramType , tabNgramType :: CTabNgramType
, withAutoUpdate :: Boolean
) )
mainNgramsTable :: Record MainNgramsTableProps -> R.Element mainNgramsTable :: Record MainNgramsTableProps -> R.Element
...@@ -421,9 +425,14 @@ mainNgramsTable props = R.createElement mainNgramsTableCpt props [] ...@@ -421,9 +425,14 @@ mainNgramsTable props = R.createElement mainNgramsTableCpt props []
mainNgramsTableCpt :: R.Component MainNgramsTableProps mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponent "MainNgramsTable" cpt mainNgramsTableCpt = R.hooksComponent "MainNgramsTable" cpt
where where
cpt {nodeId, defaultListId, tabType, session, tabNgramType} _ = do cpt {nodeId, defaultListId, tabType, session, tabNgramType, withAutoUpdate} _ = do
path /\ setPath <- R.useState' $ initialPageParams session nodeId [defaultListId] tabType path /\ setPath <- R.useState' $ initialPageParams session nodeId [defaultListId] tabType
let paint versioned = loadedNgramsTable' {tabNgramType, path: path /\ setPath, versioned} let paint versioned = loadedNgramsTable' {
tabNgramType
, path: path /\ setPath
, versioned
, withAutoUpdate
}
pure $ loader path loadNgramsTableAll \loaded -> do pure $ loader path loadNgramsTableAll \loaded -> do
case Map.lookup tabType loaded of case Map.lookup tabType loaded of
...@@ -535,7 +544,7 @@ renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent ...@@ -535,7 +544,7 @@ renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent
, className "checkbox" , className "checkbox"
, checked chkd , checked chkd
, readOnly ngramsTransient , readOnly ngramsTransient
, onChange $ const $ when (not ngramsTransient) $ dispatch $ , onChange $ const $ dispatch $
  • I understand how you had to remove this. However, I'm wondering if we should keep when withAutoUpdate is true. What do you think?

  • I don't know. If user quickly checks and unchecks a term it will result in an empty patch with current code. With previous code you couldn't uncheck whatever you did, had to wait for patch and then find the term again.

Please register or sign in to reply
setTermListA ngrams (replace termList termList'') setTermListA ngrams (replace termList termList'')
] ]
ngramsTransient = tablePatchHasNgrams ngramsLocalPatch ngrams ngramsTransient = tablePatchHasNgrams ngramsLocalPatch ngrams
...@@ -562,5 +571,5 @@ nextTermList StopTerm = CandidateTerm ...@@ -562,5 +571,5 @@ nextTermList StopTerm = CandidateTerm
nextTermList CandidateTerm = GraphTerm nextTermList CandidateTerm = GraphTerm
optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> R.Element optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> R.Element
optps1 { desc, mval } = H.option {value} [H.text desc] optps1 { desc, mval } = H.option { defaultValue: value } [H.text desc]
where value = maybe "" show mval where value = maybe "" show mval
...@@ -336,14 +336,14 @@ replace old new ...@@ -336,14 +336,14 @@ replace old new
| old == new = Keep | old == new = Keep
| otherwise = Replace { old, new } | otherwise = Replace { old, new }
instance semigroupReplace :: Semigroup (Replace a) where derive instance eqReplace :: Eq a => Eq (Replace a)
instance semigroupReplace :: Eq a => Semigroup (Replace a) where
append Keep p = p append Keep p = p
append p Keep = p append p Keep = p
append (Replace { old: _m, new }) (Replace { old, new: _m' }) = append (Replace { new }) (Replace { old }) = replace old new
  • Great work here, this was indeed needed to keep the patches small. However I'd like to keep the comment and potentially expand it. In theory one shouldn't merge patches where the middle parts are different. Now that we have the Eq constraint we can actually assert it. If we ever merge patches in a wrong way, I'd rather get an error immediately.

  • Hm, ok, sounds good, will fix.

  • ecb2608c Is this OK?

  • Yes!

Please register or sign in to reply
-- assert _m == _m'
Replace { old, new }
instance semigroupMonoid :: Monoid (Replace a) where instance semigroupMonoid :: Eq a => Monoid (Replace a) where
mempty = Keep mempty = Keep
applyReplace :: forall a. Eq a => Replace a -> a -> a applyReplace :: forall a. Eq a => Replace a -> a -> a
...@@ -419,6 +419,9 @@ newtype NgramsPatch = NgramsPatch ...@@ -419,6 +419,9 @@ newtype NgramsPatch = NgramsPatch
, patch_list :: Replace TermList , patch_list :: Replace TermList
} }
derive instance eqNgramsPatch :: Eq NgramsPatch
derive instance eqPatchSetNgramsTerm :: Eq (PatchSet NgramsTerm)
instance semigroupNgramsPatch :: Semigroup NgramsPatch where instance semigroupNgramsPatch :: Semigroup NgramsPatch where
append (NgramsPatch p) (NgramsPatch q) = NgramsPatch append (NgramsPatch p) (NgramsPatch q) = NgramsPatch
{ patch_children: p.patch_children <> q.patch_children { patch_children: p.patch_children <> q.patch_children
...@@ -455,10 +458,12 @@ applyNgramsPatch (NgramsPatch p) (NgramsElement e) = NgramsElement ...@@ -455,10 +458,12 @@ applyNgramsPatch (NgramsPatch p) (NgramsElement e) = NgramsElement
newtype PatchMap k p = PatchMap (Map k p) newtype PatchMap k p = PatchMap (Map k p)
instance semigroupPatchMap :: (Ord k, Semigroup p) => Semigroup (PatchMap k p) where instance semigroupPatchMap :: (Ord k, Eq p, Monoid p) => Semigroup (PatchMap k p) where
append (PatchMap p) (PatchMap q) = PatchMap (Map.unionWith append p q) append (PatchMap p) (PatchMap q) = PatchMap pMap
where
pMap = Map.filter (\v -> v /= mempty) $ Map.unionWith append p q
  • Nice work here too!

    If we assume p and q are both without empty patches, we could use something more advanced than Map.unionWith.

    In Haskell, I used the merge API https://hackage.haskell.org/package/containers-0.6.2.1/docs/Data-Map-Merge-Strict.html, which I think is missing in PS.

  • Well, I don't quite get it. It's just monoid append, doesn't matter if p and q are with empty patches or not. I guess you mean the Map.filter part? I just added it so that later the ngramsTransient part from above is a bit easier to write.

  • Yes I meant that we can avoid the filter when using a more flexible merge function.

Please register or sign in to reply
instance monoidPatchMap :: (Ord k, Semigroup p) => Monoid (PatchMap k p) where instance monoidPatchMap :: (Ord k, Eq p, Monoid p) => Monoid (PatchMap k p) where
mempty = PatchMap Map.empty mempty = PatchMap Map.empty
derive instance newtypePatchMap :: Newtype (PatchMap k p) _ derive instance newtypePatchMap :: Newtype (PatchMap k p) _
......
...@@ -84,7 +84,7 @@ type NgramsViewTabsProps = ...@@ -84,7 +84,7 @@ type NgramsViewTabsProps =
ngramsView :: Record NgramsViewTabsProps -> R.Element ngramsView :: Record NgramsViewTabsProps -> R.Element
ngramsView {session,mode, defaultListId, nodeId} = ngramsView {session,mode, defaultListId, nodeId} =
NT.mainNgramsTable NT.mainNgramsTable
{ nodeId, defaultListId, tabType, session, tabNgramType } { nodeId, defaultListId, tabType, session, tabNgramType, withAutoUpdate: false }
where where
tabNgramType = modeTabType' mode tabNgramType = modeTabType' mode
tabType = TabPairing $ TabNgramType $ modeTabType mode tabType = TabPairing $ TabNgramType $ modeTabType mode
...@@ -46,7 +46,7 @@ ngramsViewCpt = R.staticComponent "ListsNgramsView" cpt ...@@ -46,7 +46,7 @@ ngramsViewCpt = R.staticComponent "ListsNgramsView" cpt
R.fragment R.fragment
[ chart mode [ chart mode
, NT.mainNgramsTable , NT.mainNgramsTable
{session, defaultListId, nodeId: corpusId, tabType, tabNgramType} {session, defaultListId, nodeId: corpusId, tabType, tabNgramType, withAutoUpdate: false}
] ]
where where
tabNgramType = modeTabType mode tabNgramType = modeTabType mode
......
...@@ -146,7 +146,7 @@ tableCpt = R.hooksComponent "G.C.Table.table" cpt ...@@ -146,7 +146,7 @@ tableCpt = R.hooksComponent "G.C.Table.table" cpt
Just (ASC d) | c == d -> [lnk (Just (DESC c)) "ASC ", lnk Nothing (columnName c)] Just (ASC d) | c == d -> [lnk (Just (DESC c)) "ASC ", lnk Nothing (columnName c)]
Just (DESC d) | c == d -> [lnk (Just (ASC c)) "DESC ", lnk Nothing (columnName c)] Just (DESC d) | c == d -> [lnk (Just (ASC c)) "DESC ", lnk Nothing (columnName c)]
_ -> [lnk (Just (ASC c)) (columnName c)] _ -> [lnk (Just (ASC c)) (columnName c)]
R.useEffect2' params state do R.useEffect2' (fst params) state do
  • I don't see the other part of the change. Did params changed type?

  • No, but useEffect2' bases on React comparing JS objects, basically. Now, since params is a state tuple, it turns out to better just cache results by state value, i.e. fst params and not state function. I had an error in caching couple of times because of observing the state function as well. I think that the JS data type underlying a PS tuple is just too complex for React to observe.

Please register or sign in to reply
when (fst params /= stateParams state) $ (snd params) (const $ stateParams state) when (fst params /= stateParams state) $ (snd params) (const $ stateParams state)
pure $ container pure $ container
{ pageSizeControl: sizeDD pageSize { pageSizeControl: sizeDD pageSize
......
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