Commit d8913830 authored by Nicolas Pouillard's avatar Nicolas Pouillard

Issue #213: Use applyNgramsPatches instead of applyNgramsTablePatch; cleanup

parent d8729444
...@@ -33,7 +33,7 @@ module Gargantext.Components.NgramsTable.Core ...@@ -33,7 +33,7 @@ module Gargantext.Components.NgramsTable.Core
, _PatchMap , _PatchMap
, patchSetFromMap , patchSetFromMap
, applyPatchSet , applyPatchSet
, applyNgramsTablePatch --, applyNgramsTablePatch -- re-export only if we have a good reason not to use applyNgramsPatches
, applyNgramsPatches , applyNgramsPatches
, rootsOf , rootsOf
, singletonPatchMap , singletonPatchMap
...@@ -501,7 +501,7 @@ derive instance eqReplace :: Eq a => Eq (Replace a) ...@@ -501,7 +501,7 @@ derive instance eqReplace :: Eq a => Eq (Replace a)
instance semigroupReplace :: Eq a => Semigroup (Replace a) where 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 }) (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 append (Replace { new }) (Replace { old }) = replace old new
instance semigroupMonoid :: Eq a => Monoid (Replace a) where instance semigroupMonoid :: Eq a => Monoid (Replace a) where
...@@ -597,7 +597,9 @@ invert :: forall a. a -> a ...@@ -597,7 +597,9 @@ invert :: forall a. a -> a
invert _ = unsafeThrow "invert: TODO" invert _ = unsafeThrow "invert: TODO"
instance semigroupNgramsPatch :: Semigroup NgramsPatch where 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 append (NgramsPatch p) (NgramsPatch q) = NgramsPatch
{ patch_children: p.patch_children <> q.patch_children { patch_children: p.patch_children <> q.patch_children
, patch_list: p.patch_list <> q.patch_list , patch_list: p.patch_list <> q.patch_list
......
...@@ -4,6 +4,7 @@ import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?)) ...@@ -4,6 +4,7 @@ import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
...@@ -17,7 +18,7 @@ import Gargantext.Components.Search (SearchType(..)) ...@@ -17,7 +18,7 @@ import Gargantext.Components.Search (SearchType(..))
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.NgramsTable.Core import Gargantext.Components.NgramsTable.Core
( CoreState, NgramsPatch(..), NgramsTerm, Replace, Versioned(..) ( CoreState, NgramsPatch(..), NgramsTerm, Replace, Versioned(..)
, VersionedNgramsTable, addNewNgram, applyNgramsTablePatch, commitPatch , VersionedNgramsTable, addNewNgram, applyNgramsPatches, commitPatch
, loadNgramsTable, replace, singletonNgramsTablePatch, syncPatches ) , loadNgramsTable, replace, singletonNgramsTablePatch, syncPatches )
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
...@@ -321,7 +322,10 @@ docView props = R.createElement docViewCpt props [] ...@@ -321,7 +322,10 @@ docView props = R.createElement docViewCpt props []
docViewCpt :: R.Component DocViewProps docViewCpt :: R.Component DocViewProps
docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
where 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 {} [ pure $ H.div {} [
autoUpdate { duration: 3000, effect: dispatch Synchronize } autoUpdate { duration: 3000, effect: dispatch Synchronize }
, H.div { className: "container1" } , H.div { className: "container1" }
...@@ -329,7 +333,7 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt ...@@ -329,7 +333,7 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
R2.row R2.row
[ [
R2.col 8 R2.col 8
[ H.h4 {} [ annotate state doc.title ] [ H.h4 {} [ annotate doc.title ]
, H.ul { className: "list-group" } , H.ul { className: "list-group" }
[ li' [ H.span {} [ text' doc.source ] [ li' [ H.span {} [ text' doc.source ]
, badge "source" , badge "source"
...@@ -343,7 +347,7 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt ...@@ -343,7 +347,7 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
] ]
] ]
, badge "abstract" , badge "abstract"
, annotate state doc.abstract , annotate doc.abstract
, H.div { className: "jumbotron" } , H.div { className: "jumbotron" }
[ H.p {} [ H.text "Empty Full Text" ] [ H.p {} [ H.text "Empty Full Text" ]
] ]
...@@ -354,29 +358,24 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt ...@@ -354,29 +358,24 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
where where
dispatch :: Action -> Effect Unit dispatch :: Action -> Effect Unit
dispatch (AddNewNgram ngram termList) = do dispatch (AddNewNgram ngram termList) = do
commitPatch (Versioned {version, data: pt}) state commitPatch (Versioned {version, data: addNewNgram ngram termList}) state
where
({ ngramsVersion: version } /\ _) = state
pt = addNewNgram ngram termList
dispatch (SetTermListItem ngram termList) = do dispatch (SetTermListItem ngram termList) = do
commitPatch (Versioned {version, data: pt}) state commitPatch (Versioned {version, data: pt}) state
where where
({ ngramsVersion: version } /\ _) = state
pe = NgramsPatch { patch_list: termList, patch_children: mempty } pe = NgramsPatch { patch_list: termList, patch_children: mempty }
pt = singletonNgramsTablePatch ngram pe pt = singletonNgramsTablePatch ngram pe
dispatch Synchronize = do dispatch Synchronize = do
syncPatches props.path props.state (\_ -> pure unit) syncPatches path state (\_ -> pure unit)
ngrams = applyNgramsPatches (fst state) initTable
annotate state text = AnnotatedField.annotatedField { ngrams: ngramsTable state annotate text = AnnotatedField.annotatedField { ngrams
, setTermList: setTermList state , setTermList
, text } , text }
badge s = H.span { className: "badge badge-default badge-pill" } [ H.text s ] badge s = H.span { className: "badge badge-default badge-pill" } [ H.text s ]
li' = H.li { className: "list-group-item justify-content-between" } li' = H.li { className: "list-group-item justify-content-between" }
ngramsTable ({ ngramsLocalPatch, ngramsValidPatch } /\ _) = applyNgramsTablePatch (ngramsLocalPatch <> ngramsValidPatch) initTable setTermList ngram Nothing newList = dispatch (AddNewNgram ngram newList)
setTermList state ngram Nothing newList = dispatch (AddNewNgram ngram newList) setTermList ngram (Just oldList) newList = dispatch (SetTermListItem ngram (replace oldList newList))
setTermList state ngram (Just oldList) newList = dispatch (SetTermListItem ngram (replace oldList newList))
text' x = H.text $ fromMaybe "Nothing" x text' x = H.text $ fromMaybe "Nothing" x
NodePoly {hyperdata : Document doc} = document NodePoly {hyperdata: Document doc} = document
type LayoutProps = ( type LayoutProps = (
corpusId :: Maybe Int corpusId :: Maybe Int
......
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