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 $
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
-- 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
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
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