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 =
./packages-0.13.8-20200822.dhall
https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20201021/packages.dhall
let overrides =
{ thermite =
......
......@@ -15,6 +15,7 @@ module Gargantext.Components.NgramsTable.Core
, NgramsTerm
, normNgram
, ngramsTermText
, findNgramRoot
, findNgramTermList
, Version
, Versioned(..)
......@@ -760,8 +761,14 @@ isEmptyNgramsTablePatch {ngramsPatches} = isEmptyPatchMap ngramsPatches
fromNgramsPatches :: NgramsPatches -> NgramsTablePatch
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 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 n p = fromNgramsPatches $ singletonPatchMap n p
......
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.Tuple (fst)
import Data.Tuple.Nested ((/\))
......@@ -7,7 +9,7 @@ import Effect.Aff (Aff)
import Reactix as R
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.Search (SearchType(..))
......@@ -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.NgramsTable.Core
( CoreAction(..), Versioned(..), addNewNgramA, applyNgramsPatches, coreDispatch, loadNgramsTable
, replace, setTermListA, syncResetButtons )
, replace, setTermListA, syncResetButtons, findNgramRoot )
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..))
......@@ -75,7 +77,12 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
else []
pure $ H.div {} $
autoUpd <> syncResetBtns <> [
autoUpd <> syncResetBtns <>
--DEBUG
--[ H.pre { rows: 30 } [
-- H.text (stringifyWithIndent 2 (encodeJson (fst state)))
-- ] ] <>
[
H.div { className: "container1" }
[
R2.row
......@@ -111,8 +118,10 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
, 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 (addNewNgramA ngram newList)
setTermList ngram (Just oldList) newList = dispatch (setTermListA ngram (replace oldList newList))
setTermListOrAddA ngram Nothing = addNewNgramA ngram
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
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