Merge remote-tracking branch 'origin/dev-doc-annot' into dev-merge

src/Gargantext/Components/Annotation/AnnotatedField.purs

@@ -12,33 +12,35 @@
 module Gargantext.Components.Annotation.AnnotatedField where
 
 import Prelude
-import Data.Map as Map
+import Data.Lens ((^?), _Just)
+import Data.Lens.At (at)
 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 ( NgramsTerm, NgramsTable(..), _NgramsElement, _list, highlightNgrams )
 import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu )
 import Gargantext.Utils.Selection as Sel
 
 type Run = Tuple String (Maybe TermList)
 
-type Props = ( ngrams :: NgramsTable, text :: Maybe String )
+type Props =
+  ( ngrams      :: NgramsTable
+  , setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
+  , text        :: Maybe String
+  )
 
-defaultProps :: Record Props
-defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing }
+-- UNUSED
+-- defaultProps :: Record Props
+-- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit }
 
 annotatedField :: Record Props -> R.Element
 annotatedField p = R.createElement annotatedFieldComponent p []
@@ -46,14 +48,15 @@ annotatedField p = R.createElement annotatedFieldComponent p []
 annotatedFieldComponent :: R.Component Props
 annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt
   where
-    runs props =
-      HTML.div { className: "annotated-field-runs" } (map annotateRun $ compile props)
-    cpt props _ = do
+    cpt {ngrams,setTermList,text} _ = do
       menu /\ setMenu <- R.useState $ \_ -> pure Nothing
       let wrapperProps =
             { className: "annotated-field-wrapper"
-            , onContextMenu: mkEffectFn1 (maybeShowMenu setMenu props.ngrams) }
-      pure $ HTML.div wrapperProps [ maybeAddMenu setMenu (runs props) menu]
+            , onContextMenu: mkEffectFn1 (maybeShowMenu setMenu setTermList ngrams)
+            }
+          runs =
+            HTML.div { className: "annotated-field-runs" } $ map annotateRun $ compile ngrams text
+      pure $ HTML.div wrapperProps [maybeAddMenu setMenu runs menu]
 
 maybeAddMenu
   :: (Maybe AnnotationMenu -> Effect Unit)
@@ -63,17 +66,16 @@ maybeAddMenu
 maybeAddMenu setMenu e (Just props) = annotationMenu setMenu props <> e
 maybeAddMenu _ e _ = e
 
-compile :: Record Props -> Array Run
-compile props = runs props.text
-  where runs = maybe [] (highlightNgrams props.ngrams)
+compile :: NgramsTable -> Maybe String -> Array Run
+compile ngrams = maybe [] (highlightNgrams ngrams)
 
 maybeShowMenu
-  :: forall t
-  .  (Maybe AnnotationMenu -> Effect Unit)
+  :: (Maybe AnnotationMenu -> Effect Unit)
+  -> (NgramsTerm -> Maybe TermList -> TermList -> Effect Unit)
   -> NgramsTable
   -> E.SyntheticEvent DE.MouseEvent
   -> Effect Unit
-maybeShowMenu setMenu ngrams event = do
+maybeShowMenu setMenu setTermList ngrams event = do
   s <- Sel.getSelection
   case s of
     Just sel -> do
@@ -81,13 +83,15 @@ maybeShowMenu setMenu ngrams event = do
         "" -> pure unit
         sel' -> do
           let x = E.clientX event
-          let y = E.clientY event
+              y = E.clientY event
+              list = findNgram ngrams sel'
+              setList = setTermList sel' list
           E.preventDefault event
-          setMenu $ Just { x, y, list: findNgram ngrams sel' }
+          setMenu $ Just { x, y, sel, list, setList }
     Nothing -> pure unit
 
 findNgram :: NgramsTable -> String -> Maybe TermList
-findNgram _ _ = Nothing
+findNgram (NgramsTable m) s = m ^? at s <<< _Just <<< _NgramsElement <<< _list
 
 -- Runs
 

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 )
@@ -15,35 +15,36 @@ import Gargantext.Types ( TermList(..), termListName )
 import Gargantext.Components.Annotation.Utils ( termClass )
 
 import Gargantext.Components.ContextMenu.ContextMenu as CM
+import Gargantext.Utils.Selection (Selection, selectionToString)
 
-type Props = ( list :: Maybe TermList )
+type Props =
+  ( sel :: Selection
+  , list :: Maybe TermList
+  , setList :: TermList -> Effect Unit
+  )
 
-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
 annotationMenu :: (Maybe AnnotationMenu -> Effect Unit) -> AnnotationMenu -> R.Element
-annotationMenu setMenu { x,y,list } =
-  CM.contextMenu { x,y,setMenu } [ R.createElement annotationMenuCpt {list} [] ]
+annotationMenu setMenu { x,y,sel,list,setList } =
+  CM.contextMenu { x,y,setMenu } [
+    R.createElement annotationMenuCpt {sel,list,setList} []
+  ]
 
 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 {setList} 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
-
--- TODO: what happens when we add to a term list?
-addToTermList :: TermList -> Effect Unit
-addToTermList _ = pure unit
-
+        click = mkEffectFn1 $ \_ -> setList t

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: ""
-  }
-
-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
-
------------------------------------------------------------------------------------
+import Gargantext.Components.NgramsTable.Core
 
 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,31 +192,17 @@ 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
 
-ngramsTableSpec :: Spec State Props' Action
+ngramsTableSpec :: Spec State LoadedNgramsTableProps Action
 ngramsTableSpec = simpleSpec performAction render
   where
     setParentResetChildren :: Maybe NgramsTerm -> State -> State
     setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = mempty }
 
-    performAction :: PerformAction State Props' Action
+    performAction :: PerformAction State LoadedNgramsTableProps Action
     performAction (SetParentResetChildren p) _ _ =
       modifyState_ $ setParentResetChildren p
     performAction (ToggleChild b c) _ _ =
@@ -687,10 +232,10 @@ 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 Nothing params
 
-    render :: Render State Props' Action
+    render :: Render State LoadedNgramsTableProps Action
     render dispatch { path: pageParams
                     , loaded: Versioned { data: initTable }
                     , dispatch: loaderDispatch }
@@ -748,28 +293,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
+  , CoreParams
+  , PatchMap
+  , NgramsElement(..)
+  , _NgramsElement
+  , NgramsPatch(..)
+  , NgramsTable(..)
+  , NgramsTablePatch
+  , _NgramsTable
+  , NgramsTerm
+  , Version
+  , Versioned(..)
+  , VersionedNgramsTable
+  , CoreState
+  , LoadedNgramsTableProps
+  , 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 CoreParams s =
+  { nodeId  :: Int
+  , listIds :: Array Int
+  , tabType :: TabType
+  | s
+  }
+
+type PageParams =
+  CoreParams
+    ( params :: T.Params
+    , 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) Nothing) $ 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 :: 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.createLoaderClass "NgramsTableLoader" loadNgramsTable
+
+ngramsLoader :: Loader.Props' PageParams VersionedNgramsTable -> ReactElement
+ngramsLoader props = React.createElement ngramsLoaderClass props []
+
+type LoadedNgramsTableProps = Loader.InnerProps PageParams VersionedNgramsTable ()

src/Gargantext/Config.purs

@@ -166,10 +166,11 @@ pathUrl c (GetNgrams
                     _           -> pathUrl c (NodeAPI Url_Document) i
 
 
-pathUrl c (PutNgrams t listid) i =
-    pathUrl c (NodeAPI Node) i <> "/ngrams?ngramsType=" <> showTabType' t <> listid'
-  where
-    listid' = maybe "" (\x -> "&list=" <> show x) listid
+pathUrl c (PutNgrams t listid termList) i =
+    pathUrl c (NodeAPI Node) i <> "/ngrams?ngramsType="
+      <> showTabType' t
+      <> maybe "" (\x -> "&list=" <> show x) listid
+      <> foldMap (\x -> "&listType=" <> show x) termList
 pathUrl c Auth Nothing = c.prePath <> "auth"
 pathUrl c Auth (Just _) = "impossible" -- TODO better types
 pathUrl c (NodeAPI nt) i = c.prePath <> nodeTypeUrl nt <> (maybe "" (\i' -> "/" <> show i') i)
@@ -274,7 +275,7 @@ data Path
       , termSizeFilter :: Maybe TermSize
       , searchQuery    :: String
       }
-  | PutNgrams TabType (Maybe ListId)
+  | PutNgrams TabType (Maybe ListId) (Maybe TermList)
   -- ^ The name is not good. In particular this URL is used both in PUT and POST.
   | NodeAPI NodeType
   | Search  { {-id :: Int

src/Gargantext/Pages/Corpus/Document.purs

 module Gargantext.Pages.Corpus.Document where
 
-
 import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
 import Data.Generic.Rep (class Generic)
-import Data.Lens (Lens', lens, (?~))
 import Data.Generic.Rep.Show (genericShow)
 import Data.Map as Map
-import Data.Set as Set
-import Data.Tuple (Tuple(..))
 import Data.Maybe (Maybe(..), maybe)
 import Effect.Aff (Aff)
-import React (ReactElement)
-import React.DOM (div, h4, li, option, p, span, text, ul)
-import React.DOM.Props (className, value)
-import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
-import Unsafe.Coerce (unsafeCoerce)
+import React (ReactElement, ReactClass)
+import React as React
+import React.DOM (div, h4, li, p, span, text, ul)
+import React.DOM.Props (className)
+import Thermite (PerformAction, Render, Spec, simpleSpec, cmapProps, defaultPerformAction, createClass)
 import Control.Monad.Trans.Class (lift)
 
 import Gargantext.Prelude
 import Gargantext.Config          (toUrl, NodeType(..), End(..), TabSubType(..), TabType(..), CTabNgramType(..))
 import Gargantext.Config.REST     (get)
+import Gargantext.Components.AutoUpdate (autoUpdateElt)
+import Gargantext.Components.Loader as Loader
 import Gargantext.Components.Node (NodePoly(..))
-import Gargantext.Components.NgramsTable (NgramsTable(..), NgramsElement(..), loadNgramsTable, Versioned(..))
+import Gargantext.Components.NgramsTable.Core
 import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
-import Gargantext.Types (TermList(..))
+import Gargantext.Types (TermList)
 import Gargantext.Utils.Reactix ( scuff )
 
-nge :: String -> Tuple String NgramsElement
-nge word = Tuple word elem where
-  elem = NgramsElement
-    { ngrams: word, list: StopTerm
-    , occurrences: 1, parent: Nothing
-    , root: Nothing, children: Set.empty }
-
-testTable :: NgramsTable
-testTable = NgramsTable $ Map.fromFoldable $ nge <$> words
-  where words = [ "the", "quick", "brown", "fox", "jumped", "over", "lazy", "dog" ]
-
-type State =
-  { document    :: Maybe (NodePoly Document)
-  , ngramsTable :: Maybe NgramsTable
-  , inputValue  :: String
-  }
+type DocPath = { nodeId :: Int, listIds :: Array Int, tabType :: TabType }
+
+type NodeDocument = NodePoly Document
+
+type LoadedData =
+  { document    :: NodeDocument
+  , ngramsTable :: VersionedNgramsTable }
 
-initialState :: {} -> State
-initialState {} =
-  { document: Nothing
-  , ngramsTable: (Just testTable)
-  , inputValue: ""
+type LoadedDataProps = Loader.InnerProps DocPath LoadedData ()
+
+-- This is a subpart of NgramsTable.State.
+type State = CoreState ()
+
+initialState :: forall props others
+              . { loaded :: { ngramsTable :: VersionedNgramsTable | others } | props }
+             -> State
+initialState {loaded: {ngramsTable: Versioned {version}}} =
+  { ngramsTablePatch: mempty
+  , ngramsVersion:    version
   }
 
+-- This is a subset of NgramsTable.Action.
 data Action
-  = Load Int Int
-  | ChangeString String
-  | SetInput String
+  = SetTermListItem NgramsTerm (Replace TermList)
+  | AddNewNgram NgramsTerm TermList
+  | Refresh
 
 newtype Status = Status { failed    :: Int
                         , succeeded :: Int
@@ -135,7 +131,7 @@ data Document
     --, text               :: Maybe String
     }
 
-defaultNodeDocument :: NodePoly Document
+defaultNodeDocument :: NodeDocument
 defaultNodeDocument =
   NodePoly { id : 0
            , typename : 0
@@ -277,66 +273,49 @@ instance decodeDocument :: DecodeJson Document
                       --, text
                       }
 
-------------------------------------------------------------------------
-performAction :: PerformAction State {} Action
-performAction (Load lId nId) _ _ = do
-  node <- lift $ getNode (Just nId)
-  (Versioned {version:_version, data:table}) <- lift $ loadNgramsTable {nodeId : nId
-                                  , listIds : [lId]
-                                  , params : { offset : 0, limit : 100, orderBy: Nothing}
-                                  , tabType : (TabDocument (TabNgramType CTabTerms))
-                                  , searchQuery : ""
-                                  , termListFilter : Nothing
-                                  , termSizeFilter : Nothing
-                                   }
-  
-  void $ modifyState $ _document    ?~ node
-  void $ modifyState $ _ngramsTable ?~ table
-  logs $ "Node Document " <> show nId <> " fetched."
-performAction (ChangeString ps) _ _ = pure unit
-performAction (SetInput ps) _ _ = void <$> modifyState $ _ { inputValue = ps }
-
-
-getNode :: Maybe Int -> Aff (NodePoly Document)
-getNode = get <<< toUrl Back Node
-
-_document :: Lens' State (Maybe (NodePoly Document))
-_document = lens (\s -> s.document) (\s ss -> s{document = ss})
-
-_ngramsTable :: Lens' State (Maybe NgramsTable)
-_ngramsTable = lens (\s -> s.ngramsTable) (\s ss -> s{ngramsTable = ss})
-
-
-------------------------------------------------------------------------
-
-docview :: Spec State {} Action
-docview = simpleSpec performAction render
+docViewSpec :: Spec State LoadedDataProps Action
+docViewSpec = simpleSpec performAction render
   where
-    render :: Render State {} Action
-    render dispatch _ state _ =
-      [
-          div [className "container1"]
+    performAction :: PerformAction State LoadedDataProps Action
+    performAction Refresh {path: {nodeId, listIds, tabType}} {ngramsVersion} = do
+        commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: mempty})
+    performAction (SetTermListItem n pl) {path: {nodeId, listIds, tabType}} {ngramsVersion} =
+        commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
+      where
+        pe = NgramsPatch { patch_list: pl, patch_children: mempty }
+        pt = PatchMap $ Map.singleton n pe
+    performAction (AddNewNgram ngram termList) {path: params} _ =
+      lift $ addNewNgram ngram (Just termList) params
+
+    render :: Render State LoadedDataProps Action
+    render dispatch { path: pageParams
+                    , loaded: { ngramsTable: Versioned { data: initTable }, document }
+                    , dispatch: loaderDispatch }
+                    { ngramsTablePatch }
+                    _reactChildren =
+      [ autoUpdateElt { duration: 3000
+                      , effect:   dispatch Refresh
+                      }
+      , div [className "container1"]
         [
           div [className "row"]
           [
             div [className "col-md-8"]
-              [ h4 [] [annotate document.title]
+            [ h4 [] [annotate doc.title]
             , ul [className "list-group"]
-                [ li' [ span [] [text' document.source]
+              [ li' [ span [] [text' doc.source]
                     , badge "source"
                     ]
-                
               -- TODO add href to /author/ if author present in
-                , li' [ span [] [text' document.authors]
+              , li' [ span [] [text' doc.authors]
                     , badge "authors"
                     ]
-                
-                , li' [ span [] [text' document.publication_date]
+              , li' [ span [] [text' doc.publication_date]
                     , badge "date"
                     ]
               ]
             , badge "abstract"
-              , annotate document.abstract
+            , annotate doc.abstract
             , div [className "jumbotron"]
               [ p [] [text "Empty Full Text"]
               ]
@@ -345,27 +324,48 @@ docview = simpleSpec performAction render
         ]
       ]
         where
-          annotate t = scuff $ AnnotatedField.annotatedField { ngrams: maybe (NgramsTable Map.empty) identity state.ngramsTable, text: t }
+          ngramsTable = applyNgramsTablePatch ngramsTablePatch initTable
+          setTermList ngram Nothing        newList = dispatch $ AddNewNgram ngram newList
+          setTermList ngram (Just oldList) newList = dispatch $ SetTermListItem ngram (replace oldList newList)
+          annotate text = scuff $ AnnotatedField.annotatedField { ngrams: ngramsTable, setTermList, text }
           li' = li [className "list-group-item justify-content-between"]
           text' x = text $ maybe "Nothing" identity x
           badge s = span [className "badge badge-default badge-pill"] [text s]
-          NodePoly {hyperdata : Document document} = 
-            maybe defaultNodeDocument identity state.document
-
-findInDocument :: (Document -> Maybe String) -> State -> Maybe String
-findInDocument f state =
-  do (NodePoly d) <- state.document
-     f d.hyperdata
+          NodePoly {hyperdata : Document doc} = document
 
-aryPS :: Array String
-aryPS = ["Map", "Main", "Stop"]
+layout :: Spec {} {nodeId :: Int, listId :: Int} Void
+layout = cmapProps (\{nodeId, listId} -> {nodeId, listIds: [listId], tabType})
+       $ simpleSpec defaultPerformAction render
+  where
+    tabType = TabDocument (TabNgramType CTabTerms)
+    render :: Render {} DocPath Void
+    render _ path _ _ =
+      [ documentLoader
+        { path
+        , component: createClass "DocumentView" docViewSpec initialState
+        } ]
 
-aryPS1 :: Array String
-aryPS1 = ["Nothing Selected","STOPLIST", "MAINLIST", "MAPLIST"]
+------------------------------------------------------------------------
 
+loadDocument :: Int -> Aff NodeDocument
+loadDocument = get <<< toUrl Back Node <<< Just
+
+loadData :: DocPath -> Aff LoadedData
+loadData {nodeId, listIds, tabType} = do
+  document <- loadDocument nodeId
+  ngramsTable <- loadNgramsTable
+    { nodeId
+    , listIds: listIds
+    , params: { offset : 0, limit : 100, orderBy: Nothing}
+    , tabType
+    , searchQuery : ""
+    , termListFilter : Nothing
+    , termSizeFilter : Nothing
+    }
+  pure {document, ngramsTable}
 
-optps :: String -> ReactElement
-optps val = option [ value  val ] [text  val]
+documentLoaderClass :: ReactClass (Loader.Props DocPath LoadedData)
+documentLoaderClass = Loader.createLoaderClass "DocumentLoader" loadData
 
-unsafeEventValue :: forall event. event -> String
-unsafeEventValue e = (unsafeCoerce e).target.value
+documentLoader :: Loader.Props' DocPath LoadedData -> ReactElement
+documentLoader props = React.createElement documentLoaderClass props []

src/Gargantext/Pages/Layout.purs

@@ -6,7 +6,6 @@ import Gargantext.Pages.Layout.Actions (Action(..))
 import Gargantext.Pages.Layout.Specs.AddCorpus as AC
 -- import Gargantext.Pages.Corpus.Tabs as TV
 
-import Gargantext.Pages.Corpus.Document       as Document
 import Gargantext.Pages.Corpus.Graph          as GE
 -- import Gargantext.Pages.Corpus.Tabs.Terms.NgramsTable as NG
 
@@ -51,7 +50,6 @@ dispatchAction dispatcher _ (Folder id) = do
 
 dispatchAction dispatcher _ (Document i n) = do
   dispatcher $ SetRoute $ Document i n
-  dispatcher $ DocumentViewA $ Document.Load i n
 
 dispatchAction dispatcher _ (PGraphExplorer nid) = do
   dispatcher $ SetRoute $ PGraphExplorer nid

src/Gargantext/Pages/Layout/Actions.purs

@@ -12,7 +12,6 @@ import Routing.Hash                                    (setHash)
 import Gargantext.Components.Login                  as LN
 import Gargantext.Components.Modals.Modal              (modalShow)
 import Gargantext.Pages.Annuaire             as Annuaire
-import Gargantext.Pages.Corpus.Document       as D
 import Gargantext.Pages.Corpus.Graph     as GE
 import Gargantext.Pages.Layout.Specs.AddCorpus      as AC
 import Gargantext.Pages.Layout.Specs.Search         as S
@@ -28,7 +27,6 @@ data Action
   | SearchA    S.Action
   | AddCorpusA AC.Action
   | GraphExplorerA     GE.Action
-  | DocumentViewA D.Action
   | AnnuaireAction     Annuaire.Action
   | ShowLogin
   | Logout
@@ -65,7 +63,6 @@ performAction ShowAddCorpus  _ _ = void do
 performAction (LoginA          _) _ _ = pure unit
 performAction (AddCorpusA      _) _ _ = pure unit
 performAction (SearchA         _) _ _ = pure unit
-performAction (DocumentViewA   _) _ _ = pure unit
 performAction (GraphExplorerA  _) _ _ = pure unit
 performAction (AnnuaireAction  _) _ _ = pure unit
   -- liftEffect $ modalShow "addCorpus"
@@ -97,12 +94,6 @@ _annuaireAction = prism AnnuaireAction \action ->
        AnnuaireAction a -> Right a
        _                -> Left  action
 
-_documentViewAction :: Prism' Action D.Action
-_documentViewAction = prism DocumentViewA \action ->
-  case action of
-    DocumentViewA caction -> Right caction
-    _-> Left action
-
 _graphExplorerAction :: Prism' Action GE.Action
 _graphExplorerAction = prism GraphExplorerA \action ->
   case action of

src/Gargantext/Pages/Layout/Specs.purs

@@ -23,11 +23,11 @@ import Gargantext.Pages.Corpus.Document as Annotation
 import Gargantext.Pages.Corpus.Dashboard as Dsh
 import Gargantext.Pages.Corpus.Graph as GE
 import Gargantext.Pages.Home as L
-import Gargantext.Pages.Layout.Actions (Action(..), _addCorpusAction, _documentViewAction, _graphExplorerAction, _loginAction, _searchAction, performAction)
+import Gargantext.Pages.Layout.Actions (Action(..), _addCorpusAction, _graphExplorerAction, _loginAction, _searchAction, performAction)
 import Gargantext.Pages.Layout.Specs.AddCorpus as AC
 import Gargantext.Pages.Layout.Specs.Search    as S
 import Gargantext.Pages.Layout.Specs.SearchBar as SB
-import Gargantext.Pages.Layout.States (AppState, _addCorpusState, _documentViewState, _graphExplorerState, _loginState, _searchState)
+import Gargantext.Pages.Layout.States (AppState, _addCorpusState, _graphExplorerState, _loginState, _searchState)
 import Gargantext.Router (Routes(..))
 import Gargantext.Utils.Reactix as R'
 
@@ -60,7 +60,7 @@ pagesComponent s = case s.currentRoute of
     selectSpec (Corpus   i)      = layout0 $ cmapProps (const {nodeId: i}) $ noState Corpus.layout
     selectSpec AddCorpus         = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus
     selectSpec SearchView        = layout0 $ focus _searchState _searchAction  S.searchSpec
-    selectSpec (Document l i)      = layout0 $ focus _documentViewState _documentViewAction  Annotation.docview
+    selectSpec (Document l i)    = layout0 $ cmapProps (const {nodeId: i, listId: l}) $ noState Annotation.layout
     selectSpec (PGraphExplorer i)= layout1  $ focus _graphExplorerState _graphExplorerAction  GE.specOld
     selectSpec Dashboard         = layout0 $ noState Dsh.layoutDashboard
     selectSpec (Annuaire i)      = layout0 $ cmapProps (const {annuaireId: i}) $ noState A.layout

src/Gargantext/Pages/Layout/States.purs

@@ -7,7 +7,6 @@ import Data.Maybe                                      (Maybe(Just))
 import Effect (Effect)
 import Gargantext.Components.Login                  as LN
 
-import Gargantext.Pages.Corpus.Document       as D
 import Gargantext.Pages.Corpus.Graph     as GE
 import Gargantext.Pages.Layout.Specs.AddCorpus      as AC
 import Gargantext.Pages.Layout.Specs.Search         as S
@@ -18,7 +17,6 @@ type AppState =
   , loginState         :: LN.State
   , addCorpusState     :: AC.State
   , searchState        :: S.State
-  , documentState      :: D.State
   , showLogin          :: Boolean
   , showCorpus         :: Boolean
   , graphExplorerState :: GE.State
@@ -33,7 +31,6 @@ initAppState = do
     , loginState
     , addCorpusState : AC.initialState
     , searchState    : S.initialState
-    , documentState  : D.initialState {}
     , showLogin      : false
     , showCorpus     : false
     , graphExplorerState : GE.initialState
@@ -52,9 +49,6 @@ _addCorpusState = lens (\s -> s.addCorpusState) (\s ss -> s{addCorpusState = ss}
 _searchState :: Lens' AppState S.State
 _searchState = lens (\s -> s.searchState) (\s ss -> s{searchState = ss})
 
-_documentViewState :: Lens' AppState D.State
-_documentViewState = lens (\s -> s.documentState) (\s ss -> s{documentState = ss})
-
 _graphExplorerState :: Lens' AppState GE.State
 _graphExplorerState = lens (\s -> s.graphExplorerState) (\s ss -> s{graphExplorerState = ss})