Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
1
Merge Requests
1
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Przemyslaw Kaminski
purescript-gargantext
Commits
a42e4aaa
Unverified
Commit
a42e4aaa
authored
Jul 09, 2019
by
Nicolas Pouillard
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[DocAnnot] fix the addNewNgrams feature
parent
100d4ad8
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
74 additions
and
30 deletions
+74
-30
AnnotatedField.purs
src/Gargantext/Components/Annotation/AnnotatedField.purs
+1
-1
NgramsTable.purs
src/Gargantext/Components/NgramsTable.purs
+6
-8
Core.purs
src/Gargantext/Components/NgramsTable/Core.purs
+61
-15
Contacts.purs
src/Gargantext/Pages/Annuaire/User/Contacts.purs
+1
-1
Document.purs
src/Gargantext/Pages/Corpus/Document.purs
+5
-5
No files found.
src/Gargantext/Components/Annotation/AnnotatedField.purs
View file @
a42e4aaa
...
@@ -58,7 +58,7 @@ annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt
...
@@ -58,7 +58,7 @@ annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt
let x = E.clientX event
let x = E.clientX event
y = E.clientY event
y = E.clientY event
setList t = do
setList t = do
setTermList
(S.toLower text')
(Just list) t
setTermList
text'
(Just list) t
setMenu (const Nothing)
setMenu (const Nothing)
setMenu (const $ Just {x, y, list: Just list, menuType: SetTermListItem, setList} )
setMenu (const $ Just {x, y, list: Just list, menuType: SetTermListItem, setList} )
...
...
src/Gargantext/Components/NgramsTable.purs
View file @
a42e4aaa
...
@@ -213,9 +213,8 @@ ngramsTableSpec = simpleSpec performAction render
...
@@ -213,9 +213,8 @@ ngramsTableSpec = simpleSpec performAction render
performAction (SetTermListItem n pl) {path: {nodeId, listIds, tabType}} {ngramsVersion} =
performAction (SetTermListItem n pl) {path: {nodeId, listIds, tabType}} {ngramsVersion} =
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
where
where
listId = Just 10 -- List.head listIds
pe = NgramsPatch { patch_list: pl, patch_children: mempty }
pe = NgramsPatch { patch_list: pl, patch_children: mempty }
pt =
PatchMap $ Map.singleton
n pe
pt =
singletonNgramsTablePatch
n pe
performAction AddTermChildren _ {ngramsParent: Nothing} =
performAction AddTermChildren _ {ngramsParent: Nothing} =
-- impossible but harmless
-- impossible but harmless
pure unit
pure unit
...
@@ -227,14 +226,13 @@ ngramsTableSpec = simpleSpec performAction render
...
@@ -227,14 +226,13 @@ ngramsTableSpec = simpleSpec performAction render
modifyState_ $ setParentResetChildren Nothing
modifyState_ $ setParentResetChildren Nothing
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
where
where
listId = Just 10 -- List.head listIds
pc = patchSetFromMap ngramsChildren
pc = patchSetFromMap ngramsChildren
pe = NgramsPatch { patch_list: mempty, patch_children: pc }
pe = NgramsPatch { patch_list: mempty, patch_children: pc }
pt =
PatchMap $ Map.fromFoldable [Tuple parent pe]
pt =
singletonNgramsTablePatch parent pe
-- TODO ROOT-UPDATE
performAction (AddNewNgram ngram) {path: {listIds, nodeId, tabType}} {ngramsVersion} =
-- patch the root of the child to be equal to the root of the parent.
commitPatch {listIds, nodeId, tabType} (Versioned {version: ngramsVersion, data: pt})
performAction (AddNewNgram ngram) {path: params} _ =
where
lift $ addNewNgram ngram Nothing params
pt = addNewNgram ngram CandidateTerm
render :: Render State LoadedNgramsTableProps Action
render :: Render State LoadedNgramsTableProps Action
render dispatch { path: pageParams
render dispatch { path: pageParams
...
...
src/Gargantext/Components/NgramsTable/Core.purs
View file @
a42e4aaa
...
@@ -7,6 +7,8 @@ module Gargantext.Components.NgramsTable.Core
...
@@ -7,6 +7,8 @@ module Gargantext.Components.NgramsTable.Core
, NgramsPatch(..)
, NgramsPatch(..)
, NgramsTable(..)
, NgramsTable(..)
, NgramsTablePatch
, NgramsTablePatch
, NewElems
, NgramsPatches
, _NgramsTable
, _NgramsTable
, NgramsTerm
, NgramsTerm
, Version
, Version
...
@@ -27,6 +29,9 @@ module Gargantext.Components.NgramsTable.Core
...
@@ -27,6 +29,9 @@ module Gargantext.Components.NgramsTable.Core
, patchSetFromMap
, patchSetFromMap
, applyPatchSet
, applyPatchSet
, applyNgramsTablePatch
, applyNgramsTablePatch
, singletonPatchMap
, fromNgramsPatches
, singletonNgramsTablePatch
, _list
, _list
, _occurrences
, _occurrences
, _children
, _children
...
@@ -450,6 +455,9 @@ instance decodeJsonPatchMap :: DecodeJson p => DecodeJson (PatchMap String p) wh
...
@@ -450,6 +455,9 @@ instance decodeJsonPatchMap :: DecodeJson p => DecodeJson (PatchMap String p) wh
obj <- decodeJson json
obj <- decodeJson json
pure $ PatchMap $ Map.fromFoldableWithIndex (obj :: FO.Object p)
pure $ PatchMap $ Map.fromFoldableWithIndex (obj :: FO.Object p)
singletonPatchMap :: forall k p. k -> p -> PatchMap k p
singletonPatchMap k p = PatchMap (Map.singleton k p)
isEmptyPatchMap :: forall k p. PatchMap k p -> Boolean
isEmptyPatchMap :: forall k p. PatchMap k p -> Boolean
isEmptyPatchMap (PatchMap p) = Map.isEmpty p
isEmptyPatchMap (PatchMap p) = Map.isEmpty p
...
@@ -461,7 +469,20 @@ applyPatchMap applyPatchValue (PatchMap p) = mapWithIndex f
...
@@ -461,7 +469,20 @@ applyPatchMap applyPatchValue (PatchMap p) = mapWithIndex f
Nothing -> v
Nothing -> v
Just pv -> applyPatchValue pv v
Just pv -> applyPatchValue pv v
type NgramsTablePatch = PatchMap NgramsTerm NgramsPatch
type NgramsPatches = PatchMap NgramsTerm NgramsPatch
type NewElems = Map NgramsTerm TermList
type NgramsTablePatch =
{ ngramsNewElems :: NewElems
, ngramsPatches :: NgramsPatches
}
fromNgramsPatches :: NgramsPatches -> NgramsTablePatch
fromNgramsPatches ngramsPatches = {ngramsNewElems: mempty, ngramsPatches}
singletonNgramsTablePatch :: NgramsTerm -> NgramsPatch -> NgramsTablePatch
singletonNgramsTablePatch n p = fromNgramsPatches $ singletonPatchMap (S.toLower n) p
type RootParent = { root :: NgramsTerm, parent :: NgramsTerm }
type RootParent = { root :: NgramsTerm, parent :: NgramsTerm }
...
@@ -494,13 +515,26 @@ reParentNgramsPatch parent (NgramsPatch {patch_children: PatchSet {rem, add}}) =
...
@@ -494,13 +515,26 @@ reParentNgramsPatch parent (NgramsPatch {patch_children: PatchSet {rem, add}}) =
traverse_ (reParent Nothing) rem
traverse_ (reParent Nothing) rem
traverse_ (reParent $ Just rp) add
traverse_ (reParent $ Just rp) add
reParentNgramsTablePatch :: ReParent Ngrams
TablePatch
reParentNgramsTablePatch :: ReParent Ngrams
Patches
reParentNgramsTablePatch = void <<< traverseWithIndex reParentNgramsPatch
reParentNgramsTablePatch = void <<< traverseWithIndex reParentNgramsPatch
newElemsTable :: NewElems -> Map NgramsTerm NgramsElement
newElemsTable = mapWithIndex newElem
where
newElem ngrams list =
NgramsElement
{ ngrams
, list
, occurrences: 1
, parent: Nothing
, root: Nothing
, children: mempty
}
applyNgramsTablePatch :: NgramsTablePatch -> NgramsTable -> NgramsTable
applyNgramsTablePatch :: NgramsTablePatch -> NgramsTable -> NgramsTable
applyNgramsTablePatch
p
(NgramsTable m) =
applyNgramsTablePatch
{ ngramsPatches, ngramsNewElems: n }
(NgramsTable m) =
execState (reParentNgramsTablePatch
p
) $
execState (reParentNgramsTablePatch
ngramsPatches
) $
NgramsTable $ applyPatchMap applyNgramsPatch
p m
NgramsTable $ applyPatchMap applyNgramsPatch
ngramsPatches (newElemsTable n <> m)
-----------------------------------------------------------------------------------
-----------------------------------------------------------------------------------
...
@@ -510,17 +544,34 @@ type CoreState s =
...
@@ -510,17 +544,34 @@ type CoreState s =
| s
| s
}
}
putTable :: {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsTablePatch -> Aff (Versioned NgramsTablePatch)
postNewNgrams :: forall s. Array NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit
putTable {nodeId, listIds, tabType} =
postNewNgrams newNgrams mayList {nodeId, listIds, tabType} =
when (not (A.null newNgrams)) $ do
(_ :: Array Unit) <- post (toUrl Back (PutNgrams tabType (head listIds) mayList) $ Just nodeId) newNgrams
pure unit
postNewElems :: forall s. NewElems -> CoreParams s -> Aff Unit
postNewElems newElems params = void $ traverseWithIndex postNewElem newElems
where
postNewElem ngrams list = postNewNgrams [ngrams] (Just list) params
addNewNgram :: NgramsTerm -> TermList -> NgramsTablePatch
addNewNgram ngrams list = { ngramsPatches: mempty
, ngramsNewElems: Map.singleton (S.toLower ngrams) list }
putNgramsPatches :: {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches)
putNgramsPatches {nodeId, listIds, tabType} =
put (toUrl Back (PutNgrams tabType (head listIds) Nothing) $ Just nodeId)
put (toUrl Back (PutNgrams tabType (head listIds) Nothing) $ Just nodeId)
commitPatch :: forall s. {nodeId :: Int, listIds :: Array Int, tabType :: TabType}
commitPatch :: forall s. {nodeId :: Int, listIds :: Array Int, tabType :: TabType}
-> Versioned NgramsTablePatch -> StateCoTransformer (CoreState s) Unit
-> Versioned NgramsTablePatch -> StateCoTransformer (CoreState s) Unit
commitPatch props pt@(Versioned {data: tablePatch}) = do
commitPatch props (Versioned {version, data: tablePatch@{ngramsPatches, ngramsNewElems}}) = do
Versioned {version: newVersion, data: newPatch} <- lift $ putTable props pt
let pt = Versioned { version, data: ngramsPatches }
lift $ postNewElems ngramsNewElems props
Versioned {version: newVersion, data: newPatch} <- lift $ putNgramsPatches props pt
modifyState_ $ \s ->
modifyState_ $ \s ->
s { ngramsVersion = newVersion
s { ngramsVersion = newVersion
, ngramsTablePatch = newPatch <> tablePatch <> s.ngramsTablePatch
, ngramsTablePatch =
fromNgramsPatches
newPatch <> tablePatch <> s.ngramsTablePatch
}
}
-- TODO: check that pt.version == s.ngramsTablePatch.version
-- TODO: check that pt.version == s.ngramsTablePatch.version
...
@@ -540,11 +591,6 @@ convOrderBy (T.DESC (T.ColumnName "Score (Occurrences)")) = ScoreDesc
...
@@ -540,11 +591,6 @@ convOrderBy (T.DESC (T.ColumnName "Score (Occurrences)")) = ScoreDesc
convOrderBy (T.ASC _) = TermAsc
convOrderBy (T.ASC _) = TermAsc
convOrderBy (T.DESC _) = TermDesc
convOrderBy (T.DESC _) = TermDesc
addNewNgram :: forall s. NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit
addNewNgram ngram mayList {nodeId, listIds, tabType} = do
(_ :: Array Unit) <- post (toUrl Back (PutNgrams tabType (head listIds) mayList) $ Just nodeId) [ngram]
pure unit
ngramsLoaderClass :: Loader.LoaderClass PageParams VersionedNgramsTable
ngramsLoaderClass :: Loader.LoaderClass PageParams VersionedNgramsTable
ngramsLoaderClass = Loader.createLoaderClass "NgramsTableLoader" loadNgramsTable
ngramsLoaderClass = Loader.createLoaderClass "NgramsTableLoader" loadNgramsTable
...
...
src/Gargantext/Pages/Annuaire/User/Contacts.purs
View file @
a42e4aaa
...
@@ -4,4 +4,4 @@ module Gargantext.Pages.Annuaire.User.Contacts
...
@@ -4,4 +4,4 @@ module Gargantext.Pages.Annuaire.User.Contacts
where
where
import Gargantext.Pages.Annuaire.User.Contacts.Types
import Gargantext.Pages.Annuaire.User.Contacts.Types
import Gargantext.Pages.Annuaire.User.Contacts.Specs
import Gargantext.Pages.Annuaire.User.Contacts.Specs
(layoutUser)
src/Gargantext/Pages/Corpus/Document.purs
View file @
a42e4aaa
...
@@ -3,7 +3,6 @@ module Gargantext.Pages.Corpus.Document where
...
@@ -3,7 +3,6 @@ module Gargantext.Pages.Corpus.Document where
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
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.Map as Map
import Data.Maybe (Maybe(..), maybe)
import Data.Maybe (Maybe(..), maybe)
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import React (ReactClass, Children)
import React (ReactClass, Children)
...
@@ -11,7 +10,6 @@ import React.DOM (div, h4, li, p, span, text, ul)
...
@@ -11,7 +10,6 @@ import React.DOM (div, h4, li, p, span, text, ul)
import React.DOM.Props (className)
import React.DOM.Props (className)
import Reactix as R
import Reactix as R
import Thermite (PerformAction, Render, Spec, simpleSpec, cmapProps, createClass)
import Thermite (PerformAction, Render, Spec, simpleSpec, cmapProps, createClass)
import Control.Monad.Trans.Class (lift)
import Gargantext.Prelude
import Gargantext.Prelude
import Gargantext.Config (toUrl, NodeType(..), End(..), TabSubType(..), TabType(..), CTabNgramType(..))
import Gargantext.Config (toUrl, NodeType(..), End(..), TabSubType(..), TabType(..), CTabNgramType(..))
...
@@ -286,9 +284,11 @@ docViewSpec = simpleSpec performAction render
...
@@ -286,9 +284,11 @@ docViewSpec = simpleSpec performAction render
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
where
where
pe = NgramsPatch { patch_list: pl, patch_children: mempty }
pe = NgramsPatch { patch_list: pl, patch_children: mempty }
pt = PatchMap $ Map.singleton n pe
pt = singletonNgramsTablePatch n pe
performAction (AddNewNgram ngram termList) {path: params} _ =
performAction (AddNewNgram ngram termList) {path: {nodeId, listIds, tabType}} {ngramsVersion} =
lift $ addNewNgram ngram (Just termList) params
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
where
pt = addNewNgram ngram termList
render :: Render State Props Action
render :: Render State Props Action
render dispatch { loaded: { ngramsTable: Versioned { data: initTable }, document } }
render dispatch { loaded: { ngramsTable: Versioned { data: initTable }, document } }
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment