NgramsTable,Document,Annotations: refactoring

src/Gargantext/Components/Annotation/AnnotatedField.purs

@@ -14,22 +14,18 @@ module Gargantext.Components.Annotation.AnnotatedField where
 import Prelude
 import Data.Map as Map
 import Data.Maybe ( Maybe(..), maybe, maybe' )
-import Data.Lens ( Lens', lens )
-import Data.Traversable ( traverse_ )
 import Data.Tuple ( Tuple(..) )
 import Data.Tuple.Nested ( (/\) )
-import DOM.Simple.Console
 import DOM.Simple.Event as DE
 import Effect ( Effect )
-import Effect.Uncurried (mkEffectFn1)
+import Effect.Uncurried ( mkEffectFn1 )
 import Reactix as R
 import Reactix.DOM.HTML as HTML
 import Reactix.SyntheticEvent as E
 
-import Gargantext.Types ( TermList(..) )
+import Gargantext.Types ( TermList )
 import Gargantext.Components.Annotation.Utils ( termClass )
-import Gargantext.Components.NgramsTable ( NgramsTable(..), highlightNgrams )
-import Gargantext.Components.ContextMenu.ContextMenu as CM
+import Gargantext.Components.NgramsTable.Core ( NgramsTable(..), highlightNgrams )
 import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu )
 import Gargantext.Utils.Selection as Sel
 
@@ -68,8 +64,7 @@ compile props = runs props.text
   where runs = maybe [] (highlightNgrams props.ngrams)
 
 maybeShowMenu
-  :: forall t
-  .  (Maybe AnnotationMenu -> Effect Unit)
+  :: (Maybe AnnotationMenu -> Effect Unit)
   -> NgramsTable
   -> E.SyntheticEvent DE.MouseEvent
   -> Effect Unit

src/Gargantext/Components/Annotation/Menu.purs

@@ -2,7 +2,7 @@
 module Gargantext.Components.Annotation.Menu where
 
 
-import Prelude ( Unit, (==), ($), (<>), unit, pure )
+import Prelude ( Unit, (==), ($), (<>), unit, pure, otherwise )
 import Data.Array as A
 import Data.Maybe ( Maybe(..), maybe' )
 import Effect ( Effect )
@@ -18,7 +18,7 @@ import Gargantext.Components.ContextMenu.ContextMenu as CM
 
 type Props = ( list :: Maybe TermList )
 
-type AnnotationMenu = { x :: Number, y :: Number, list :: Maybe TermList }
+type AnnotationMenu = { x :: Number, y :: Number | Props }
 
 -- | An Annotation Menu is parameterised by a Maybe Termlist of the
 -- | TermList the currently selected text belongs to
@@ -29,21 +29,20 @@ annotationMenu setMenu { x,y,list } =
 annotationMenuCpt :: R.Component Props
 annotationMenuCpt = R.hooksComponent "Annotation.Menu" cpt
   where
-    cpt { list } _ = pure $ R.fragment $ children list
-    children l = A.mapMaybe (\l' -> addToList l' l) [ GraphTerm, CandidateTerm, StopTerm ]
+    cpt props _ = pure $ R.fragment $ children props
+    children props = A.mapMaybe (addToList props) [ GraphTerm, CandidateTerm, StopTerm ]
 
 -- | Given the TermList to render the item for zand the Maybe TermList the item may belong to, possibly render the menuItem
-addToList :: TermList -> Maybe TermList -> Maybe R.Element
-addToList t (Just t')
+addToList :: Record Props -> TermList -> Maybe R.Element
+addToList {list: Just t'} t
   | t == t'   = Nothing
-  | true = addToList t Nothing
-addToList t _ = Just $ CM.contextMenuItem [ link ]
+addToList props t = Just $ CM.contextMenuItem [ link ]
   where link = HTML.a { onClick: click, className: className } [ HTML.text label ]
         label = "Add to " <> termListName t
         className = termClass t
-        click = mkEffectFn1 $ \_ -> addToTermList t
+        click = mkEffectFn1 $ \_ -> addToTermList props t
 
 -- TODO: what happens when we add to a term list?
-addToTermList :: TermList -> Effect Unit
-addToTermList _ = pure unit
+addToTermList :: Record Props -> TermList -> Effect Unit
+addToTermList _ _ = pure unit
 

src/Gargantext/Components/NgramsTable.purs

 module Gargantext.Components.NgramsTable
-  ( PageParams
-  , PatchMap
-  , Action
+  ( Action
   , MainNgramsTableProps
-  , NgramsElement(..)
-  , NgramsPatch
-  , NgramsTable(..)
-  , NgramsTerm
-  , Version
-  , Versioned(..)
-  , VersionedNgramsTable
-  , highlightNgrams
-  , initialPageParams
   , initialState
   , mainNgramsTableSpec
-  , loadNgramsTable
-  , ngramsTableSpec
-  , ngramsLoaderClass
-  , ngramsLoader
-  , ngramsLoaderClass
   , ngramsTableClass
   , ngramsTableSpec
   , termStyle
   )
   where
 
-import Control.Monad.State (class MonadState, execState)
 import Control.Monad.Cont.Trans (lift)
-import Data.Array (head)
 import Data.Array as A
-import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson
-                     , jsonEmptyObject, (:=), (~>), (.?), (.??) )
-import Data.Either (Either(..), either)
-import Data.Foldable (class Foldable, foldMap, foldl, foldr)
-import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)
-import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)
-import Data.Newtype (class Newtype)
-import Data.Lens (Iso', Lens', (?=), (%=), (%~), (.~), (^?), (^.), (^..), to, use, view)
+import Data.Lens (to, view, (%~), (.~), (^.), (^..))
 import Data.Lens.Common (_Just)
-import Data.Lens.At (class At, at)
-import Data.Lens.Index (class Index, ix)
-import Data.Lens.Fold (folded, traverseOf_)
+import Data.Lens.At (at)
+import Data.Lens.Index (ix)
+import Data.Lens.Fold (folded)
 import Data.Lens.Record (prop)
-import Data.Lens.Iso.Newtype (_Newtype)
 import Data.List as List
-import Data.List ((:), List(Nil))
 import Data.Map (Map)
 import Data.Map as Map
 import Data.Maybe (Maybe(..), maybe)
 import Data.Monoid.Additive (Additive(..))
 import Data.Ord.Down (Down(..))
-import Data.Traversable (class Traversable, traverse, traverse_, sequence)
-import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
-import Data.Set (Set)
-import Data.Set as Set
-import Data.String as S
-import Data.String.Regex as R
-import Data.String.Regex.Flags as R
 import Data.Symbol (SProxy(..))
 import Data.Tuple (Tuple(..), snd)
 import Effect (Effect)
-import Effect.Aff (Aff)
-import Foreign.Object as FO
 import React (ReactElement)
-import React as React
 import React.DOM (a, button, div, h2, i, input, li, option, p, select, span, table, tbody, text, thead, ul)
-import React.DOM.Props (_id, _type, checked, className, name, onChange, onClick, onInput, placeholder, style, defaultValue, value)
+import React.DOM.Props (_id, _type, checked, className, name, onChange, onClick, onInput, placeholder, style, value)
 import React.DOM.Props as DOM
-import Thermite (PerformAction, Render, Spec, StateCoTransformer, defaultPerformAction, modifyState_, simpleSpec, createClass)
+import Thermite (PerformAction, Render, Spec, defaultPerformAction, modifyState_, simpleSpec, createClass)
 import Unsafe.Coerce (unsafeCoerce)
-import Partial (crashWith)
-import Partial.Unsafe (unsafePartial)
 
-import Gargantext.Utils.KarpRabin (indicesOfAny)
-import Gargantext.Types (TermList(..), TermSize, readTermList, readTermSize, termLists, termSizes)
-import Gargantext.Config (toUrl, End(..), Path(..), TabType(..), OrderBy(..), NodeType(..))
-import Gargantext.Config.REST (get, put, post)
+import Gargantext.Types (TermList(..), readTermList, readTermSize, termLists, termSizes)
+import Gargantext.Config (OrderBy(..), TabType)
 import Gargantext.Components.AutoUpdate (autoUpdateElt)
 import Gargantext.Components.Table as T
 import Gargantext.Prelude
 import Gargantext.Components.Loader as Loader
-
-type PageParams =
-  { nodeId :: Int
-  , listIds :: Array Int
-  , params :: T.Params
-  , tabType :: TabType
-  , searchQuery :: String
-  , termListFilter :: Maybe TermList -- Nothing means all
-  , termSizeFilter :: Maybe TermSize -- Nothing means all
-  }
-
-initialPageParams :: Int -> Array Int -> TabType -> PageParams
-initialPageParams nodeId listIds tabType =
-  { nodeId
-  , listIds
-  , params: T.initialParams
-  , tabType
-  , termSizeFilter: Nothing
-  , termListFilter: Just GraphTerm
-  , searchQuery: ""
-  }
+import Gargantext.Components.NgramsTable.Core
 
 type Props' = Loader.InnerProps PageParams VersionedNgramsTable ()
 
-type NgramsTerm = String
-
------------------------------------------------------------------------------------
-newtype NgramsElement = NgramsElement
-  { ngrams      :: NgramsTerm
-  , list        :: TermList
-  , occurrences :: Int
-  , parent      :: Maybe NgramsTerm
-  , root        :: Maybe NgramsTerm
-  , children    :: Set NgramsTerm
-  }
-
-derive instance eqNgramsElement :: Eq NgramsElement
-derive instance eqNgramsTable :: Eq NgramsTable
-
-
-_parent = prop (SProxy :: SProxy "parent")
-_root   = prop (SProxy :: SProxy "root")
-_ngrams = prop (SProxy :: SProxy "ngrams")
-
-_children :: forall row. Lens' { children :: Set NgramsTerm | row } (Set NgramsTerm)
-_children = prop (SProxy :: SProxy "children")
-
-_occurrences :: forall row. Lens' { occurrences :: Int | row } Int
-_occurrences = prop (SProxy :: SProxy "occurrences")
-
-_list :: forall a row. Lens' { list :: a | row } a
-_list = prop (SProxy :: SProxy "list")
-
-derive instance newtypeNgramsElement :: Newtype NgramsElement _
-
-_NgramsElement :: Iso' NgramsElement _
-_NgramsElement = _Newtype
-
-instance decodeJsonNgramsElement :: DecodeJson NgramsElement where
-  decodeJson json = do
-    obj         <- decodeJson json
-    ngrams      <- obj .?  "ngrams"
-    list        <- obj .?  "list"
-    occurrences <- obj .?  "occurrences"
-    parent      <- obj .?? "parent"
-    root        <- obj .?? "root"
-    children'   <- obj .?  "children"
-    let children = Set.fromFoldable (children' :: Array NgramsTerm)
-    pure $ NgramsElement {ngrams, list, occurrences, parent, root, children}
-
------------------------------------------------------------------------------------
-type Version = Int
-
-newtype Versioned a = Versioned
-  { version :: Version
-  , data    :: a
-  }
-
-instance encodeJsonVersioned :: EncodeJson a => EncodeJson (Versioned a) where
-  encodeJson (Versioned {version, data: data_})
-     = "version" := version
-    ~> "data" := data_
-    ~> jsonEmptyObject
-
-instance decodeJsonVersioned :: DecodeJson a => DecodeJson (Versioned a) where
-  decodeJson json = do
-    obj     <- decodeJson json
-    version <- obj .? "version"
-    data_   <- obj .? "data"
-    pure $ Versioned {version, data: data_}
-
--- type NgramsTable = Array (NTree NgramsElement)
--- type NgramsTable = Array NgramsElement
-newtype NgramsTable = NgramsTable (Map NgramsTerm NgramsElement)
-
-derive instance newtypeNgramsTable :: Newtype NgramsTable _
-
-_NgramsTable :: Iso' NgramsTable (Map NgramsTerm NgramsElement)
-_NgramsTable = _Newtype
-
-instance indexNgramsTable :: Index NgramsTable String NgramsElement where
-  ix k = _NgramsTable <<< ix k
-
-instance atNgramsTable :: At NgramsTable String NgramsElement where
-  at k = _NgramsTable <<< at k
-
-instance decodeJsonNgramsTable :: DecodeJson NgramsTable where
-  decodeJson json = do
-    elements <- decodeJson json
-    pure $ NgramsTable
-         $ Map.fromFoldable
-         $ f <$> (elements :: Array NgramsElement)
-    where
-      f e@(NgramsElement e') = Tuple e'.ngrams e
------------------------------------------------------------------------------------
-
--- TODO: while this function works well with word boundaries,
---       it inserts too many spaces.
-highlightNgrams :: NgramsTable -> String -> Array (Tuple String (Maybe TermList))
-highlightNgrams (NgramsTable table) input0 =
-    let sN = unsafePartial (foldl goFold {i0: 0, s: input, l: Nil} ixs) in
-    A.reverse (A.fromFoldable (consNonEmpty sN.s sN.l))
-  where
-    sp x = " " <> S.replaceAll (S.Pattern " ") (S.Replacement "  ") x <> " "
-    unsp x =
-      case S.stripSuffix (S.Pattern " ") x of
-        Nothing -> x
-        Just x1 -> S.replaceAll (S.Pattern "  ") (S.Replacement " ") (S.drop 1 x1)
-    input = sp input0
-    pats = A.fromFoldable (Map.keys table)
-    ixs  = indicesOfAny (sp <$> pats) (S.toLower $ R.replace theRegex " " input)
-      where
-        theRegex = case R.regex "[.,;:!?'\\{}()]" (R.global <> R.multiline) of
-            Left e  -> unsafePartial $ crashWith e
-            Right r -> r
-
-    consNonEmpty x xs
-      | S.null x  = xs
-      | otherwise = Tuple x Nothing : xs
-
-    -- NOTE that only the first matching pattern is used, the others are ignored!
-    goFold :: Partial => _ -> Tuple Int (Array Int) -> _
-    goFold { i0, s, l } (Tuple i pis)
-      | i < i0    =
-        -- Skip this pattern which is overlapping with a previous one.
-        { i0, s, l }
-      | otherwise =
-      case A.index pis 0 of
-        Nothing ->
-          { i0, s, l }
-        Just pi ->
-          case A.index pats pi of
-            Nothing ->
-              crashWith "highlightNgrams: out of bounds pattern"
-            Just pat ->
-              let lpat = S.length (sp pat) in
-              case Map.lookup pat table of
-                Nothing ->
-                  crashWith "highlightNgrams: pattern missing from table"
-                Just (NgramsElement ne) ->
-                  let s1 = S.splitAt (i - i0) s
-                      s2 = S.splitAt lpat s1.after in
-                  -- s2.before and pat might differ by casing only!
-                  { i0: i + lpat
-                  , s:  s2.after
-                  , l:  Tuple " " Nothing :
-                        Tuple s2.before (Just ne.list) :
-                        Tuple " " Nothing :
-                        consNonEmpty (unsp s1.before) l
-                  }
-
------------------------------------------------------------------------------------
-
-type VersionedNgramsTable = Versioned NgramsTable
-
------------------------------------------------------------------------------------
-data Replace a
-  = Keep
-  | Replace { old :: a, new :: a }
-
-replace :: forall a. Eq a => a -> a -> Replace a
-replace old new
-  | old == new = Keep
-  | otherwise  = Replace { old, new }
-
-instance semigroupReplace :: Semigroup (Replace a) where
-  append Keep p = p
-  append p Keep = p
-  append (Replace { old: _m, new }) (Replace { old, new: _m' }) =
-    -- assert _m == _m'
-    Replace { old, new }
-
-instance semigroupMonoid :: Monoid (Replace a) where
-  mempty = Keep
-
-applyReplace :: forall a. Eq a => Replace a -> a -> a
-applyReplace Keep a = a
-applyReplace (Replace { old, new }) a
-  | a == old  = new
-  | otherwise = a
-
-instance encodeJsonReplace :: EncodeJson a => EncodeJson (Replace a) where
-  encodeJson Keep
-    = "tag" := "Keep"
-   ~> jsonEmptyObject
-  encodeJson (Replace {old, new})
-    = "old" := old
-   ~> "new" := new
-   ~> "tag" := "Replace"
-   ~> jsonEmptyObject
-
-instance decodeJsonReplace :: (DecodeJson a, Eq a) => DecodeJson (Replace a) where
-  decodeJson json = do
-    obj  <- decodeJson json
-    mold <- obj .?? "old"
-    mnew <- obj .?? "new"
-    case Tuple mold mnew of
-      Tuple (Just old) (Just new) -> pure $ replace old new
-      Tuple Nothing Nothing       -> pure Keep
-      _                           -> Left "decodeJsonReplace"
-
--- Representing a PatchSet as `Map a Boolean` would have the advantage
--- of enforcing rem and add to be disjoint.
-newtype PatchSet a = PatchSet
-  { rem :: Set a
-  , add :: Set a
-  }
-
-instance semigroupPatchSet :: Ord a => Semigroup (PatchSet a) where
-  append (PatchSet p) (PatchSet q) = PatchSet
-    { rem: q.rem <> p.rem
-    , add: Set.difference q.add p.rem <> p.add
-    }
-
-instance monoidPatchSet :: Ord a => Monoid (PatchSet a) where
-  mempty = PatchSet { rem: Set.empty, add: Set.empty }
-
-instance encodeJsonPatchSet :: EncodeJson a => EncodeJson (PatchSet a) where
-  encodeJson (PatchSet {rem, add})
-    -- TODO only include non empty fields
-    = "rem" := (Set.toUnfoldable rem :: Array a)
-   ~> "add" := (Set.toUnfoldable add :: Array a)
-   ~> jsonEmptyObject
-
-instance decodeJsonPatchSet :: (Ord a, DecodeJson a) => DecodeJson (PatchSet a) where
-  decodeJson json = do
-    -- TODO handle empty fields
-    obj <- decodeJson json
-    rem <- mkSet <$> (obj .? "rem")
-    add <- mkSet <$> (obj .? "add")
-    pure $ PatchSet { rem, add }
-   where
-    mkSet :: forall b. Ord b => Array b -> Set b
-    mkSet = Set.fromFoldable
-
-applyPatchSet :: forall a. Ord a => PatchSet a -> Set a -> Set a
-applyPatchSet (PatchSet p) s = Set.difference s p.rem <> p.add
-
-patchSetFromMap :: forall a. Ord a => Map a Boolean -> PatchSet a
-patchSetFromMap m = PatchSet { rem: Map.keys (Map.filter not m)
-                             , add: Map.keys (Map.filter identity m) }
-  -- TODO Map.partition would be nice here
-
-newtype NgramsPatch = NgramsPatch
-  { patch_children :: PatchSet NgramsTerm
-  , patch_list     :: Replace TermList
-  }
-
-instance semigroupNgramsPatch :: Semigroup NgramsPatch where
-  append (NgramsPatch p) (NgramsPatch q) = NgramsPatch
-    { patch_children: p.patch_children <> q.patch_children
-    , patch_list:     p.patch_list     <> q.patch_list
-    }
-
-instance monoidNgramsPatch :: Monoid NgramsPatch where
-  mempty = NgramsPatch { patch_children: mempty, patch_list: mempty }
-
-instance encodeJsonNgramsPatch :: EncodeJson NgramsPatch where
-  -- TODO only include non empty fields
-  encodeJson (NgramsPatch { patch_children, patch_list })
-     = "patch_children" := patch_children
-    ~> "patch_list"     := patch_list
-    ~> jsonEmptyObject
-
-instance decodeJsonNgramsPatch :: DecodeJson NgramsPatch where
-  decodeJson json = do
-    obj            <- decodeJson json
-    -- TODO handle empty fields
-    patch_list     <- obj .? "patch_list"
-    patch_children <- obj .? "patch_children"
-    pure $ NgramsPatch { patch_list, patch_children }
-
-applyNgramsPatch :: NgramsPatch -> NgramsElement -> NgramsElement
-applyNgramsPatch (NgramsPatch p) (NgramsElement e) = NgramsElement
-  { ngrams:      e.ngrams
-  , list:        applyReplace p.patch_list e.list
-  , occurrences: e.occurrences
-  , parent:      e.parent
-  , root:        e.root
-  , children:    applyPatchSet p.patch_children e.children
-  }
-
-newtype PatchMap k p = PatchMap (Map k p)
-
-instance semigroupPatchMap :: (Ord k, Semigroup p) => Semigroup (PatchMap k p) where
-  append (PatchMap p) (PatchMap q) = PatchMap (Map.unionWith append p q)
-
-instance monoidPatchMap :: (Ord k, Semigroup p) => Monoid (PatchMap k p) where
-  mempty = PatchMap Map.empty
-
-derive instance newtypePatchMap :: Newtype (PatchMap k p) _
-
-_PatchMap :: forall k p. Iso' (PatchMap k p) (Map k p)
-_PatchMap = _Newtype
-
-instance functorPatchMap :: Functor (PatchMap k) where
-  map f (PatchMap m) = PatchMap (map f m)
-
-instance functorWithIndexPatchMap :: FunctorWithIndex k (PatchMap k) where
-  mapWithIndex f (PatchMap m) = PatchMap (mapWithIndex f m)
-
-instance foldlablePatchMap :: Foldable (PatchMap k) where
-  foldr f z (PatchMap m) = foldr f z m
-  foldl f z (PatchMap m) = foldl f z m
-  foldMap f (PatchMap m) = foldMap f m
-
-instance foldlableWithIndexPatchMap :: FoldableWithIndex k (PatchMap k) where
-  foldrWithIndex f z (PatchMap m) = foldrWithIndex f z m
-  foldlWithIndex f z (PatchMap m) = foldlWithIndex f z m
-  foldMapWithIndex f (PatchMap m) = foldMapWithIndex f m
-
-instance traversablePatchMap :: Traversable (PatchMap k) where
-  traverse f (PatchMap m) = PatchMap <$> traverse f m
-  sequence (PatchMap m) = PatchMap <$> sequence m
-
-instance traversableWithIndexPatchMap :: TraversableWithIndex k (PatchMap k) where
-  traverseWithIndex f (PatchMap m) = PatchMap <$> traverseWithIndex f m
-
-instance encodeJsonPatchMap :: EncodeJson p => EncodeJson (PatchMap String p) where
-  encodeJson (PatchMap m) =
-    encodeJson $ FO.fromFoldable $ (Map.toUnfoldable m :: Array _)
-
-instance decodeJsonPatchMap :: DecodeJson p => DecodeJson (PatchMap String p) where
-  decodeJson json = do
-    obj <- decodeJson json
-    pure $ PatchMap $ Map.fromFoldableWithIndex (obj :: FO.Object p)
-
-isEmptyPatchMap :: forall k p. PatchMap k p -> Boolean
-isEmptyPatchMap (PatchMap p) = Map.isEmpty p
-
-applyPatchMap :: forall k p v. Ord k => (p -> v -> v) -> PatchMap k p -> Map k v -> Map k v
-applyPatchMap applyPatchValue (PatchMap p) = mapWithIndex f
-  where
-    f k v =
-      case Map.lookup k p of
-        Nothing -> v
-        Just pv -> applyPatchValue pv v
-
-type NgramsTablePatch = PatchMap NgramsTerm NgramsPatch
-
-type RootParent = { root :: NgramsTerm, parent :: NgramsTerm }
-
-type ReParent a = forall m. MonadState NgramsTable m => a -> m Unit
-
-reRootChildren :: NgramsTerm -> ReParent NgramsTerm
-reRootChildren root ngram = do
-  nre <- use (at ngram)
-  traverseOf_ (_Just <<< _NgramsElement <<< _children <<< folded) (\child -> do
-    at child <<< _Just <<< _NgramsElement <<< _root ?= root
-    reRootChildren root child) nre
-
-reParent :: Maybe RootParent -> ReParent NgramsTerm
-reParent mrp child = do
-  at child <<< _Just <<< _NgramsElement %= ((_parent .~ (view _parent <$> mrp)) <<<
-                                            (_root   .~ (view _root   <$> mrp)))
-  reRootChildren (maybe child identity (mrp ^? _Just <<< _root)) child
-
--- reParentNgramsPatch :: NgramsTerm -> ReParent NgramsPatch
--- ^ GHC would have accepted this type. Here reParentNgramsPatch checks but
---   not its usage in reParentNgramsTablePatch.
-reParentNgramsPatch :: forall m. MonadState NgramsTable m
-                    => NgramsTerm -> NgramsPatch -> m Unit
-reParentNgramsPatch parent (NgramsPatch {patch_children: PatchSet {rem, add}}) = do
-  -- root_of_parent <- use (at parent <<< _Just <<< _NgramsElement <<< _root)
-  -- ^ TODO this does not type checks, we do the following two lines instead:
-  s <- use (at parent)
-  let root_of_parent = s ^. (_Just <<< _NgramsElement <<< _root)
-  let rp = { root: maybe parent identity root_of_parent, parent }
-  traverse_ (reParent Nothing) rem
-  traverse_ (reParent $ Just rp) add
-
-reParentNgramsTablePatch :: ReParent NgramsTablePatch
-reParentNgramsTablePatch = void <<< traverseWithIndex reParentNgramsPatch
-
-applyNgramsTablePatch :: NgramsTablePatch -> NgramsTable -> NgramsTable
-applyNgramsTablePatch p (NgramsTable m) =
-  execState (reParentNgramsTablePatch p) $
-  NgramsTable $ applyPatchMap applyNgramsPatch p m
-
------------------------------------------------------------------------------------
-
 type State =
-  { ngramsTablePatch :: NgramsTablePatch
-  , ngramsVersion    :: Version
-  , ngramsParent     :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
+  CoreState
+  ( ngramsParent     :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
   , ngramsChildren   :: Map NgramsTerm Boolean
                      -- ^ Used only when grouping.
                      --   This updates the children of `ngramsParent`,
                      --   ngrams set to `true` are to be added, and `false` to
                      --   be removed.
-  }
+  )
 
 _ngramsChildren = prop (SProxy :: SProxy "ngramsChildren")
 
@@ -633,20 +194,6 @@ tableContainer { pageParams
     setTermListFilter x = setPageParams $ _ { termListFilter = x }
     setTermSizeFilter x = setPageParams $ _ { termSizeFilter = x }
 
-putTable :: {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsTablePatch -> Aff (Versioned NgramsTablePatch)
-putTable {nodeId, listIds, tabType} =
-  put (toUrl Back (PutNgrams tabType (head listIds)) $ Just nodeId)
-
-commitPatch :: {nodeId :: Int, listIds :: Array Int, tabType :: TabType}
-            -> Versioned NgramsTablePatch -> StateCoTransformer State Unit
-commitPatch props pt@(Versioned {data: tablePatch}) = do
-  Versioned {version: newVersion, data: newPatch} <- lift $ putTable props pt
-  modifyState_ $ \s ->
-    s { ngramsVersion    = newVersion
-      , ngramsTablePatch = newPatch <> tablePatch <> s.ngramsTablePatch
-      }
-    -- TODO: check that pt.version == s.ngramsTablePatch.version
-
 toggleMap :: forall a. a -> Maybe a -> Maybe a
 toggleMap _ (Just _) = Nothing
 toggleMap b Nothing  = Just b
@@ -687,8 +234,8 @@ ngramsTableSpec = simpleSpec performAction render
         pt = PatchMap $ Map.fromFoldable [Tuple parent pe]
         -- TODO ROOT-UPDATE
         -- patch the root of the child to be equal to the root of the parent.
-    performAction (AddNewNgram ngram) {path: {nodeId, listIds, tabType}} _ =
-      lift $ post (toUrl Back (PutNgrams tabType (head listIds)) $ Just nodeId) [ngram]
+    performAction (AddNewNgram ngram) {path: params} _ =
+      lift $ addNewNgram ngram params
 
     render :: Render State Props' Action
     render dispatch { path: pageParams
@@ -748,28 +295,6 @@ ngramsTableSpec = simpleSpec performAction render
               , delete: false
               }
 
-convOrderBy (T.ASC  (T.ColumnName "Score (Occurrences)")) = ScoreAsc
-convOrderBy (T.DESC (T.ColumnName "Score (Occurrences)")) = ScoreDesc
-convOrderBy (T.ASC  _) = TermAsc
-convOrderBy (T.DESC _) = TermDesc
-
-loadNgramsTable :: PageParams -> Aff VersionedNgramsTable
-loadNgramsTable { nodeId, listIds, termListFilter, termSizeFilter
-         , searchQuery, tabType, params: {offset, limit, orderBy}} =
-  get $ toUrl Back
-          (GetNgrams { tabType, offset, limit, listIds
-                     , orderBy: convOrderBy <$> orderBy
-                     , termListFilter, termSizeFilter
-                     , searchQuery
-                     })
-          (Just nodeId)
-
-ngramsLoaderClass :: Loader.LoaderClass PageParams VersionedNgramsTable
-ngramsLoaderClass = Loader.createLoaderClass "NgramsTableLoader" loadNgramsTable
-
-ngramsLoader :: Loader.Props' PageParams VersionedNgramsTable -> ReactElement
-ngramsLoader props = React.createElement ngramsLoaderClass props []
-
 ngramsTableClass :: Loader.InnerClass PageParams VersionedNgramsTable
 ngramsTableClass = createClass "NgramsTable" ngramsTableSpec initialState
 

src/Gargantext/Components/NgramsTable/Core.purs

+module Gargantext.Components.NgramsTable.Core
+  ( PageParams
+  , PatchMap
+  , NgramsElement(..)
+  , _NgramsElement
+  , NgramsPatch(..)
+  , NgramsTable(..)
+  , NgramsTablePatch
+  , _NgramsTable
+  , NgramsTerm
+  , Version
+  , Versioned(..)
+  , VersionedNgramsTable
+  , CoreState
+  , highlightNgrams
+  , initialPageParams
+  , loadNgramsTable
+  , ngramsLoader
+  , ngramsLoaderClass
+  , convOrderBy
+  , Replace(..) -- Ideally we should keep the constructors hidden
+  , replace
+  , PatchSet(..)
+  , PatchMap(..)
+  , patchSetFromMap
+  , applyPatchSet
+  , applyNgramsTablePatch
+  , _list
+  , _occurrences
+  , _children
+  , _ngrams
+  , _parent
+  , _root
+  , commitPatch
+  , addNewNgram
+  )
+  where
+
+import Control.Monad.State (class MonadState, execState)
+import Control.Monad.Cont.Trans (lift)
+import Data.Array (head)
+import Data.Array as A
+import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson
+                     , jsonEmptyObject, (:=), (~>), (.?), (.??) )
+import Data.Either (Either(..))
+import Data.Foldable (class Foldable, foldMap, foldl, foldr)
+import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)
+import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)
+import Data.Newtype (class Newtype)
+import Data.Lens (Iso', Lens', use, view, (%=), (.~), (?=), (^.), (^?))
+import Data.Lens.Common (_Just)
+import Data.Lens.At (class At, at)
+import Data.Lens.Index (class Index, ix)
+import Data.Lens.Fold (folded, traverseOf_)
+import Data.Lens.Record (prop)
+import Data.Lens.Iso.Newtype (_Newtype)
+import Data.List ((:), List(Nil))
+import Data.Map (Map)
+import Data.Map as Map
+import Data.Maybe (Maybe(..), maybe)
+import Data.Traversable (class Traversable, traverse, traverse_, sequence)
+import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
+import Data.Set (Set)
+import Data.Set as Set
+import Data.String as S
+import Data.String.Regex as R
+import Data.String.Regex.Flags as R
+import Data.Symbol (SProxy(..))
+import Data.Tuple (Tuple(..))
+import Effect.Aff (Aff)
+import Foreign.Object as FO
+import React (ReactElement)
+import React as React
+import Thermite (StateCoTransformer, modifyState_)
+import Partial (crashWith)
+import Partial.Unsafe (unsafePartial)
+
+import Gargantext.Utils.KarpRabin (indicesOfAny)
+import Gargantext.Types (TermList(..), TermSize)
+import Gargantext.Config (toUrl, End(..), Path(..), TabType, OrderBy(..))
+import Gargantext.Config.REST (get, put, post)
+import Gargantext.Components.Table as T
+import Gargantext.Prelude
+import Gargantext.Components.Loader as Loader
+
+
+type PageParams =
+  { nodeId :: Int
+  , listIds :: Array Int
+  , params :: T.Params
+  , tabType :: TabType
+  , searchQuery :: String
+  , termListFilter :: Maybe TermList -- Nothing means all
+  , termSizeFilter :: Maybe TermSize -- Nothing means all
+  }
+
+initialPageParams :: Int -> Array Int -> TabType -> PageParams
+initialPageParams nodeId listIds tabType =
+  { nodeId
+  , listIds
+  , params: T.initialParams
+  , tabType
+  , termSizeFilter: Nothing
+  , termListFilter: Just GraphTerm
+  , searchQuery: ""
+  }
+
+type NgramsTerm = String
+
+-----------------------------------------------------------------------------------
+newtype NgramsElement = NgramsElement
+  { ngrams      :: NgramsTerm
+  , list        :: TermList
+  , occurrences :: Int
+  , parent      :: Maybe NgramsTerm
+  , root        :: Maybe NgramsTerm
+  , children    :: Set NgramsTerm
+  }
+
+derive instance eqNgramsElement :: Eq NgramsElement
+derive instance eqNgramsTable :: Eq NgramsTable
+
+
+_parent = prop (SProxy :: SProxy "parent")
+_root   = prop (SProxy :: SProxy "root")
+_ngrams = prop (SProxy :: SProxy "ngrams")
+
+_children :: forall row. Lens' { children :: Set NgramsTerm | row } (Set NgramsTerm)
+_children = prop (SProxy :: SProxy "children")
+
+_occurrences :: forall row. Lens' { occurrences :: Int | row } Int
+_occurrences = prop (SProxy :: SProxy "occurrences")
+
+_list :: forall a row. Lens' { list :: a | row } a
+_list = prop (SProxy :: SProxy "list")
+
+derive instance newtypeNgramsElement :: Newtype NgramsElement _
+
+_NgramsElement :: Iso' NgramsElement _
+_NgramsElement = _Newtype
+
+instance decodeJsonNgramsElement :: DecodeJson NgramsElement where
+  decodeJson json = do
+    obj         <- decodeJson json
+    ngrams      <- obj .?  "ngrams"
+    list        <- obj .?  "list"
+    occurrences <- obj .?  "occurrences"
+    parent      <- obj .?? "parent"
+    root        <- obj .?? "root"
+    children'   <- obj .?  "children"
+    let children = Set.fromFoldable (children' :: Array NgramsTerm)
+    pure $ NgramsElement {ngrams, list, occurrences, parent, root, children}
+
+-----------------------------------------------------------------------------------
+type Version = Int
+
+newtype Versioned a = Versioned
+  { version :: Version
+  , data    :: a
+  }
+
+instance encodeJsonVersioned :: EncodeJson a => EncodeJson (Versioned a) where
+  encodeJson (Versioned {version, data: data_})
+     = "version" := version
+    ~> "data" := data_
+    ~> jsonEmptyObject
+
+instance decodeJsonVersioned :: DecodeJson a => DecodeJson (Versioned a) where
+  decodeJson json = do
+    obj     <- decodeJson json
+    version <- obj .? "version"
+    data_   <- obj .? "data"
+    pure $ Versioned {version, data: data_}
+
+-- type NgramsTable = Array (NTree NgramsElement)
+-- type NgramsTable = Array NgramsElement
+newtype NgramsTable = NgramsTable (Map NgramsTerm NgramsElement)
+
+derive instance newtypeNgramsTable :: Newtype NgramsTable _
+
+_NgramsTable :: Iso' NgramsTable (Map NgramsTerm NgramsElement)
+_NgramsTable = _Newtype
+
+instance indexNgramsTable :: Index NgramsTable String NgramsElement where
+  ix k = _NgramsTable <<< ix k
+
+instance atNgramsTable :: At NgramsTable String NgramsElement where
+  at k = _NgramsTable <<< at k
+
+instance decodeJsonNgramsTable :: DecodeJson NgramsTable where
+  decodeJson json = do
+    elements <- decodeJson json
+    pure $ NgramsTable
+         $ Map.fromFoldable
+         $ f <$> (elements :: Array NgramsElement)
+    where
+      f e@(NgramsElement e') = Tuple e'.ngrams e
+-----------------------------------------------------------------------------------
+
+-- TODO: while this function works well with word boundaries,
+--       it inserts too many spaces.
+highlightNgrams :: NgramsTable -> String -> Array (Tuple String (Maybe TermList))
+highlightNgrams (NgramsTable table) input0 =
+    let sN = unsafePartial (foldl goFold {i0: 0, s: input, l: Nil} ixs) in
+    A.reverse (A.fromFoldable (consNonEmpty sN.s sN.l))
+  where
+    sp x = " " <> S.replaceAll (S.Pattern " ") (S.Replacement "  ") x <> " "
+    unsp x =
+      case S.stripSuffix (S.Pattern " ") x of
+        Nothing -> x
+        Just x1 -> S.replaceAll (S.Pattern "  ") (S.Replacement " ") (S.drop 1 x1)
+    input = sp input0
+    pats = A.fromFoldable (Map.keys table)
+    ixs  = indicesOfAny (sp <$> pats) (S.toLower $ R.replace theRegex " " input)
+      where
+        theRegex = case R.regex "[.,;:!?'\\{}()]" (R.global <> R.multiline) of
+            Left e  -> unsafePartial $ crashWith e
+            Right r -> r
+
+    consNonEmpty x xs
+      | S.null x  = xs
+      | otherwise = Tuple x Nothing : xs
+
+    -- NOTE that only the first matching pattern is used, the others are ignored!
+    goFold :: Partial => _ -> Tuple Int (Array Int) -> _
+    goFold { i0, s, l } (Tuple i pis)
+      | i < i0    =
+        -- Skip this pattern which is overlapping with a previous one.
+        { i0, s, l }
+      | otherwise =
+      case A.index pis 0 of
+        Nothing ->
+          { i0, s, l }
+        Just pi ->
+          case A.index pats pi of
+            Nothing ->
+              crashWith "highlightNgrams: out of bounds pattern"
+            Just pat ->
+              let lpat = S.length (sp pat) in
+              case Map.lookup pat table of
+                Nothing ->
+                  crashWith "highlightNgrams: pattern missing from table"
+                Just (NgramsElement ne) ->
+                  let s1 = S.splitAt (i - i0) s
+                      s2 = S.splitAt lpat s1.after in
+                  -- s2.before and pat might differ by casing only!
+                  { i0: i + lpat
+                  , s:  s2.after
+                  , l:  Tuple " " Nothing :
+                        Tuple s2.before (Just ne.list) :
+                        Tuple " " Nothing :
+                        consNonEmpty (unsp s1.before) l
+                  }
+
+-----------------------------------------------------------------------------------
+
+type VersionedNgramsTable = Versioned NgramsTable
+
+-----------------------------------------------------------------------------------
+data Replace a
+  = Keep
+  | Replace { old :: a, new :: a }
+
+replace :: forall a. Eq a => a -> a -> Replace a
+replace old new
+  | old == new = Keep
+  | otherwise  = Replace { old, new }
+
+instance semigroupReplace :: Semigroup (Replace a) where
+  append Keep p = p
+  append p Keep = p
+  append (Replace { old: _m, new }) (Replace { old, new: _m' }) =
+    -- assert _m == _m'
+    Replace { old, new }
+
+instance semigroupMonoid :: Monoid (Replace a) where
+  mempty = Keep
+
+applyReplace :: forall a. Eq a => Replace a -> a -> a
+applyReplace Keep a = a
+applyReplace (Replace { old, new }) a
+  | a == old  = new
+  | otherwise = a
+
+instance encodeJsonReplace :: EncodeJson a => EncodeJson (Replace a) where
+  encodeJson Keep
+    = "tag" := "Keep"
+   ~> jsonEmptyObject
+  encodeJson (Replace {old, new})
+    = "old" := old
+   ~> "new" := new
+   ~> "tag" := "Replace"
+   ~> jsonEmptyObject
+
+instance decodeJsonReplace :: (DecodeJson a, Eq a) => DecodeJson (Replace a) where
+  decodeJson json = do
+    obj  <- decodeJson json
+    mold <- obj .?? "old"
+    mnew <- obj .?? "new"
+    case Tuple mold mnew of
+      Tuple (Just old) (Just new) -> pure $ replace old new
+      Tuple Nothing Nothing       -> pure Keep
+      _                           -> Left "decodeJsonReplace"
+
+-- Representing a PatchSet as `Map a Boolean` would have the advantage
+-- of enforcing rem and add to be disjoint.
+newtype PatchSet a = PatchSet
+  { rem :: Set a
+  , add :: Set a
+  }
+
+instance semigroupPatchSet :: Ord a => Semigroup (PatchSet a) where
+  append (PatchSet p) (PatchSet q) = PatchSet
+    { rem: q.rem <> p.rem
+    , add: Set.difference q.add p.rem <> p.add
+    }
+
+instance monoidPatchSet :: Ord a => Monoid (PatchSet a) where
+  mempty = PatchSet { rem: Set.empty, add: Set.empty }
+
+instance encodeJsonPatchSet :: EncodeJson a => EncodeJson (PatchSet a) where
+  encodeJson (PatchSet {rem, add})
+    -- TODO only include non empty fields
+    = "rem" := (Set.toUnfoldable rem :: Array a)
+   ~> "add" := (Set.toUnfoldable add :: Array a)
+   ~> jsonEmptyObject
+
+instance decodeJsonPatchSet :: (Ord a, DecodeJson a) => DecodeJson (PatchSet a) where
+  decodeJson json = do
+    -- TODO handle empty fields
+    obj <- decodeJson json
+    rem <- mkSet <$> (obj .? "rem")
+    add <- mkSet <$> (obj .? "add")
+    pure $ PatchSet { rem, add }
+   where
+    mkSet :: forall b. Ord b => Array b -> Set b
+    mkSet = Set.fromFoldable
+
+applyPatchSet :: forall a. Ord a => PatchSet a -> Set a -> Set a
+applyPatchSet (PatchSet p) s = Set.difference s p.rem <> p.add
+
+patchSetFromMap :: forall a. Ord a => Map a Boolean -> PatchSet a
+patchSetFromMap m = PatchSet { rem: Map.keys (Map.filter not m)
+                             , add: Map.keys (Map.filter identity m) }
+  -- TODO Map.partition would be nice here
+
+newtype NgramsPatch = NgramsPatch
+  { patch_children :: PatchSet NgramsTerm
+  , patch_list     :: Replace TermList
+  }
+
+instance semigroupNgramsPatch :: Semigroup NgramsPatch where
+  append (NgramsPatch p) (NgramsPatch q) = NgramsPatch
+    { patch_children: p.patch_children <> q.patch_children
+    , patch_list:     p.patch_list     <> q.patch_list
+    }
+
+instance monoidNgramsPatch :: Monoid NgramsPatch where
+  mempty = NgramsPatch { patch_children: mempty, patch_list: mempty }
+
+instance encodeJsonNgramsPatch :: EncodeJson NgramsPatch where
+  -- TODO only include non empty fields
+  encodeJson (NgramsPatch { patch_children, patch_list })
+     = "patch_children" := patch_children
+    ~> "patch_list"     := patch_list
+    ~> jsonEmptyObject
+
+instance decodeJsonNgramsPatch :: DecodeJson NgramsPatch where
+  decodeJson json = do
+    obj            <- decodeJson json
+    -- TODO handle empty fields
+    patch_list     <- obj .? "patch_list"
+    patch_children <- obj .? "patch_children"
+    pure $ NgramsPatch { patch_list, patch_children }
+
+applyNgramsPatch :: NgramsPatch -> NgramsElement -> NgramsElement
+applyNgramsPatch (NgramsPatch p) (NgramsElement e) = NgramsElement
+  { ngrams:      e.ngrams
+  , list:        applyReplace p.patch_list e.list
+  , occurrences: e.occurrences
+  , parent:      e.parent
+  , root:        e.root
+  , children:    applyPatchSet p.patch_children e.children
+  }
+
+newtype PatchMap k p = PatchMap (Map k p)
+
+instance semigroupPatchMap :: (Ord k, Semigroup p) => Semigroup (PatchMap k p) where
+  append (PatchMap p) (PatchMap q) = PatchMap (Map.unionWith append p q)
+
+instance monoidPatchMap :: (Ord k, Semigroup p) => Monoid (PatchMap k p) where
+  mempty = PatchMap Map.empty
+
+derive instance newtypePatchMap :: Newtype (PatchMap k p) _
+
+_PatchMap :: forall k p. Iso' (PatchMap k p) (Map k p)
+_PatchMap = _Newtype
+
+instance functorPatchMap :: Functor (PatchMap k) where
+  map f (PatchMap m) = PatchMap (map f m)
+
+instance functorWithIndexPatchMap :: FunctorWithIndex k (PatchMap k) where
+  mapWithIndex f (PatchMap m) = PatchMap (mapWithIndex f m)
+
+instance foldlablePatchMap :: Foldable (PatchMap k) where
+  foldr f z (PatchMap m) = foldr f z m
+  foldl f z (PatchMap m) = foldl f z m
+  foldMap f (PatchMap m) = foldMap f m
+
+instance foldlableWithIndexPatchMap :: FoldableWithIndex k (PatchMap k) where
+  foldrWithIndex f z (PatchMap m) = foldrWithIndex f z m
+  foldlWithIndex f z (PatchMap m) = foldlWithIndex f z m
+  foldMapWithIndex f (PatchMap m) = foldMapWithIndex f m
+
+instance traversablePatchMap :: Traversable (PatchMap k) where
+  traverse f (PatchMap m) = PatchMap <$> traverse f m
+  sequence (PatchMap m) = PatchMap <$> sequence m
+
+instance traversableWithIndexPatchMap :: TraversableWithIndex k (PatchMap k) where
+  traverseWithIndex f (PatchMap m) = PatchMap <$> traverseWithIndex f m
+
+instance encodeJsonPatchMap :: EncodeJson p => EncodeJson (PatchMap String p) where
+  encodeJson (PatchMap m) =
+    encodeJson $ FO.fromFoldable $ (Map.toUnfoldable m :: Array _)
+
+instance decodeJsonPatchMap :: DecodeJson p => DecodeJson (PatchMap String p) where
+  decodeJson json = do
+    obj <- decodeJson json
+    pure $ PatchMap $ Map.fromFoldableWithIndex (obj :: FO.Object p)
+
+isEmptyPatchMap :: forall k p. PatchMap k p -> Boolean
+isEmptyPatchMap (PatchMap p) = Map.isEmpty p
+
+applyPatchMap :: forall k p v. Ord k => (p -> v -> v) -> PatchMap k p -> Map k v -> Map k v
+applyPatchMap applyPatchValue (PatchMap p) = mapWithIndex f
+  where
+    f k v =
+      case Map.lookup k p of
+        Nothing -> v
+        Just pv -> applyPatchValue pv v
+
+type NgramsTablePatch = PatchMap NgramsTerm NgramsPatch
+
+type RootParent = { root :: NgramsTerm, parent :: NgramsTerm }
+
+type ReParent a = forall m. MonadState NgramsTable m => a -> m Unit
+
+reRootChildren :: NgramsTerm -> ReParent NgramsTerm
+reRootChildren root ngram = do
+  nre <- use (at ngram)
+  traverseOf_ (_Just <<< _NgramsElement <<< _children <<< folded) (\child -> do
+    at child <<< _Just <<< _NgramsElement <<< _root ?= root
+    reRootChildren root child) nre
+
+reParent :: Maybe RootParent -> ReParent NgramsTerm
+reParent mrp child = do
+  at child <<< _Just <<< _NgramsElement %= ((_parent .~ (view _parent <$> mrp)) <<<
+                                            (_root   .~ (view _root   <$> mrp)))
+  reRootChildren (maybe child identity (mrp ^? _Just <<< _root)) child
+
+-- reParentNgramsPatch :: NgramsTerm -> ReParent NgramsPatch
+-- ^ GHC would have accepted this type. Here reParentNgramsPatch checks but
+--   not its usage in reParentNgramsTablePatch.
+reParentNgramsPatch :: forall m. MonadState NgramsTable m
+                    => NgramsTerm -> NgramsPatch -> m Unit
+reParentNgramsPatch parent (NgramsPatch {patch_children: PatchSet {rem, add}}) = do
+  -- root_of_parent <- use (at parent <<< _Just <<< _NgramsElement <<< _root)
+  -- ^ TODO this does not type checks, we do the following two lines instead:
+  s <- use (at parent)
+  let root_of_parent = s ^. (_Just <<< _NgramsElement <<< _root)
+  let rp = { root: maybe parent identity root_of_parent, parent }
+  traverse_ (reParent Nothing) rem
+  traverse_ (reParent $ Just rp) add
+
+reParentNgramsTablePatch :: ReParent NgramsTablePatch
+reParentNgramsTablePatch = void <<< traverseWithIndex reParentNgramsPatch
+
+applyNgramsTablePatch :: NgramsTablePatch -> NgramsTable -> NgramsTable
+applyNgramsTablePatch p (NgramsTable m) =
+  execState (reParentNgramsTablePatch p) $
+  NgramsTable $ applyPatchMap applyNgramsPatch p m
+
+-----------------------------------------------------------------------------------
+
+type CoreState s =
+  { ngramsTablePatch :: NgramsTablePatch
+  , ngramsVersion    :: Version
+  | s
+  }
+
+putTable :: {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsTablePatch -> Aff (Versioned NgramsTablePatch)
+putTable {nodeId, listIds, tabType} =
+  put (toUrl Back (PutNgrams tabType (head listIds)) $ Just nodeId)
+
+commitPatch :: forall s. {nodeId :: Int, listIds :: Array Int, tabType :: TabType}
+            -> Versioned NgramsTablePatch -> StateCoTransformer (CoreState s) Unit
+commitPatch props pt@(Versioned {data: tablePatch}) = do
+  Versioned {version: newVersion, data: newPatch} <- lift $ putTable props pt
+  modifyState_ $ \s ->
+    s { ngramsVersion    = newVersion
+      , ngramsTablePatch = newPatch <> tablePatch <> s.ngramsTablePatch
+      }
+    -- TODO: check that pt.version == s.ngramsTablePatch.version
+
+loadNgramsTable :: PageParams -> Aff VersionedNgramsTable
+loadNgramsTable { nodeId, listIds, termListFilter, termSizeFilter
+         , searchQuery, tabType, params: {offset, limit, orderBy}} =
+  get $ toUrl Back
+          (GetNgrams { tabType, offset, limit, listIds
+                     , orderBy: convOrderBy <$> orderBy
+                     , termListFilter, termSizeFilter
+                     , searchQuery
+                     })
+          (Just nodeId)
+
+convOrderBy (T.ASC  (T.ColumnName "Score (Occurrences)")) = ScoreAsc
+convOrderBy (T.DESC (T.ColumnName "Score (Occurrences)")) = ScoreDesc
+convOrderBy (T.ASC  _) = TermAsc
+convOrderBy (T.DESC _) = TermDesc
+
+addNewNgram :: NgramsTerm -> PageParams -> Aff Unit
+addNewNgram ngram {nodeId, listIds, tabType} =
+  post (toUrl Back (PutNgrams tabType (head listIds)) $ Just nodeId) [ngram]
+
+ngramsLoaderClass :: Loader.LoaderClass PageParams VersionedNgramsTable
+ngramsLoaderClass = Loader.createLoaderClass "NgramsTableLoader" loadNgramsTable
+
+ngramsLoader :: Loader.Props' PageParams VersionedNgramsTable -> ReactElement
+ngramsLoader props = React.createElement ngramsLoaderClass props []

src/Gargantext/Pages/Corpus/Document.purs

@@ -21,7 +21,7 @@ import Gargantext.Prelude
 import Gargantext.Config          (toUrl, NodeType(..), End(..), TabSubType(..), TabType(..), CTabNgramType(..))
 import Gargantext.Config.REST     (get)
 import Gargantext.Components.Node (NodePoly(..))
-import Gargantext.Components.NgramsTable (NgramsTable(..), NgramsElement(..), loadNgramsTable, Versioned(..))
+import Gargantext.Components.NgramsTable.Core (NgramsTable(..), NgramsElement(..), loadNgramsTable, Versioned(..))
 import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
 import Gargantext.Types (TermList(..))
 import Gargantext.Utils.Reactix ( scuff )