Skip to content

P
purescript-gargantext
Commit a921828a authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski Committed by Alexandre Delanoë
Browse files
Options

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

parent a64c25b2
Hide whitespace changes
Inline Side-by-side
Showing with 39 additions and 25 deletions
src/Gargantext/Components/NgramsTable.purs
View file @ a921828a
......@@ -26,7 +26,7 @@ import Effect (Effect)
import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.Loader (loader)
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.Sessions (Session)
import Gargantext.Types (CTabNgramType, OrderBy(..), TabType, TermList(..), readTermList, readTermSize, termLists, termSizes)
......@@ -151,7 +151,7 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
, name: "search"
, placeholder: "Search"
, type: "value"
, value: searchQuery
, defaultValue: searchQuery
, on: {input: setSearchQuery <<< R2.unsafeEventValue}}
, H.div {} (
if A.null props.tableBody && searchQuery /= "" then [
......@@ -167,14 +167,14 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
[ H.li {className: " list-group-item"}
[ R2.select { id: "picklistmenu"
, className: "form-control custom-select"
, value: (maybe "" show termListFilter)
, defaultValue: (maybe "" show termListFilter)
, on: {change: setTermListFilter <<< readTermList <<< R2.unsafeEventValue}}
(map optps1 termLists)]]
, H.div {className: "col-md-2", style: {marginTop : "6px"}}
[ H.li {className: "list-group-item"}
[ R2.select {id: "picktermtype"
, className: "form-control custom-select"
, value: (maybe "" show termSizeFilter)
, defaultValue: (maybe "" show termSizeFilter)
, on: {change: setTermSizeFilter <<< readTermSize <<< R2.unsafeEventValue}}
(map optps1 termSizes)]]
, H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}}
......@@ -271,9 +271,10 @@ loadedNgramsTableCpt = R.hooksComponent "G.C.NgramsTable.loadedNgramsTable" cpt
performNgramsAction Synchronize' = pure -- TODO
type LoadedNgramsTableProps =
( tabNgramType :: CTabNgramType
, path :: R.State PageParams
( path :: R.State PageParams
, tabNgramType :: CTabNgramType
, versioned :: VersionedNgramsTable
, withAutoUpdate :: Boolean
)
loadedNgramsTableSpec :: Thermite.Spec State (Record LoadedNgramsTableProps) Action
......@@ -323,20 +324,22 @@ loadedNgramsTableSpec = Thermite.simpleSpec performAction render
render :: Thermite.Render State (Record LoadedNgramsTableProps) Action
render dispatch { path: path@({searchQuery, scoreType, params, termListFilter} /\ setPath)
, versioned: Versioned { data: initTable }
, tabNgramType }
, tabNgramType
, withAutoUpdate }
state@{ ngramsParent, ngramsChildren, ngramsLocalPatch
, ngramsSelection, ngramsSelectAll }
_reactChildren =
[ autoUpdateElt { duration: 5000, effect: dispatch Synchronize }
, R2.scuff $ T.table { colNames
(autoUpdate <> [
R2.scuff $ T.table { colNames
, container
, params: params /\ setParams -- TODO-LENS
, rows: filteredRows
, totalRecords
, wrapColElts
}
]
])
where
autoUpdate = if withAutoUpdate then [ autoUpdateElt { duration: 5000, effect: dispatch Synchronize } ] else []
totalRecords = A.length rows
filteredRows = T.filterRows { params } rows
colNames = T.ColumnName <$> ["Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy
......@@ -413,6 +416,7 @@ type MainNgramsTableProps =
, tabType :: TabType
, session :: Session
, tabNgramType :: CTabNgramType
, withAutoUpdate :: Boolean
)
mainNgramsTable :: Record MainNgramsTableProps -> R.Element
......@@ -421,9 +425,14 @@ mainNgramsTable props = R.createElement mainNgramsTableCpt props []
mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponent "MainNgramsTable" cpt
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
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
case Map.lookup tabType loaded of
......@@ -535,7 +544,7 @@ renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent
, className "checkbox"
, checked chkd
, readOnly ngramsTransient
, onChange $ const $ when (not ngramsTransient) $ dispatch $
, onChange $ const $ dispatch $
setTermListA ngrams (replace termList termList'')
]
ngramsTransient = tablePatchHasNgrams ngramsLocalPatch ngrams
......@@ -562,5 +571,5 @@ nextTermList StopTerm = CandidateTerm
nextTermList CandidateTerm = GraphTerm
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
src/Gargantext/Components/NgramsTable/Core.purs
View file @ a921828a
......@@ -336,14 +336,14 @@ replace old new
| old == new = Keep
| 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 p Keep = p
append (Replace { old: _m, new }) (Replace { old, new: _m' }) =
-- assert _m == _m'
Replace { old, new }
append (Replace { new }) (Replace { old }) = replace old new
instance semigroupMonoid :: Monoid (Replace a) where
instance semigroupMonoid :: Eq a => Monoid (Replace a) where
mempty = Keep
applyReplace :: forall a. Eq a => Replace a -> a -> a
......@@ -419,6 +419,9 @@ newtype NgramsPatch = NgramsPatch
, patch_list :: Replace TermList
}
derive instance eqNgramsPatch :: Eq NgramsPatch
derive instance eqPatchSetNgramsTerm :: Eq (PatchSet NgramsTerm)
instance semigroupNgramsPatch :: Semigroup NgramsPatch where
append (NgramsPatch p) (NgramsPatch q) = NgramsPatch
{ patch_children: p.patch_children <> q.patch_children
......@@ -455,10 +458,12 @@ applyNgramsPatch (NgramsPatch p) (NgramsElement e) = NgramsElement
newtype PatchMap k p = PatchMap (Map k p)
instance semigroupPatchMap :: (Ord k, Semigroup p) => Semigroup (PatchMap k p) where
append (PatchMap p) (PatchMap q) = PatchMap (Map.unionWith append p q)
instance semigroupPatchMap :: (Ord k, Eq p, Monoid p) => Semigroup (PatchMap k p) where
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
derive instance newtypePatchMap :: Newtype (PatchMap k p) _
......
src/Gargantext/Components/Nodes/Annuaire/User/Contacts/Tabs.purs
View file @ a921828a
......@@ -84,7 +84,7 @@ type NgramsViewTabsProps =
ngramsView :: Record NgramsViewTabsProps -> R.Element
ngramsView {session,mode, defaultListId, nodeId} =
NT.mainNgramsTable
{ nodeId, defaultListId, tabType, session, tabNgramType }
{ nodeId, defaultListId, tabType, session, tabNgramType, withAutoUpdate: false }
where
tabNgramType = modeTabType' mode
tabType = TabPairing $ TabNgramType $ modeTabType mode
src/Gargantext/Components/Nodes/Lists/Tabs.purs
View file @ a921828a
......@@ -46,7 +46,7 @@ ngramsViewCpt = R.staticComponent "ListsNgramsView" cpt
R.fragment
[ chart mode
, NT.mainNgramsTable
{session, defaultListId, nodeId: corpusId, tabType, tabNgramType}
{session, defaultListId, nodeId: corpusId, tabType, tabNgramType, withAutoUpdate: false}
]
where
tabNgramType = modeTabType mode
......
src/Gargantext/Components/Table.purs
View file @ a921828a
......@@ -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 (DESC d) | c == d -> [lnk (Just (ASC c)) "DESC ", lnk Nothing (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)
pure $ container
{ 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