Skip to content

P
purescript-gargantext
Commit a7e6df4d authored by Nicolas Pouillard's avatar Nicolas Pouillard
Browse files
Options

[Document,NgramsTable] merge the actions into CoreAction, add Sync/Reset buttons on Document

parent 44e72451
Hide whitespace changes
Inline Side-by-side
Showing with 132 additions and 112 deletions
src/Gargantext/Components/NgramsTable.purs
View file @ a7e6df4d
......@@ -16,18 +16,15 @@ import Data.Map as Map
import Data.Maybe (Maybe(..), isNothing, maybe)
import Data.Monoid.Additive (Additive(..))
import Data.Ord.Down (Down(..))
import Data.Sequence as Seq
import Data.Sequence (Seq, length) as Seq
import Data.Set (Set)
import Data.Set as Set
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import FFI.Simple (delay)
import Reactix as R
import Reactix (Component, Element, State, createElement, fragment, hooksComponentWithModule, unsafeEventValue, useState') as R
import Reactix.DOM.HTML as H
import Unsafe.Coerce (unsafeCoerce)
......@@ -45,8 +42,9 @@ import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermL
import Gargantext.Utils (queryMatchesLabel, toggleSet, sortWith)
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Seq as Seq
import Gargantext.Utils.Seq (mapMaybe) as Seq
thisModule :: String
thisModule = "Gargantext.Components.NgramsTable"
type State' =
......@@ -103,7 +101,7 @@ initialState (Versioned {version}) = {
setTermListSetA :: NgramsTable -> Set NgramsTerm -> TermList -> Action
setTermListSetA ngramsTable ns new_list =
CommitPatch $ fromNgramsPatches $ PatchMap $ mapWithIndex f $ toMap ns
CoreAction $ CommitPatch $ fromNgramsPatches $ PatchMap $ mapWithIndex f $ toMap ns
where
f :: NgramsTerm -> Unit -> NgramsPatch
f n unit = NgramsPatch { patch_list, patch_children: mempty }
......@@ -116,9 +114,6 @@ setTermListSetA ngramsTable ns new_list =
-- https://github.com/purescript/purescript-ordered-collections/pull/31
-- toMap = Map.fromFoldable
addNewNgramA :: NgramsTerm -> Action
addNewNgramA ngram = CommitPatch $ addNewNgram ngram CandidateTerm
type PreConversionRows = Seq.Seq NgramsElement
type TableContainerProps =
......@@ -157,8 +152,10 @@ tableContainerCpt { dispatch
H.li { className: "list-group-item" } [
H.button { className: "btn btn-primary"
, on: { click: const $ dispatch
$ CoreAction
$ addNewNgramA
$ normNgram tabNgramType searchQuery
(normNgram tabNgramType searchQuery)
CandidateTerm
}
}
[ H.text ("Add " <> searchQuery) ]
......@@ -303,8 +300,12 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
, versioned: Versioned { data: initTable }
, withAutoUpdate } _ = do
let syncResetBtns = [syncResetButtons { afterSync, ngramsLocalPatch
, performAction: performAction <<< CoreAction
}]
pure $ R.fragment $
autoUpdate <> [syncResetButtons { afterSync, ngramsLocalPatch, performAction }] <> [
autoUpdate <> syncResetBtns <> [
H.h4 {style: {textAlign : "center"}} [
H.span {className: "glyphicon glyphicon-hand-down"} []
, H.text "Extracted Terms"
......@@ -327,13 +328,13 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
, ngramsSelection
}
}
] <> [syncResetButtons { afterSync, ngramsLocalPatch, performAction }]
] <> syncResetBtns
where
autoUpdate :: Array R.Element
autoUpdate = if withAutoUpdate then
[ R2.buff $ autoUpdateElt {
duration: 5000
, effect: performAction $ Synchronize { afterSync }
, effect: performAction $ CoreAction $ Synchronize { afterSync }
} ]
else []
......@@ -357,11 +358,6 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
s { ngramsSelection = Set.empty :: Set NgramsTerm }
else
s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
performAction (Synchronize { afterSync }) = syncPatches path' (state /\ setState) afterSync
performAction (CommitPatch pt) =
commitPatch (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
performAction ResetPatches =
setState $ \s -> s { ngramsLocalPatch = { ngramsPatches: mempty } }
performAction AddTermChildren =
case ngramsParent of
Nothing ->
......@@ -373,6 +369,7 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
pt = singletonNgramsTablePatch parent pe
setState $ setParentResetChildren Nothing
commitPatch (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
performAction (CoreAction a) = coreDispatch path' (state /\ setState) a
totalRecords = Seq.length rows
filteredConvertedRows :: T.Rows
......@@ -444,41 +441,6 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
setSearchQuery x = setPath $ _ { searchQuery = x }
type SyncResetButtonsProps = (
afterSync :: Unit -> Aff Unit
, ngramsLocalPatch :: NgramsTablePatch
, performAction :: Action -> Effect Unit
)
syncResetButtons :: Record SyncResetButtonsProps -> R.Element
syncResetButtons p = R.createElement syncResetButtonsCpt p []
syncResetButtonsCpt :: R.Component SyncResetButtonsProps
syncResetButtonsCpt = R.hooksComponentWithModule thisModule "syncResetButtons" cpt
where
cpt { afterSync, ngramsLocalPatch, performAction } _ = do
synchronizing@(s /\ _) <- R.useState' false
let hasChanges = ngramsLocalPatch /= mempty
pure $ H.div {} [
H.button { className: "btn btn-danger " <> if hasChanges then "" else " disabled"
, on: { click: \_ -> performAction ResetPatches }
} [ H.text "Reset" ]
, H.button { className: "btn btn-primary " <> (if s || (not hasChanges) then "disabled" else "")
, on: { click: synchronize synchronizing }
} [ H.text "Sync" ]
]
where
synchronize (_ /\ setSynchronizing) _ = delay unit $ \_ -> do
setSynchronizing $ const true
performAction $ Synchronize { afterSync: newAfterSync }
where
newAfterSync x = do
afterSync x
liftEffect $ setSynchronizing $ const false
displayRow :: State -> SearchQuery -> NgramsTable -> Maybe NgramsTerm -> Maybe TermList -> Maybe TermSize -> NgramsElement -> Boolean
displayRow state@{ ngramsChildren
, ngramsLocalPatch
......
src/Gargantext/Components/NgramsTable/Components.purs
View file @ a7e6df4d
......@@ -17,7 +17,12 @@ import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.NgramsTable.Core (Action(..), Dispatch, NgramsElement, NgramsPatch(..), NgramsTable, NgramsTablePatch, NgramsTerm, Replace, _NgramsElement, _NgramsRepoElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace, singletonNgramsTablePatch)
import Gargantext.Components.NgramsTable.Core ( Action(..), Dispatch, NgramsElement, NgramsPatch(..)
, NgramsTable, NgramsTablePatch, NgramsTerm, Replace
, _NgramsElement, _NgramsRepoElement, _PatchMap, _children
, _list, _ngrams, _occurrences, ngramsTermText, replace
, singletonNgramsTablePatch, setTermListA
)
import Gargantext.Components.Table as Tbl
import Gargantext.Types as T
import Gargantext.Utils.Reactix as R2
......@@ -207,7 +212,7 @@ renderNgramsItemCpt = R.hooksComponentWithModule thisModule "renderNgramsItem" c
ngramsStyle = [termStyle termList ngramsOpacity]
ngramsEdit = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams
ngramsClick
= Just <<< dispatch <<< cycleTermListItem <<< view _ngrams
= Just <<< dispatch <<< CoreAction <<< cycleTermListItem <<< view _ngrams
-- ^ This is the old behavior it is nicer to use since one can
-- rapidly change the ngram list without waiting for confirmation.
-- However this might expose bugs. One of them can be reproduced
......@@ -226,7 +231,7 @@ renderNgramsItemCpt = R.hooksComponentWithModule thisModule "renderNgramsItem" c
in
H.input { checked: chkd
, className: "checkbox"
, on: { change: const $ dispatch $
, on: { change: const $ dispatch $ CoreAction $
setTermListA ngrams (replace termList termList'') }
, readOnly: ngramsTransient
, type: "checkbox" }
......@@ -245,13 +250,6 @@ termStyle T.StopTerm opacity = DOM.style { color: "red", opacity
, textDecoration: "line-through" }
termStyle T.CandidateTerm opacity = DOM.style { color: "black", opacity }
setTermListA :: NgramsTerm -> Replace T.TermList -> Action
setTermListA n patch_list =
CommitPatch $
singletonNgramsTablePatch n $
NgramsPatch { patch_list, patch_children: mempty }
tablePatchHasNgrams :: NgramsTablePatch -> NgramsTerm -> Boolean
tablePatchHasNgrams ngramsTablePatch ngrams =
isJust $ ngramsTablePatch.ngramsPatches ^. _PatchMap <<< at ngrams
......
src/Gargantext/Components/NgramsTable/Core.purs
View file @ a7e6df4d
......@@ -51,11 +51,20 @@ module Gargantext.Components.NgramsTable.Core
, commitPatch
, putNgramsPatches
, syncPatches
, addNewNgram
, addNewNgramP
, addNewNgramA
, setTermListP
, setTermListA
, CoreAction(..)
, CoreDispatch
, Action(..)
, Dispatch
, coreDispatch
, isSingleNgramsTerm
, filterTermSize
, SyncResetButtonsProps
, syncResetButtons
, syncResetButtonsCpt
)
where
......@@ -107,7 +116,9 @@ import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Exception.Unsafe (unsafeThrow)
import Foreign.Object as FO
import Reactix (State) as R
import FFI.Simple.Functions (delay)
import Reactix as R
import Reactix.DOM.HTML as H
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
......@@ -118,6 +129,9 @@ import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (CTabNgramType(..), OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
import Gargantext.Utils.KarpRabin (indicesOfAny)
thisModule :: String
thisModule = "Gargantext.Components.NgramsTable.Core"
type Endo a = a -> a
type CoreParams s =
......@@ -864,10 +878,21 @@ newNgramPatch list =
}
}
addNewNgram :: NgramsTerm -> TermList -> NgramsTablePatch
addNewNgram ngrams list =
addNewNgramP :: NgramsTerm -> TermList -> NgramsTablePatch
addNewNgramP ngrams list =
{ ngramsPatches: singletonPatchMap ngrams (newNgramPatch list) }
addNewNgramA :: NgramsTerm -> TermList -> CoreAction
addNewNgramA ngrams list = CommitPatch $ addNewNgramP ngrams list
setTermListP :: NgramsTerm -> Replace TermList -> NgramsTablePatch
setTermListP ngram patch_list = singletonNgramsTablePatch ngram pe
where
pe = NgramsPatch { patch_list, patch_children: mempty }
setTermListA :: NgramsTerm -> Replace TermList -> CoreAction
setTermListA ngram termList = CommitPatch $ setTermListP ngram termList
putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff VersionedNgramsPatches
putNgramsPatches {session, nodeId, listIds, tabType} = put session putNgrams
where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId)
......@@ -949,9 +974,13 @@ convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc
convOrderBy (T.ASC _) = TermAsc
convOrderBy (T.DESC _) = TermDesc
data CoreAction
= CommitPatch NgramsTablePatch
| Synchronize { afterSync :: Unit -> Aff Unit }
| ResetPatches
data Action
= CommitPatch NgramsTablePatch
= CoreAction CoreAction
| SetParentResetChildren (Maybe NgramsTerm)
-- ^ This sets `ngramsParent` and resets `ngramsChildren`.
| ToggleChild Boolean NgramsTerm
......@@ -959,15 +988,22 @@ 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 { afterSync :: Unit -> Aff Unit }
| ToggleSelect NgramsTerm
-- ^ Toggles the NgramsTerm in the `Set` `ngramsSelection`.
| ToggleSelectAll
| ResetPatches
type CoreDispatch = CoreAction -> Effect Unit
type Dispatch = Action -> Effect Unit
coreDispatch :: forall p s. CoreParams p -> R.State (CoreState s) -> CoreDispatch
coreDispatch path state (Synchronize { afterSync }) =
syncPatches path state afterSync
coreDispatch _ state@({ngramsVersion} /\ _) (CommitPatch pt) =
commitPatch (Versioned {version: ngramsVersion, data: pt}) state
coreDispatch _ (_ /\ setState) ResetPatches =
setState $ \s -> s { ngramsLocalPatch = { ngramsPatches: mempty } }
isSingleNgramsTerm :: NgramsTerm -> Boolean
isSingleNgramsTerm nt = isSingleTerm $ ngramsTermText nt
where
......@@ -980,3 +1016,38 @@ filterTermSize :: Maybe TermSize -> NgramsTerm -> Boolean
filterTermSize (Just MonoTerm) nt = isSingleNgramsTerm nt
filterTermSize (Just MultiTerm) nt = not $ isSingleNgramsTerm nt
filterTermSize _ _ = true
type SyncResetButtonsProps =
( afterSync :: Unit -> Aff Unit
, ngramsLocalPatch :: NgramsTablePatch
, performAction :: CoreDispatch
)
syncResetButtons :: Record SyncResetButtonsProps -> R.Element
syncResetButtons p = R.createElement syncResetButtonsCpt p []
syncResetButtonsCpt :: R.Component SyncResetButtonsProps
syncResetButtonsCpt = R.hooksComponentWithModule thisModule "syncResetButtons" cpt
where
cpt { afterSync, ngramsLocalPatch, performAction } _ = do
synchronizing@(s /\ setSynchronizing) <- R.useState' false
let
hasChanges = ngramsLocalPatch /= mempty
newAfterSync x = do
afterSync x
liftEffect $ setSynchronizing $ const false
synchronizeClick _ = delay unit $ \_ -> do
setSynchronizing $ const true
performAction $ Synchronize { afterSync: newAfterSync }
pure $ H.div {} [
H.button { className: "btn btn-danger " <> if hasChanges then "" else " disabled"
, on: { click: \_ -> performAction ResetPatches }
} [ H.text "Reset" ]
, H.button { className: "btn btn-primary " <> (if s || (not hasChanges) then "disabled" else "")
, on: { click: synchronizeClick }
} [ H.text "Sync" ]
]
\ No newline at end of file
src/Gargantext/Components/Nodes/Annuaire/User/Contacts.purs
View file @ a7e6df4d
......@@ -26,6 +26,7 @@ import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, get, put, sessionId)
import Gargantext.Types (NodeType(..))
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Annuaire.User.Contacts"
display :: String -> Array R.Element -> R.Element
......
src/Gargantext/Components/Nodes/Corpus/Document.purs
View file @ a7e6df4d
module Gargantext.Components.Nodes.Corpus.Document where
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Prelude (bind, pure, show, unit, ($), (<>))
import Gargantext.Components.AutoUpdate (autoUpdate)
import Gargantext.Components.Search (SearchType(..))
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus.Document.Types
import Gargantext.Components.Nodes.Corpus.Document.Types (DocPath, Document(..), LoadedData, NodeDocument, Props, State, initialState)
import Gargantext.Components.NgramsTable.Core
( CoreState, NgramsPatch(..), NgramsTerm, Replace, Versioned(..)
, VersionedNgramsTable, addNewNgram, applyNgramsPatches, commitPatch
, loadNgramsTable, replace, singletonNgramsTablePatch, syncPatches )
( CoreAction(..), Versioned(..), addNewNgramA, applyNgramsPatches, coreDispatch, loadNgramsTable
, replace, setTermListA, syncResetButtons )
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..))
......@@ -62,11 +57,26 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
where
cpt { path
, loaded: loaded@{ ngramsTable: Versioned { data: initTable }, document }
, state: state@({ ngramsVersion: version } /\ _)
, state: state@({ ngramsVersion: version, ngramsLocalPatch } /\ _)
} _children = do
pure $ H.div {} [
autoUpdate { duration: 3000, effect: dispatch Synchronize }
, H.div { className: "container1" }
let
afterSync = \_ -> pure unit
syncResetBtns = [syncResetButtons { afterSync, ngramsLocalPatch
, performAction: dispatch
}]
withAutoUpdate = false
autoUpd :: Array R.Element
autoUpd = if withAutoUpdate then
[ autoUpdate { duration: 5000
, effect: dispatch $ Synchronize { afterSync }
}
]
else []
pure $ H.div {} $
autoUpd <> syncResetBtns <> [
H.div { className: "container1" }
[
R2.row
[
......@@ -94,24 +104,15 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
]
]
where
dispatch :: Action -> Effect Unit
dispatch (AddNewNgram ngram termList) = do
commitPatch (Versioned {version, data: addNewNgram ngram termList}) state
dispatch (SetTermListItem ngram termList) = do
commitPatch (Versioned {version, data: pt}) state
where
pe = NgramsPatch { patch_list: termList, patch_children: mempty }
pt = singletonNgramsTablePatch ngram pe
dispatch Synchronize = do
syncPatches path state (\_ -> pure unit)
dispatch = coreDispatch path state
ngrams = applyNgramsPatches (fst state) initTable
annotate text = AnnotatedField.annotatedField { ngrams
, setTermList
, text }
badge s = H.span { className: "badge badge-default badge-pill" } [ H.text s ]
li' = H.li { className: "list-group-item justify-content-between" }
setTermList ngram Nothing newList = dispatch (AddNewNgram ngram newList)
setTermList ngram (Just oldList) newList = dispatch (SetTermListItem ngram (replace oldList newList))
setTermList ngram Nothing newList = dispatch (addNewNgramA ngram newList)
setTermList ngram (Just oldList) newList = dispatch (setTermListA ngram (replace oldList newList))
text' x = H.text $ fromMaybe "Nothing" x
NodePoly {hyperdata: Document doc} = document
......
src/Gargantext/Components/Nodes/Corpus/Document/Types.purs
View file @ a7e6df4d
......@@ -8,15 +8,12 @@ import Data.Maybe (Maybe(..))
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.NgramsTable.Core
(CoreState, NgramsTerm, Replace, Versioned(..) , VersionedNgramsTable)
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Components.NgramsTable.Core (CoreState, Versioned(..) , VersionedNgramsTable)
import Gargantext.Sessions (Session)
import Gargantext.Types (TabType, TermList)
import Gargantext.Types (TabType)
type DocPath =
{
corpusId :: Maybe Int
{ corpusId :: Maybe Int
, listIds :: Array Int
, nodeId :: Int
, session :: Session
......@@ -50,12 +47,6 @@ initialState {loaded: {ngramsTable: Versioned {version}}} =
, ngramsVersion: version
}
-- This is a subset of NgramsTable.Action.
data Action
= SetTermListItem NgramsTerm (Replace TermList)
| AddNewNgram NgramsTerm TermList
| Synchronize
newtype Status = Status { failed :: Int
, succeeded :: Int
, remaining :: Int
......
src/Gargantext/Components/Nodes/Lists.purs
View file @ a7e6df4d
......@@ -14,7 +14,6 @@ import Gargantext.Components.Table as Table
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Lists"
......
src/Gargantext/Components/Nodes/Lists/Tabs.purs
View file @ a7e6df4d
module Gargantext.Components.Nodes.Lists.Tabs where
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
......
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