diff --git a/src/Gargantext/Components/NgramsTable/Core.purs b/src/Gargantext/Components/NgramsTable/Core.purs index c0a55620a031fbedc0c2fd9ed179b12815bbbbfa..4a15dde80637b79c8d9b6981242871d450f156ab 100644 --- a/src/Gargantext/Components/NgramsTable/Core.purs +++ b/src/Gargantext/Components/NgramsTable/Core.purs @@ -33,7 +33,7 @@ module Gargantext.Components.NgramsTable.Core , _PatchMap , patchSetFromMap , applyPatchSet - , applyNgramsTablePatch +--, applyNgramsTablePatch -- re-export only if we have a good reason not to use applyNgramsPatches , applyNgramsPatches , rootsOf , singletonPatchMap @@ -501,7 +501,7 @@ 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 }) (Replace { new }) | old /= new = unsafeThrow "old != new" + append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow "old != new" append (Replace { new }) (Replace { old }) = replace old new instance semigroupMonoid :: Eq a => Monoid (Replace a) where @@ -597,7 +597,9 @@ invert :: forall a. a -> a invert _ = unsafeThrow "invert: TODO" instance semigroupNgramsPatch :: Semigroup NgramsPatch where - append (NgramsReplace p) (NgramsReplace q) = ngramsReplace q.patch_old p.patch_new + append (NgramsReplace p) (NgramsReplace q) + | p.patch_old /= q.patch_new = unsafeThrow "append/NgramsPatch: old != new" + | otherwise = ngramsReplace q.patch_old p.patch_new append (NgramsPatch p) (NgramsPatch q) = NgramsPatch { patch_children: p.patch_children <> q.patch_children , patch_list: p.patch_list <> q.patch_list diff --git a/src/Gargantext/Components/Nodes/Corpus/Document.purs b/src/Gargantext/Components/Nodes/Corpus/Document.purs index 831b36704a75204b845475ac8a9407c0eb4eb531..3e6bd13515e787295724b01370eed8556ee69f96 100644 --- a/src/Gargantext/Components/Nodes/Corpus/Document.purs +++ b/src/Gargantext/Components/Nodes/Corpus/Document.purs @@ -4,6 +4,7 @@ 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) @@ -17,7 +18,7 @@ import Gargantext.Components.Search (SearchType(..)) import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.NgramsTable.Core ( CoreState, NgramsPatch(..), NgramsTerm, Replace, Versioned(..) - , VersionedNgramsTable, addNewNgram, applyNgramsTablePatch, commitPatch + , VersionedNgramsTable, addNewNgram, applyNgramsPatches, commitPatch , loadNgramsTable, replace, singletonNgramsTablePatch, syncPatches ) import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField import Gargantext.Hooks.Loader (useLoader) @@ -321,7 +322,10 @@ docView props = R.createElement docViewCpt props [] docViewCpt :: R.Component DocViewProps docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt where - cpt props@{ loaded: loaded@{ ngramsTable: Versioned { data: initTable }, document }, state } _ = do + cpt { path + , loaded: loaded@{ ngramsTable: Versioned { data: initTable }, document } + , state: state@({ ngramsVersion: version } /\ _) + } _children = do pure $ H.div {} [ autoUpdate { duration: 3000, effect: dispatch Synchronize } , H.div { className: "container1" } @@ -329,7 +333,7 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt R2.row [ R2.col 8 - [ H.h4 {} [ annotate state doc.title ] + [ H.h4 {} [ annotate doc.title ] , H.ul { className: "list-group" } [ li' [ H.span {} [ text' doc.source ] , badge "source" @@ -343,7 +347,7 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt ] ] , badge "abstract" - , annotate state doc.abstract + , annotate doc.abstract , H.div { className: "jumbotron" } [ H.p {} [ H.text "Empty Full Text" ] ] @@ -354,29 +358,24 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt where dispatch :: Action -> Effect Unit dispatch (AddNewNgram ngram termList) = do - commitPatch (Versioned {version, data: pt}) state - where - ({ ngramsVersion: version } /\ _) = state - pt = addNewNgram ngram termList + commitPatch (Versioned {version, data: addNewNgram ngram termList}) state dispatch (SetTermListItem ngram termList) = do 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 - syncPatches props.path props.state (\_ -> pure unit) - - annotate state text = AnnotatedField.annotatedField { ngrams: ngramsTable state - , setTermList: setTermList state - , text } + syncPatches path state (\_ -> pure unit) + 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" } - ngramsTable ({ ngramsLocalPatch, ngramsValidPatch } /\ _) = applyNgramsTablePatch (ngramsLocalPatch <> ngramsValidPatch) initTable - setTermList state ngram Nothing newList = dispatch (AddNewNgram ngram newList) - setTermList state ngram (Just oldList) newList = dispatch (SetTermListItem ngram (replace oldList newList)) + setTermList ngram Nothing newList = dispatch (AddNewNgram ngram newList) + setTermList ngram (Just oldList) newList = dispatch (SetTermListItem ngram (replace oldList newList)) text' x = H.text $ fromMaybe "Nothing" x - NodePoly {hyperdata : Document doc} = document + NodePoly {hyperdata: Document doc} = document type LayoutProps = ( corpusId :: Maybe Int