Commit 1907214d authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-doc-annot-issue-213' of...

Merge branch 'dev-doc-annot-issue-213' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge
parents 5b2acf09 ee9bfb7f
This diff is collapsed.
This diff is collapsed.
let upstream = let upstream =
./packages-0.13.8-20200822.dhall https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20201021/packages.dhall
let overrides = let overrides =
{ thermite = { thermite =
......
...@@ -15,6 +15,7 @@ module Gargantext.Components.NgramsTable.Core ...@@ -15,6 +15,7 @@ module Gargantext.Components.NgramsTable.Core
, NgramsTerm , NgramsTerm
, normNgram , normNgram
, ngramsTermText , ngramsTermText
, findNgramRoot
, findNgramTermList , findNgramTermList
, Version , Version
, Versioned(..) , Versioned(..)
...@@ -760,8 +761,14 @@ isEmptyNgramsTablePatch {ngramsPatches} = isEmptyPatchMap ngramsPatches ...@@ -760,8 +761,14 @@ isEmptyNgramsTablePatch {ngramsPatches} = isEmptyPatchMap ngramsPatches
fromNgramsPatches :: NgramsPatches -> NgramsTablePatch fromNgramsPatches :: NgramsPatches -> NgramsTablePatch
fromNgramsPatches ngramsPatches = {ngramsPatches} fromNgramsPatches ngramsPatches = {ngramsPatches}
findNgramRoot :: NgramsTable -> NgramsTerm -> NgramsTerm
findNgramRoot (NgramsTable m) n =
fromMaybe n (m.ngrams_repo_elements ^? at n <<< _Just <<< _NgramsRepoElement <<< _root <<< _Just)
findNgramTermList :: NgramsTable -> NgramsTerm -> Maybe TermList findNgramTermList :: NgramsTable -> NgramsTerm -> Maybe TermList
findNgramTermList (NgramsTable m) n = m.ngrams_repo_elements ^? at n <<< _Just <<< _NgramsRepoElement <<< _list findNgramTermList (NgramsTable m) n = m.ngrams_repo_elements ^? at r <<< _Just <<< _NgramsRepoElement <<< _list
where
r = findNgramRoot (NgramsTable m) n
singletonNgramsTablePatch :: NgramsTerm -> NgramsPatch -> NgramsTablePatch singletonNgramsTablePatch :: NgramsTerm -> NgramsPatch -> NgramsTablePatch
singletonNgramsTablePatch n p = fromNgramsPatches $ singletonPatchMap n p singletonNgramsTablePatch n p = fromNgramsPatches $ singletonPatchMap n p
......
module Gargantext.Components.Nodes.Corpus.Document where module Gargantext.Components.Nodes.Corpus.Document where
--import Data.Argonaut (encodeJson) -- DEBUG
--import Data.Argonaut.Core (stringifyWithIndent) -- DEBUG
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst) import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
...@@ -7,7 +9,7 @@ import Effect.Aff (Aff) ...@@ -7,7 +9,7 @@ import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude (bind, pure, show, unit, ($), (<>)) import Gargantext.Prelude (bind, pure, show, unit, ($), (<>), (<<<))
import Gargantext.Components.AutoUpdate (autoUpdate) import Gargantext.Components.AutoUpdate (autoUpdate)
import Gargantext.Components.Search (SearchType(..)) import Gargantext.Components.Search (SearchType(..))
...@@ -15,7 +17,7 @@ import Gargantext.Components.Node (NodePoly(..)) ...@@ -15,7 +17,7 @@ import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus.Document.Types (DocPath, Document(..), LoadedData, NodeDocument, Props, State, initialState) import Gargantext.Components.Nodes.Corpus.Document.Types (DocPath, Document(..), LoadedData, NodeDocument, Props, State, initialState)
import Gargantext.Components.NgramsTable.Core import Gargantext.Components.NgramsTable.Core
( CoreAction(..), Versioned(..), addNewNgramA, applyNgramsPatches, coreDispatch, loadNgramsTable ( CoreAction(..), Versioned(..), addNewNgramA, applyNgramsPatches, coreDispatch, loadNgramsTable
, replace, setTermListA, syncResetButtons ) , replace, setTermListA, syncResetButtons, findNgramRoot )
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
...@@ -75,7 +77,12 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt ...@@ -75,7 +77,12 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
else [] else []
pure $ H.div {} $ pure $ H.div {} $
autoUpd <> syncResetBtns <> [ autoUpd <> syncResetBtns <>
--DEBUG
--[ H.pre { rows: 30 } [
-- H.text (stringifyWithIndent 2 (encodeJson (fst state)))
-- ] ] <>
[
H.div { className: "container1" } H.div { className: "container1" }
[ [
R2.row R2.row
...@@ -111,8 +118,10 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt ...@@ -111,8 +118,10 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
, 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" }
setTermList ngram Nothing newList = dispatch (addNewNgramA ngram newList) setTermListOrAddA ngram Nothing = addNewNgramA ngram
setTermList ngram (Just oldList) newList = dispatch (setTermListA ngram (replace oldList newList)) setTermListOrAddA ngram (Just oldList) = setTermListA ngram <<< replace oldList
setTermList ngram mOldList = dispatch <<< setTermListOrAddA (findNgramRoot ngrams ngram) mOldList
-- Here the use of findNgramRoot makes that we always target the root of an ngram group.
text' x = H.text $ fromMaybe "Nothing" x text' x = H.text $ fromMaybe "Nothing" x
NodePoly {hyperdata: Document doc} = document NodePoly {hyperdata: Document doc} = document
......
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