Merge remote-tracking branch 'origin/409-dev-ngrams-table-edit-and-search' into dev-merge

src/Gargantext/Components/Annotation/Field.purs

@@ -23,7 +23,8 @@ import Data.Tuple.Nested ((/\))
 import Effect (Effect)
 import Gargantext.Components.Annotation.Menu (annotationMenu, AnnotationMenu)
 import Gargantext.Components.Annotation.Types (termClass, MenuType(..))
-import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
+import Gargantext.Core.NgramsTable.Functions (findNgramTermList, highlightNgrams, normNgram)
+import Gargantext.Core.NgramsTable.Types (NgramsTable, NgramsTerm)
 import Gargantext.Types (CTabNgramType(..), TermList)
 import Gargantext.Utils.Reactix as R2
 import Gargantext.Utils.Selection as Sel

src/Gargantext/Components/Document/API.purs

@@ -7,7 +7,7 @@ import Gargantext.Prelude
 import Data.Either (Either(..))
 import Data.Maybe (Maybe(..))
 import Gargantext.Components.Document.Types (DocPath, LoadedData, NodeDocument)
-import Gargantext.Components.NgramsTable.Core (loadNgramsTable)
+import Gargantext.Core.NgramsTable.Functions (loadNgramsTable)
 import Gargantext.Components.Search (SearchType(..))
 import Gargantext.Config.REST (AffRESTError)
 import Gargantext.Routes (SessionRoute(..))

src/Gargantext/Components/Document/Layout.purs

@@ -12,8 +12,10 @@ import Gargantext.Components.AutoUpdate (autoUpdate)
 import Gargantext.Components.Bootstrap as B
 import Gargantext.Components.Bootstrap.Types (SpinnerTheme(..))
 import Gargantext.Components.Document.Types (DocPath, Document(..), LoadedData, initialState)
-import Gargantext.Components.NgramsTable.Core (CoreAction(..), Versioned(..), addNewNgramA, applyNgramsPatches, coreDispatch, findNgramRoot, replace, setTermListA, syncResetButtons, useAutoSync)
+import Gargantext.Core.NgramsTable.Functions (addNewNgramA, applyNgramsPatches, coreDispatch, findNgramRoot, setTermListA)
+import Gargantext.Components.NgramsTable.AutoSync (useAutoSync)
 import Gargantext.Components.Node (NodePoly(..))
+import Gargantext.Core.NgramsTable.Types (CoreAction(..), Versioned(..), replace)
 import Gargantext.Utils as U
 import Gargantext.Utils.Reactix as R2
 import Reactix as R

src/Gargantext/Components/Document/Types.purs

@@ -10,7 +10,7 @@ import Simple.JSON as JSON
 import Gargantext.Prelude
 
 import Gargantext.Components.Node (NodePoly(..))
-import Gargantext.Components.NgramsTable.Core (CoreState, Versioned(..) , VersionedNgramsTable)
+import Gargantext.Core.NgramsTable.Types (CoreState, Versioned(..) , VersionedNgramsTable)
 import Gargantext.Sessions (Session)
 import Gargantext.Types (ListId, NodeID, TabType)
 

src/Gargantext/Components/GraphExplorer/API.purs

@@ -4,8 +4,8 @@ import Gargantext.Prelude
 
 import Data.Maybe (Maybe(..))
 import Gargantext.Components.GraphExplorer.Types as GET
-import Gargantext.Components.NgramsTable.Core as NTC
 import Gargantext.Config.REST (AffRESTError)
+import Gargantext.Core.NgramsTable.Types as CNT
 import Gargantext.Hooks.Sigmax.Types as SigmaxT
 import Gargantext.Routes (SessionRoute(..))
 import Gargantext.Routes as GR
@@ -20,7 +20,7 @@ type GraphAsyncUpdateParams =
   , nodes :: Array (Record SigmaxT.Node)
   , session :: Session
   , termList :: GT.TermList
-  , version :: NTC.Version
+  , version :: CNT.Version
   )
 
 graphAsyncUpdate :: Record GraphAsyncUpdateParams -> AffRESTError GT.AsyncTaskWithType

src/Gargantext/Components/GraphExplorer/Sidebar/Sidebar.purs → src/Gargantext/Components/GraphExplorer/Sidebar.purs

@@ -28,8 +28,9 @@ import Gargantext.Components.GraphExplorer.Sidebar.Legend as Legend
 import Gargantext.Components.GraphExplorer.Store as GraphStore
 import Gargantext.Components.GraphExplorer.Types as GET
 import Gargantext.Components.Lang (Lang(..))
-import Gargantext.Components.NgramsTable.Core as NTC
+import Gargantext.Core.NgramsTable.Functions as NTC
 import Gargantext.Config.REST (AffRESTError)
+import Gargantext.Core.NgramsTable.Types as CNT
 import Gargantext.Data.Array (mapMaybe)
 import Gargantext.Ends (Frontends)
 import Gargantext.Hooks.FirstEffect (useFirstEffect')
@@ -634,14 +635,14 @@ type SendPatches =
 sendPatches :: Record SendPatches -> Effect Unit
 sendPatches { errors, metaData, nodes, reloadForest, session, termList } = do
   launchAff_ do
-    patches <- (parTraverse (sendPatch termList session metaData) nodes) -- :: Aff (Array NTC.VersionedNgramsPatches)
+    patches <- (parTraverse (sendPatch termList session metaData) nodes) -- :: Aff (Array CNT.VersionedNgramsPatches)
     let mPatch = last patches
     case mPatch of
       Nothing -> pure unit
       Just (Left err) -> liftEffect $ do
         T.modify_ (A.cons $ FRESTError { error: err }) errors
         here.warn2 "[sendPatches] RESTError" err
-      Just (Right (NTC.Versioned _patch)) -> do
+      Just (Right (CNT.Versioned _patch)) -> do
         liftEffect $ T2.reload reloadForest
 
 -- Why is this called delete node?
@@ -649,7 +650,7 @@ sendPatch :: TermList
           -> Session
           -> GET.MetaData
           -> Record SigmaxT.Node
-          -> AffRESTError NTC.VersionedNgramsPatches
+          -> AffRESTError CNT.VersionedNgramsPatches
 sendPatch termList session (GET.MetaData metaData) node = do
     eRet  <- NTC.putNgramsPatches coreParams versioned
     case eRet of
@@ -661,10 +662,10 @@ sendPatch termList session (GET.MetaData metaData) node = do
     nodeId :: NodeID
     nodeId = unsafePartial $ fromJust $ fromString node.id
 
-    versioned :: NTC.VersionedNgramsPatches
-    versioned = NTC.Versioned {version: metaData.list.version, data: np}
+    versioned :: CNT.VersionedNgramsPatches
+    versioned = CNT.Versioned {version: metaData.list.version, data: np}
 
-    coreParams :: NTC.CoreParams ()
+    coreParams :: CNT.CoreParams ()
     coreParams = {session, nodeId, listIds: [metaData.list.listId], tabType}
 
     tabNgramType :: CTabNgramType
@@ -673,14 +674,14 @@ sendPatch termList session (GET.MetaData metaData) node = do
     tabType :: TabType
     tabType = TabCorpus (TabNgramType tabNgramType)
 
-    term :: NTC.NgramsTerm
+    term :: CNT.NgramsTerm
     term = NTC.normNgram tabNgramType node.label
 
-    np :: NTC.NgramsPatches
-    np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list }
+    np :: CNT.NgramsPatches
+    np = NTC.singletonPatchMap term $ CNT.NgramsPatch { patch_children: mempty, patch_list }
 
-    patch_list :: NTC.Replace TermList
-    patch_list = NTC.Replace { new: termList, old: MapTerm }
+    patch_list :: CNT.Replace TermList
+    patch_list = CNT.Replace { new: termList, old: MapTerm }
 
 
 

src/Gargantext/Components/NgramsTable.purs

 module Gargantext.Components.NgramsTable
   ( MainNgramsTableProps
   , CommonProps
+  , TreeEdit
+  , NgramsTreeEditProps
+  , getNgramsChildrenAff
+  , initialTreeEdit
   , mainNgramsTable
   ) where
 
 import Gargantext.Prelude
 
 import Data.Array as A
+import Data.Either (Either(..))
 import Data.FunctorWithIndex (mapWithIndex)
-import Data.Lens (to, view, (%~), (.~), (^.), (^?))
+import Data.Lens (to, view, (%~), (.~), (^.), (^?), (^..))
 import Data.Lens.At (at)
 import Data.Lens.Common (_Just)
 import Data.Lens.Fold (folded)
 import Data.Lens.Index (ix)
+import Data.List (List)
+import Data.List as List
 import Data.Map (Map)
 import Data.Map as Map
 import Data.Maybe (Maybe(..), fromMaybe, isNothing, maybe)
@@ -25,20 +32,25 @@ import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested ((/\))
 import Effect (Effect)
 import Effect.Aff (Aff)
+import Effect.Class (liftEffect)
 import Gargantext.Components.App.Store (Boxes)
 import Gargantext.Components.Bootstrap as B
 import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), Variant(..))
-import Gargantext.Components.NgramsTable.Components as NTC
-import Gargantext.Components.NgramsTable.Core (Action(..), CoreAction(..), CoreState, Dispatch, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm, PageParams, PatchMap(..), Versioned(..), VersionedNgramsTable, VersionedWithCountNgramsTable, _NgramsElement, _NgramsRepoElement, _NgramsTable, _children, _list, _ngrams, _ngrams_repo_elements, _ngrams_scores, _occurrences, _root, addNewNgramA, applyNgramsPatches, applyPatchSet, chartsAfterSync, commitPatch, convOrderBy, coreDispatch, filterTermSize, fromNgramsPatches, ngramsRepoElementToNgramsElement, ngramsTermText, normNgram, patchSetFromMap, replace, setTermListA, singletonNgramsTablePatch, syncResetButtons, toVersioned)
+import Gargantext.Core.NgramsTable.Functions (addNewNgramA, applyNgramsPatches, chartsAfterSync, commitPatch, convOrderBy, coreDispatch, filterTermSize, ngramsRepoElementToNgramsElement, normNgram, patchSetFromMap, setTermListA, singletonNgramsTablePatch, tablePatchHasNgrams, toVersioned)
+import Gargantext.Components.NgramsTable.Search as NTS
+import Gargantext.Components.NgramsTable.SelectionCheckbox as NTSC
+import Gargantext.Components.NgramsTable.Tree (renderNgramsItem, renderNgramsTree)
 import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
+import Gargantext.Components.NgramsTable.SyncResetButton (syncResetButtons)
 import Gargantext.Components.Nodes.Lists.Types as NT
 import Gargantext.Components.Table as TT
 import Gargantext.Components.Table.Types as TT
-import Gargantext.Config.REST (AffRESTError, logRESTError)
+import Gargantext.Config.REST (AffRESTError, RESTError, logRESTError)
+import Gargantext.Core.NgramsTable.Types (Action(..), CoreAction(..), CoreState, Dispatch, NgramsActionRef, NgramsClick, NgramsDepth, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTablePatch(..), NgramsTerm(..), PageParams, PatchMap(..), Versioned(..), VersionedNgramsTable, VersionedWithCountNgramsTable, _NgramsElement, _NgramsRepoElement, _NgramsTable, _children, _list, _ngrams, _ngrams_repo_elements, _ngrams_scores, _occurrences, _root, applyPatchSet, ngramsTermText, replace)
 import Gargantext.Hooks.Loader (useLoaderBox)
 import Gargantext.Routes (SessionRoute(..)) as R
 import Gargantext.Sessions (Session, get)
-import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
+import Gargantext.Types (CTabNgramType, ListId, NodeID, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
 import Gargantext.Utils (queryExactMatchesLabel, queryMatchesLabel, toggleSet, sortWith)
 import Gargantext.Utils.CacheAPI as GUC
 import Gargantext.Utils.Reactix as R2
@@ -46,38 +58,54 @@ import Gargantext.Utils.Seq as Seq
 import Gargantext.Utils.Toestand as T2
 import Reactix as R
 import Reactix.DOM.HTML as H
+import Record as Record
 import Toestand as T
 import Unsafe.Coerce (unsafeCoerce)
 
 here :: R2.Here
 here = R2.here "Gargantext.Components.NgramsTable"
 
-type State =
-  CoreState (
-    ngramsChildren   :: Map NgramsTerm Boolean
+type TreeEdit =
+  { isEditing          :: Boolean
+  , ngramsChildren     :: List NgramsTerm
+                       -- ^ Root children, as were originally present
+                       --   in the table, before editing
+  , ngramsChildrenDiff :: 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.
   , ngramsParent       :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
-  , ngramsSelection  :: Set NgramsTerm
+  }
+
+type State =
+  CoreState (
+    ngramsSelection  :: Set NgramsTerm
                      -- ^ The set of selected checkboxes of the first column.
   )
 
-initialState :: VersionedNgramsTable -> State
-initialState (Versioned {version}) = {
-    ngramsChildren:   Map.empty
-  , ngramsLocalPatch: mempty
-  , ngramsParent:     Nothing
+initialTreeEdit :: TreeEdit
+initialTreeEdit =
+  { isEditing         : false
+  , ngramsChildren    : List.Nil
+  , ngramsChildrenDiff: Map.empty
+  , ngramsParent      : Nothing }
+
+initialState :: State
+initialState =
+  { ngramsLocalPatch: mempty
   , ngramsSelection:  mempty
   , ngramsStagePatch: mempty
   , ngramsValidPatch: mempty
-  , ngramsVersion:    version
+  , ngramsVersion:    0
   }
 
+initialStateWithVersion :: VersionedNgramsTable -> State
+initialStateWithVersion (Versioned { version }) = initialState { ngramsVersion = version }
+
 setTermListSetA :: NgramsTable -> Set NgramsTerm -> TermList -> Action
 setTermListSetA ngramsTable ns new_list =
-  CoreAction $ CommitPatch $ fromNgramsPatches $ PatchMap $ mapWithIndex f $ toMap ns
+  CoreAction $ CommitPatch $ NgramsTablePatch $ PatchMap $ mapWithIndex f $ toMap ns
   where
     f :: NgramsTerm -> Unit -> NgramsPatch
     f n _unit = NgramsPatch { patch_list, patch_children: mempty }
@@ -96,31 +124,29 @@ setTermListSetA ngramsTable ns new_list =
 type PreConversionRows = Seq.Seq NgramsElement
 
 type TableContainerProps =
-  ( dispatch          :: Dispatch
-  , ngramsChildren    :: Map NgramsTerm Boolean
-  , ngramsParent      :: Maybe NgramsTerm
+  ( addCallback       :: String -> Effect Unit
+  , dispatch          :: Dispatch
+  , getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
   , ngramsSelection   :: Set NgramsTerm
   , ngramsTable       :: NgramsTable
-  , queryExactMatches :: Boolean
   , path              :: T.Box PageParams
-  , tabNgramType      :: CTabNgramType
+  , queryExactMatches :: Boolean
   , syncResetButton   :: Array R.Element
-  , addCallback       :: String -> Effect Unit
+  , tabNgramType      :: CTabNgramType
   )
 
 tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps -> R.Element
 tableContainer p q = R.createElement (tableContainerCpt p) q []
 tableContainerCpt :: Record TableContainerProps -> R.Component TT.TableContainerProps
-tableContainerCpt { dispatch
-                  , ngramsChildren
-                  , ngramsParent
+tableContainerCpt { addCallback
+                  , dispatch
+                  , getNgramsChildren
                   , ngramsSelection
                   , ngramsTable: ngramsTableCache
                   , path
                   , queryExactMatches
-                  , tabNgramType
                   , syncResetButton
-                  , addCallback
+                  , tabNgramType
                   } = here.component "tableContainer" cpt
   where
     cpt props _ = do
@@ -181,7 +207,6 @@ tableContainerCpt { dispatch
                   ]
                 ]
             ]
-          , editor
           , if (selectionsExist ngramsSelection)
             then H.li {className: "list-group-item"} [selectButtons true]
             else H.div {} []
@@ -207,33 +232,6 @@ tableContainerCpt { dispatch
     setTermSizeFilter x = T.modify (_ { termSizeFilter = x }) path
     setSelection term = dispatch $ setTermListSetA ngramsTableCache ngramsSelection term
 
-    editor = H.div {} $ maybe [] edit ngramsParent
-      where
-        edit ngrams = [ H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
-                   , NTC.renderNgramsTree { ngramsTable
-                                          , ngrams
-                                          , ngramsStyle: []
-                                          , ngramsClick
-                                          , ngramsEdit
-                                          }
-                   , H.button { className: "btn btn-primary"
-                              , on: {click: (const $ do
-                                               dispatch AddTermChildren)}
-                              } [H.text "Save"]
-                   , H.button { className: "btn btn-primary"
-                              , on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}
-                              } [H.text "Cancel"]
-                   ]
-          where
-            ngramsTable = ngramsTableCache # at ngrams
-                          <<< _Just
-                          <<< _NgramsRepoElement
-                          <<< _children
-                          %~ applyPatchSet (patchSetFromMap ngramsChildren)
-            ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
-            ngramsClick _ = Nothing
-            ngramsEdit  _ = Nothing
-
     selectionsExist :: Set NgramsTerm -> Boolean
     selectionsExist = not <<< Set.isEmpty
 
@@ -265,6 +263,7 @@ type PropsNoReload =
   , mTotalRows        :: Maybe Int
   , path              :: T.Box PageParams
   , state             :: T.Box State
+  , treeEdit          :: Record NgramsTreeEditProps
   , versioned         :: VersionedNgramsTable
   | CommonProps
   )
@@ -286,7 +285,7 @@ loadedNgramsTableHeaderCpt = here.component "loadedNgramsTableHeader" cpt where
       [ H.h4 { style: { textAlign : "center" } }
         [ H.span { className: "fa fa-hand-o-down" } []
         , H.text "Extracted Terms" ]
-      , NTC.searchInput { key: "search-input"
+      , NTS.searchInput { key: "search-input"
                         , searchQuery }
       ]
 
@@ -302,14 +301,17 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
       , path
       , state
       , tabNgramType
+      , treeEdit: treeEdit@{ getNgramsChildren }
       , versioned: Versioned { data: initTable }
       } _ = do
-    state'@{ ngramsChildren, ngramsLocalPatch, ngramsParent, ngramsSelection } <- T.useLive T.unequal state
+    treeEdit'@{ ngramsParent } <- T.useLive T.unequal treeEdit.box
+    state'@{ ngramsLocalPatch, ngramsSelection } <- T.useLive T.unequal state
     path'@{ scoreType, termListFilter, termSizeFilter } <- T.useLive T.unequal path
     params <- T.useFocused (_.params) (\a b -> b { params = a }) path
     params'@{ orderBy } <- T.useLive T.unequal params
     searchQueryFocused <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path
     searchQuery <- T.useLive T.unequal searchQueryFocused
+    isEditing <- T.useFocused (_.isEditing) (\a b -> b { isEditing = a}) treeEdit.box
 
     let ngramsTable = applyNgramsPatches state' initTable
         rowMap (Tuple ng nre) =
@@ -340,7 +342,8 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
                         , rootsWithMatches
                         , state: state'
                         , termListFilter
-                        , termSizeFilter } then
+                        , termSizeFilter
+                        , treeEdit: treeEdit' } then
             Just ngramsElement
           else
             Nothing
@@ -348,7 +351,7 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
         performAction = mkDispatch { filteredRows
                                    , path: path'
                                    , state
-                                   , state' }
+                                   , treeEdit }
 
         -- filteredRows :: PreConversionRows
         -- no need to filter offset if cache is off
@@ -357,11 +360,12 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
         filteredConvertedRows = convertRow <$> filteredRows
 
         convertRow ngramsElement =
-          { row: NTC.renderNgramsItem { dispatch: performAction
+          { row: renderNgramsItem { dispatch: performAction
+                                  , getNgramsChildren
+                                  , isEditing
                                   , ngrams: ngramsElement ^. _NgramsElement <<< _ngrams
                                   , ngramsElement
                                   , ngramsLocalPatch
-                                      , ngramsParent
                                   , ngramsSelection
                                   , ngramsTable } []
           , delete: false
@@ -409,20 +413,26 @@ loadedNgramsTableBodyCpt = here.component "loadedNgramsTableBody" cpt where
                             <<< _Just
             ) =<< ngramsParent
 
+    R.useEffect' $ do
+      R.setRef treeEdit.onCancelRef $ Just $ const $ performAction ClearTreeEdit
+      R.setRef treeEdit.onSaveRef $ Just $ const $ performAction AddTermChildren
+      let ngramsClick { depth: 1, ngrams: child } = Just $ performAction $ ToggleChild  false child
+          ngramsClick  _ = Nothing
+      R.setRef treeEdit.onNgramsClickRef $ Just ngramsClick
+
     pure $ R.fragment
       [ TT.table
         { colNames
         , container: tableContainer
-          { dispatch: performAction
-          , ngramsChildren
-          , ngramsParent
+          { addCallback
+          , dispatch: performAction
+          , getNgramsChildren
           , ngramsSelection
           , ngramsTable
           , path
           , queryExactMatches: exactMatches
           , syncResetButton: [ syncResetButton ]
           , tabNgramType
-          , addCallback
           }
         , params
         , rows: filteredConvertedRows
@@ -445,7 +455,7 @@ ngramsTableOrderWith orderBy =
     _              -> identity -- the server ordering is enough here
 
 -- This is used to *decorate* the Select header with the checkbox.
-wrapColElts scProps _         (TT.ColumnName "Select") = const [NTC.selectionCheckbox scProps]
+wrapColElts scProps _         (TT.ColumnName "Select") = const [NTSC.selectionCheckbox scProps]
 wrapColElts _       scoreType (TT.ColumnName "Score")  = (_ <> [H.text ("(" <> show scoreType <> ")")])
 wrapColElts _       _         _                        = identity
 
@@ -453,60 +463,57 @@ type MkDispatchProps = (
     filteredRows :: PreConversionRows
   , path         :: PageParams
   , state        :: T.Box State
-  , state'       :: State
+  , treeEdit     :: Record NgramsTreeEditProps
   )
 
 mkDispatch :: Record MkDispatchProps -> (Action -> Effect Unit)
 mkDispatch { filteredRows
            , path
            , state
-           , state': { ngramsChildren
-                     , ngramsParent
-                     , ngramsSelection } } = performAction
+           , treeEdit } = performAction
   where
-    allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows
-
-    setParentResetChildren :: Maybe NgramsTerm -> State -> State
-    setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = Map.empty }
-
     performAction :: Action -> Effect Unit
-    performAction (SetParentResetChildren p) =
-      T.modify_ (setParentResetChildren p) state
-    performAction (ToggleChild b c) =
-      T.modify_ (\s@{ ngramsChildren: nc } -> s { ngramsChildren = newNC nc }) state
+    performAction ClearTreeEdit = do
+      T.write_ initialTreeEdit treeEdit.box
+    performAction (SetParentResetChildren ngramsParent ngramsChildren) = do
+      T.write_ { isEditing: true
+               , ngramsChildren
+               , ngramsChildrenDiff: Map.empty
+               , ngramsParent } treeEdit.box
+    performAction (ToggleChild b c) = do
+      T.modify_ (\g@{ ngramsChildrenDiff: ncd } -> g { ngramsChildrenDiff = newNC ncd }) treeEdit.box
       where
-        newNC nc = Map.alter (maybe (Just b) (const Nothing)) c nc
+        newNC ncd = Map.alter (maybe (Just b) (const Nothing)) c ncd
     performAction (ToggleSelect c) =
       T.modify_ (\s@{ ngramsSelection: ns } -> s { ngramsSelection = toggleSet c ns }) state
-    performAction ToggleSelectAll =
-      T.modify_ toggler state
+    performAction ToggleSelectAll = do
+      { ngramsSelection } <- T.read state
+      T.modify_ (toggler ngramsSelection) state
       where
-        toggler s =
-          if allNgramsSelected then
+        toggler ngramsSelection s =
+          if allNgramsSelectedOnFirstPage ngramsSelection filteredRows then
             s { ngramsSelection = Set.empty :: Set NgramsTerm }
           else
             s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
     performAction AddTermChildren = do
+      { ngramsChildren, ngramsChildrenDiff, ngramsParent } <- T.read treeEdit.box
       case ngramsParent of
         Nothing ->
           -- impossible but harmless
           pure unit
         Just parent -> do
-          here.log2 "[performAction] AddTermChildren, parent" parent
-          here.log2 "[performAction] AddTermChildren, ngramsChildren" ngramsChildren
-          let pc = patchSetFromMap ngramsChildren
+          let pc = patchSetFromMap ngramsChildrenDiff
               pe = NgramsPatch { patch_list: mempty, patch_children: pc }
               pt = singletonNgramsTablePatch parent pe
-          T.modify_ (setParentResetChildren Nothing) state
-          here.log2 "[performAction] pt" pt
-          let ppt = case (A.head $ Set.toUnfoldable $ Map.keys ngramsChildren) of
-                Nothing -> mempty
-                Just h  ->
-                  let pp = NgramsPatch { patch_list: mempty
-                                       , patch_children: patchSetFromMap $ Map.mapMaybe (\v -> Just $ not v) ngramsChildren }
-                  in
-                  singletonNgramsTablePatch h pp
-          here.log2 "[performAction] pt with patchSetFromMap" $ pt <> ppt
+          performAction ClearTreeEdit
+          -- let ppt = case (A.head $ Set.toUnfoldable $ Map.keys ngramsChildrenDiff) of
+          --       Nothing -> mempty
+          --       Just h  ->
+          --         let pp = NgramsPatch { patch_list: mempty
+          --                              , patch_children: patchSetFromMap $ Map.mapMaybe (\v -> Just $ not v) ngramsChildrenDiff }
+          --         in
+          --         singletonNgramsTablePatch h pp
+          -- here.log2 "[performAction] pt with patchSetFromMap" $ pt <> ppt
           commitPatch (pt {-<> ppt-}) state
     performAction (CoreAction a) = coreDispatch path state a
 
@@ -516,15 +523,17 @@ displayRow :: { ngramsElement    :: NgramsElement
               , rootsWithMatches :: Set NgramsTerm
               , state            :: State
               , termListFilter   :: Maybe TermList
-              , termSizeFilter   :: Maybe TermSize } -> Boolean
+              , termSizeFilter   :: Maybe TermSize
+              , treeEdit         :: TreeEdit } -> Boolean
 displayRow { ngramsElement: NgramsElement {ngrams, root, list}
            , ngramsParentRoot
-           , state: { ngramsChildren
-                    , ngramsLocalPatch
-                    , ngramsParent }
+           , state: { ngramsLocalPatch }
            , rootsWithMatches
            , termListFilter
-           , termSizeFilter } =
+           , termSizeFilter
+           , treeEdit: { ngramsChildren
+                       , ngramsChildrenDiff
+                       , ngramsParent } } =
     -- See these issues about the evolution of this filtering.
     -- * https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/340
     -- * https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/87
@@ -534,7 +543,7 @@ displayRow { ngramsElement: NgramsElement {ngrams, root, list}
     -- ^ and which matches the search query.
     && maybe true (_ == list) termListFilter
     -- ^ and which matches the ListType filter.
-    && ngramsChildren ^. at ngrams /= Just true
+    && ngramsChildrenDiff ^. at ngrams /= Just true
     -- ^ and which are not scheduled to be added already
     && Just ngrams /= ngramsParent
     -- ^ and which are not our new parent
@@ -542,9 +551,9 @@ displayRow { ngramsElement: NgramsElement {ngrams, root, list}
     -- ^ and which are not the root of our new parent
     && filterTermSize termSizeFilter ngrams
     -- ^ and which satisfies the chosen term size
-    || ngramsChildren ^. at ngrams == Just false
+    || ngramsChildrenDiff ^. at ngrams == Just false
     -- ^ unless they are scheduled to be removed.
-    || NTC.tablePatchHasNgrams ngramsLocalPatch ngrams
+    || tablePatchHasNgrams ngramsLocalPatch ngrams
     -- ^ unless they are being processed at the moment.
 
 allNgramsSelectedOnFirstPage :: Set NgramsTerm -> PreConversionRows -> Boolean
@@ -561,17 +570,51 @@ type MainNgramsTableProps = (
   , path          :: T.Box PageParams
   , session       :: Session
   , tabType       :: TabType
+  , treeEdit      :: Record NgramsTreeEditProps
   | CommonProps
   )
 
+getNgramsChildrenAff :: Session -> NodeID -> Array ListId -> TabType -> NgramsTerm -> Aff (Array NgramsTerm)
+getNgramsChildrenAff session nodeId listIds tabType (NormNgramsTerm ngrams) = do
+  res :: Either RESTError ({ data :: Array { children :: Array String, ngrams :: String }}) <- get session $ R.GetNgrams params (Just nodeId)
+  case res of
+    Left err -> pure []
+    Right { data: lst } -> case A.uncons (A.filter (\d -> d.ngrams == ngrams) lst) of
+      Nothing -> pure []
+      Just { head } -> pure $ NormNgramsTerm <$> head.children
+  where
+    params = { limit: 10
+             , listIds
+             , offset: Nothing
+             , orderBy: Nothing
+             , searchQuery: ngrams
+             , tabType
+             , termListFilter: Nothing
+             , termSizeFilter: Nothing }
+
 mainNgramsTable :: R2.Component MainNgramsTableProps
 mainNgramsTable = R.createElement mainNgramsTableCpt
 mainNgramsTableCpt :: R.Component MainNgramsTableProps
 mainNgramsTableCpt = here.component "mainNgramsTable" cpt
   where
-    cpt props@{ cacheState, path } _ = do
+    cpt props@{ cacheState, path, session, tabType, treeEdit } _ = do
       searchQuery <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path
       cacheState' <- T.useLive T.unequal cacheState
+      onCancelRef <- R.useRef Nothing
+      onNgramsClickRef <- R.useRef Nothing
+      onSaveRef   <- R.useRef Nothing
+      state <- T.useBox initialState
+      ngramsLocalPatch <- T.useFocused (_.ngramsLocalPatch) (\a b -> b { ngramsLocalPatch = a }) state
+
+      nodeId <- T.useFocused (_.nodeId) (\a b -> b { nodeId = a }) path
+      nodeId' <- T.useLive T.unequal nodeId
+
+      -- let treeEdit = { box: treeEditBox
+      --                , getNgramsChildren: getNgramsChildrenAff session nodeId' tabType
+      --                , onCancelRef
+      --                , onNgramsClickRef
+      --                , onSaveRef 
+      --                }
 
       -- let path = initialPageParams session nodeId [defaultListId] tabType
 
@@ -579,26 +622,120 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
         NT.CacheOn  -> pure $ R.fragment
           [
             loadedNgramsTableHeader { searchQuery } []
-          ,
-            mainNgramsTableCacheOn props []
+          , mainNgramsTableCacheOn (Record.merge props { state }) []
           ]
         NT.CacheOff -> pure $ R.fragment
           [
             loadedNgramsTableHeader { searchQuery } []
-          ,
-            mainNgramsTableCacheOff props []
+          , ngramsTreeEdit (treeEdit) []
+          , mainNgramsTableCacheOff (Record.merge props { state }) []
           ]
 
+type NgramsTreeEditProps =
+  ( box               :: T.Box TreeEdit
+  , getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
+  --, ngramsLocalPatch  :: T.Box NgramsTablePatch
+  , onCancelRef       :: NgramsActionRef
+  , onNgramsClickRef  :: R.Ref (Maybe NgramsClick)
+  , onSaveRef         :: NgramsActionRef
+  )
+
+ngramsTreeEdit :: R2.Component NgramsTreeEditProps
+ngramsTreeEdit = R.createElement ngramsTreeEditCpt
+ngramsTreeEditCpt :: R.Component NgramsTreeEditProps
+ngramsTreeEditCpt = here.component "ngramsTreeEdit" cpt where
+  cpt props@{ box } _ = do
+    isEditingFocused <- T.useFocused (_.isEditing) (\a b -> b { isEditing = a }) box
+    isEditingFocused' <- T.useLive T.unequal isEditingFocused
+    ngramsParentFocused <- T.useFocused (_.ngramsParent) (\a b -> b { ngramsParent = a}) box
+    ngramsParentFocused' <- T.useLive T.unequal ngramsParentFocused
+
+    pure $ if isEditingFocused'
+      then case ngramsParentFocused' of
+                Nothing -> H.div {} []
+                Just ngramsParent' -> ngramsTreeEditReal (Record.merge props { ngramsParent' }) []
+      else H.div {} []
 
-mainNgramsTableCacheOn :: R2.Component MainNgramsTableProps
+type NgramsTreeEditRealProps =
+  ( ngramsParent' :: NgramsTerm
+  | NgramsTreeEditProps )
+
+ngramsTreeEditReal :: R2.Component NgramsTreeEditRealProps
+ngramsTreeEditReal = R.createElement ngramsTreeEditRealCpt
+ngramsTreeEditRealCpt :: R.Component NgramsTreeEditRealProps
+ngramsTreeEditRealCpt = here.component "ngramsTreeEditReal" cpt where
+  cpt { box
+      , getNgramsChildren
+      , ngramsParent'
+      , onCancelRef
+      , onNgramsClickRef
+      , onSaveRef } _ = do
+    { ngramsChildren, ngramsChildrenDiff } <- T.useLive T.unequal box
+
+    let ngramsDepth = { depth: 0, ngrams: ngramsParent' }
+        ngramsChildrenPatched :: Set NgramsTerm
+        ngramsChildrenPatched = applyPatchSet (patchSetFromMap ngramsChildrenDiff) $ Set.fromFoldable ngramsChildren
+        -- A patched version of getNgramsChildren. This is used
+        -- because we're editing the tree and so won't fetch the API
+        -- ngrams children.
+        gnc ngrams = if ngrams == ngramsParent'
+                       then do
+                         pure $ A.fromFoldable ngramsChildrenPatched
+                       else do
+                         pure []
+
+    pure $ H.div {}
+      [ H.p {}
+        [ H.text $ "Editing " <> ngramsTermText ngramsDepth.ngrams ]
+      , renderNgramsTree { getNgramsChildren: gnc
+                         , ngramsClick
+                         , ngramsDepth
+                         , ngramsEdit
+                         , ngramsStyle: []
+                         , key: show ngramsParent'
+                                 <> "-" <> show ngramsChildren
+                                 <> "-" <> show ngramsChildrenDiff
+                         }
+      , H.button { className: "btn btn-primary"
+                 , on: { click: onSaveClick } --(const $ dispatch AddTermChildren)}
+                 } [ H.text "Save" ]
+      , H.button { className: "btn btn-primary"
+                 , on: { click: onCancelClick } --(const $ dispatch ClearTreeEdit)}
+                 } [ H.text "Cancel" ]
+      ]
+      where
+        --ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
+        --ngramsClick _ = Nothing
+        ngramsClick :: NgramsClick
+        ngramsClick nd = case R.readRef onNgramsClickRef of
+          Nothing  -> Nothing
+          Just ngc -> ngc nd
+        ngramsEdit :: NgramsClick
+        ngramsEdit  _ = Nothing
+        onCancelClick :: forall e. e -> Effect Unit
+        onCancelClick _ = case R.readRef onCancelRef of
+          Nothing -> pure unit
+          Just onCancel -> onCancel unit
+        onSaveClick :: forall e. e -> Effect Unit
+        onSaveClick _ = case R.readRef onSaveRef of
+          Nothing -> pure unit
+          Just onSave -> onSave unit
+
+type MainNgramsTableCacheProps =
+  ( state :: T.Box State
+  | MainNgramsTableProps )
+
+mainNgramsTableCacheOn :: R2.Component MainNgramsTableCacheProps
 mainNgramsTableCacheOn = R.createElement mainNgramsTableCacheOnCpt
-mainNgramsTableCacheOnCpt :: R.Component MainNgramsTableProps
+mainNgramsTableCacheOnCpt :: R.Component MainNgramsTableCacheProps
 mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where
   cpt { afterSync
       , boxes
       , defaultListId
       , path
+      , state
       , tabNgramType
+      , treeEdit
       , withAutoUpdate } _ = do
 
     -- let path = initialPageParams session nodeId [defaultListId] tabType
@@ -608,7 +745,9 @@ mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where
                                                 , boxes
                                                 , cacheState: NT.CacheOn
                                                 , path
+                                                , state
                                                 , tabNgramType
+                                                , treeEdit
                                                 , versioned
                                                 , withAutoUpdate } []
     useLoaderWithCacheAPI {
@@ -633,20 +772,24 @@ mainNgramsTableCacheOnCpt = here.component "mainNgramsTableCacheOn" cpt where
   handleResponse :: VersionedNgramsTable -> VersionedNgramsTable
   handleResponse v = v
 
-mainNgramsTableCacheOff :: R2.Component MainNgramsTableProps
+mainNgramsTableCacheOff :: R2.Component MainNgramsTableCacheProps
 mainNgramsTableCacheOff = R.createElement mainNgramsTableCacheOffCpt
-mainNgramsTableCacheOffCpt :: R.Component MainNgramsTableProps
+mainNgramsTableCacheOffCpt :: R.Component MainNgramsTableCacheProps
 mainNgramsTableCacheOffCpt = here.component "mainNgramsTableCacheOff" cpt where
   cpt { afterSync
       , boxes
       , path
+      , state
       , tabNgramType
+      , treeEdit
       , withAutoUpdate } _ = do
     let render versionedWithCount = mainNgramsTablePaintNoCache { afterSync
                                                                 , boxes
                                                                 , cacheState: NT.CacheOff
                                                                 , path
+                                                                , state
                                                                 , tabNgramType
+                                                                , treeEdit
                                                                 , versionedWithCount
                                                                 , withAutoUpdate } []
     useLoaderBox { errorHandler
@@ -683,6 +826,8 @@ mainNgramsTableCacheOffCpt = here.component "mainNgramsTableCacheOff" cpt where
 type MainNgramsTablePaintProps = (
     cacheState        :: NT.CacheState
   , path              :: T.Box PageParams
+  , state             :: T.Box State
+  , treeEdit          :: Record NgramsTreeEditProps
   , versioned         :: VersionedNgramsTable
   | CommonProps
   )
@@ -696,13 +841,16 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
         , boxes
         , cacheState
         , path
+        , state
         , tabNgramType
+        , treeEdit
         , versioned
         , withAutoUpdate } _ = do
-      state <- T.useBox $ initialState versioned
+      R.useEffectOnce' $ do
+        let (Versioned { version }) = versioned
+        T.modify_ (_ { ngramsVersion = version }) state
 
       pure $
-
         loadedNgramsTableBody
         { afterSync
         , boxes
@@ -711,6 +859,7 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
         , path
         , state
         , tabNgramType
+        , treeEdit
         , versioned
         , withAutoUpdate
         } []
@@ -718,6 +867,8 @@ mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
 type MainNgramsTablePaintNoCacheProps = (
     cacheState         :: NT.CacheState
   , path               :: T.Box PageParams
+  , state              :: T.Box State
+  , treeEdit           :: Record NgramsTreeEditProps
   , versionedWithCount :: VersionedWithCountNgramsTable
   | CommonProps
   )
@@ -731,16 +882,19 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
         , boxes
         , cacheState
         , path
+        , state
         , tabNgramType
+        , treeEdit
         , versionedWithCount
         , withAutoUpdate } _ = do
       -- TODO This is lame, make versionedWithCount a proper box?
       let count /\ versioned = toVersioned versionedWithCount
 
-      state <- T.useBox $ initialState versioned
+      R.useEffectOnce' $ do
+        let (Versioned { version }) = versioned
+        T.modify_ (_ { ngramsVersion = version }) state
 
       pure $
-
         loadedNgramsTableBody
         { afterSync
         , boxes
@@ -749,6 +903,7 @@ mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cp
         , path
         , state
         , tabNgramType
+        , treeEdit
         , versioned
         , withAutoUpdate } []
 

src/Gargantext/Components/NgramsTable/AutoSync.purs

+module Gargantext.Components.NgramsTable.AutoSync where
+
+import Data.Maybe (Maybe(..))
+import Effect.Class (liftEffect)
+import Gargantext.Core.NgramsTable.Types (CoreAction(..), CoreDispatch, CoreState)
+import Gargantext.Prelude
+import Gargantext.Utils.Reactix as R2
+import Reactix as R
+import Toestand as T
+
+------------------------------------------------------------------
+
+here :: R2.Here
+here = R2.here "Gargantext.Components.NgramsTable.AutoSync"
+
+
+type AutoSyncInput s =
+  ( state  :: T.Box (CoreState s)
+  , action :: CoreDispatch
+  )
+
+type AutoSyncOutput =
+  -- @XXX: cannot use an Either here due to the mecanism of `syncPatches` only
+  --       returning an `Aff Unit`
+  -- ( result :: T.Box (Maybe (Either RESTError Unit))
+  ( result    :: T.Box (Maybe Unit)
+  , onPending :: T.Box Boolean
+  )
+
+useAutoSync :: forall s.
+     Record (AutoSyncInput s)
+  -> R.Hooks (Record AutoSyncOutput)
+useAutoSync { state, action } = do
+  -- States
+  onPending <- T.useBox false
+  result    <- T.useBox Nothing
+
+  ngramsLocalPatch <-
+    T.useFocused
+      (_.ngramsLocalPatch)
+      (\a b -> b { ngramsLocalPatch = a }) state
+
+  -- Computed
+  let
+    exec { new } =
+      let hasChanges = new /= mempty
+      in when hasChanges do
+        T.write_ true onPending
+        T.write_ Nothing result
+        action $ Synchronize
+          { afterSync: onSuccess
+          }
+
+    onSuccess _ = liftEffect do
+      T.write_ false onPending
+      T.write_ (Just unit) result
+
+  -- Hooks
+  R.useEffectOnce' $ T.listen exec ngramsLocalPatch
+
+  -- Output
+  pure
+    { onPending
+    , result
+    }

src/Gargantext/Components/NgramsTable/Loader.purs

@@ -10,8 +10,8 @@ import Effect.Aff (Aff, launchAff_, throwError)
 import Effect.Class (liftEffect)
 import Effect.Exception (error)
 import Gargantext.Components.LoadingSpinner (loadingSpinner)
-import Gargantext.Components.NgramsTable.Core (Version, Versioned(..))
 import Gargantext.Config.REST (RESTError(..), AffRESTError)
+import Gargantext.Core.NgramsTable.Types (Version, Versioned(..))
 import Gargantext.Utils.CacheAPI as GUC
 import Reactix as R
 import Simple.JSON as JSON

src/Gargantext/Components/NgramsTable/Search.purs

+module Gargantext.Components.NgramsTable.Search where
+
+import Data.Nullable (Nullable, null)
+import DOM.Simple as DOM
+import Gargantext.Prelude
+import Gargantext.Utils.Reactix as R2
+import Reactix as R
+import Reactix.DOM.HTML as H
+import Toestand as T
+
+here :: R2.Here
+here = R2.here "Gargantext.Components.NgramsTable.Search"
+
+
+type SearchInputProps =
+  ( searchQuery :: T.Box String
+  )
+
+-- "key": to prevent refreshing & losing input
+searchInput :: R2.Leaf ( key :: String | SearchInputProps )
+searchInput = R2.leafComponent searchInputCpt
+searchInputCpt :: R.Component ( key :: String | SearchInputProps )
+searchInputCpt = here.component "searchInput" cpt
+  where
+    cpt { searchQuery } _ = do
+      inputRef <- R.useRef null
+      
+      pure $ R2.row
+        [ H.div { className: "col-12" }
+          [ H.div { className: "input-group" }
+            [ searchButton { inputRef, searchQuery } []
+            , searchFieldInput { inputRef, searchQuery } []
+            ]
+          ]
+        ]
+
+type SearchButtonProps =
+  ( inputRef    :: R.Ref (Nullable DOM.Element)
+  , searchQuery :: T.Box String
+  )
+
+searchButton :: R2.Component SearchButtonProps
+searchButton = R.createElement searchButtonCpt
+searchButtonCpt :: R.Component SearchButtonProps
+searchButtonCpt = here.component "searchButton" cpt where
+  cpt { inputRef, searchQuery } _ = do
+    searchQuery' <- T.useLive T.unequal searchQuery
+
+    pure $ H.div { className: "input-group-prepend" }
+      [ if searchQuery' /= ""
+        then
+          H.button { className: "btn btn-danger"
+                   , on: { click: \_ -> R2.setInputValue inputRef "" } }
+                            -- T.write "" searchQuery } }
+          [ H.span {className: "fa fa-times"} []]
+        else H.span { className: "fa fa-search input-group-text" } []
+      ]
+
+type SearchFieldInputProps =
+  ( inputRef    :: R.Ref (Nullable DOM.Element)
+  , searchQuery :: T.Box String
+  )
+
+searchFieldInput :: R2.Component SearchFieldInputProps
+searchFieldInput = R.createElement searchFieldInputCpt
+searchFieldInputCpt :: R.Component SearchFieldInputProps
+searchFieldInputCpt = here.component "searchFieldInput" cpt where
+  cpt { inputRef, searchQuery } _ = do
+    -- searchQuery' <- T.useLive T.unequal searchQuery
+    
+    pure $ H.input { className: "form-control"
+                   -- , defaultValue: searchQuery'
+                   , name: "search"
+                   , on: { input: \e -> T.write (R.unsafeEventValue e) searchQuery }
+                   , placeholder: "Search"
+                   , ref: inputRef
+                   , type: "value"
+                   }

src/Gargantext/Components/NgramsTable/SelectionCheckbox.purs

+module Gargantext.Components.NgramsTable.SelectionCheckbox where
+
+import Data.Maybe (Maybe(..))
+import Data.Nullable (null, toMaybe)
+import Data.Set (Set)
+import Data.Set as Set
+import FFI.Simple (delay)
+import Gargantext.Core.NgramsTable.Types (Action(..), Dispatch, NgramsTerm)
+import Gargantext.Prelude
+import Gargantext.Utils.Reactix as R2
+import Reactix as R
+import Reactix.DOM.HTML as H
+
+here :: R2.Here
+here = R2.here "Gargantext.Components.NgramsTable.SelectionCheckbox"
+
+
+type SelectionCheckboxProps =
+  ( allNgramsSelected :: Boolean
+  , dispatch          :: Dispatch
+  , ngramsSelection   :: Set NgramsTerm
+  )
+
+selectionCheckbox :: Record SelectionCheckboxProps -> R.Element
+selectionCheckbox props = R.createElement selectionCheckboxCpt props []
+selectionCheckboxCpt :: R.Component SelectionCheckboxProps
+selectionCheckboxCpt = here.component "selectionCheckbox" cpt
+  where
+    cpt { allNgramsSelected, dispatch, ngramsSelection } _ = do
+      ref <- R.useRef null
+
+      R.useEffect' $ delay unit $ \_ -> do
+        let mCb = toMaybe $ R.readRef ref
+        case mCb of
+          Nothing -> pure unit
+          Just cb -> do
+            _ <- if allNgramsSelected || (Set.isEmpty ngramsSelection) then
+              R2.setIndeterminateCheckbox cb false
+            else
+              R2.setIndeterminateCheckbox cb true
+            pure unit
+
+      pure $ H.input { checked: allNgramsSelected
+                     , className: "checkbox"
+                     , on: { change: const $ dispatch $ ToggleSelectAll }
+                     , ref
+                     , type: "checkbox" }

src/Gargantext/Components/NgramsTable/SyncResetButton.purs

+module Gargantext.Components.NgramsTable.SyncResetButton where
+
+import Effect.Aff (Aff)
+import Effect.Class (liftEffect)
+import FFI.Simple.Functions (delay)
+import Gargantext.Core.NgramsTable.Types (CoreAction(..), CoreDispatch, NgramsTablePatch)
+import Gargantext.Prelude
+import Gargantext.Utils.Reactix as R2
+import Reactix as R
+import Reactix.DOM.HTML as H
+import Toestand as T
+
+here :: R2.Here
+here = R2.here "Gargantext.Components.NgramsTable.SyncResetButton"
+
+
+-- | Reset Button
+type SyncResetButtonsProps =
+  ( afterSync        :: Unit -> Aff Unit
+  , ngramsLocalPatch :: NgramsTablePatch
+  , performAction    :: CoreDispatch
+  )
+
+syncResetButtons :: Record SyncResetButtonsProps -> R.Element
+syncResetButtons p = R.createElement syncResetButtonsCpt p []
+syncResetButtonsCpt :: R.Component SyncResetButtonsProps
+syncResetButtonsCpt = here.component "syncResetButtons" cpt
+  where
+    cpt { afterSync, ngramsLocalPatch, performAction } _ = do
+      synchronizing <- T.useBox false
+      synchronizing' <- T.useLive T.unequal synchronizing
+
+      let
+        hasChanges = ngramsLocalPatch /= mempty
+        hasChangesClass = if hasChanges then "" else " disabled"
+
+        synchronizingClass = if synchronizing' then " disabled" else ""
+
+        resetClick _ = do
+          performAction ResetPatches
+
+        synchronizeClick _ = delay unit $ \_ -> do
+          T.write_ true synchronizing
+          performAction $ Synchronize { afterSync: newAfterSync }
+
+        newAfterSync x = do
+          afterSync x
+          liftEffect $ T.write_ false synchronizing
+
+      pure $ H.div { className: "btn-toolbar" }
+        [ H.div { className: "btn-group mr-2" }
+          [ H.button { className: "btn btn-danger " <> hasChangesClass <> synchronizingClass
+                     , on: { click: resetClick }
+                     } [ H.text "Reset" ]
+          ]
+        , H.div { className: "btn-group mr-2" }
+          [ H.button { className: "btn btn-primary " <> hasChangesClass <> synchronizingClass
+                     , on: { click: synchronizeClick }
+                     } [ H.text "Sync" ]
+          ]
+        ]
+

src/Gargantext/Components/NgramsTable/Components.purs → src/Gargantext/Components/NgramsTable/Tree.purs

-module Gargantext.Components.NgramsTable.Components where
+module Gargantext.Components.NgramsTable.Tree where
 
+import Data.Array as A
+import Data.Either (Either(..))
 import Data.Lens ((^..), (^.), view)
 import Data.Lens.At (at)
 import Data.Lens.Fold (folded)
 import Data.Lens.Index (ix)
-import Data.List (null, toUnfoldable) as L
+import Data.List (List)
+import Data.List as L
+import Data.Map (Map)
+import Data.Map as Map
 import Data.Maybe (Maybe(..), maybe, isJust)
-import Data.Nullable (null, toMaybe)
+import Data.Nullable (Nullable, null, toMaybe)
 import Data.Set (Set)
 import Data.Set as Set
+import DOM.Simple as DOM
 import Effect (Effect)
-import FFI.Simple (delay)
-import Gargantext.Components.NgramsTable.Core (Action(..), Dispatch, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm, _NgramsElement, _NgramsRepoElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace, setTermListA)
+import Effect.Aff (Aff, launchAff_)
+import Effect.Class (liftEffect)
+import Gargantext.Core.NgramsTable.Functions (applyNgramsPatches, setTermListA, tablePatchHasNgrams)
+import Gargantext.Core.NgramsTable.Types (Action(..), NgramsClick, NgramsDepth, NgramsElement, NgramsTable, NgramsTablePatch(..), NgramsTerm, _NgramsElement, _NgramsRepoElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace)
 import Gargantext.Components.Table as Tbl
-import Gargantext.Prelude (Unit, bind, const, discard, map, not, otherwise, pure, show, unit, ($), (+), (/=), (<<<), (<>), (==), (>), (||))
+import Gargantext.Config.REST (logRESTError)
+import Gargantext.Hooks.Loader (useLoader)
+import Gargantext.Prelude (Unit, bind, const, discard, map, mempty, not, otherwise, pure, show, unit, ($), (+), (/=), (<<<), (<>), (==), (>), (||))
 import Gargantext.Types as GT
 import Gargantext.Utils.Reactix as R2
 import React.DOM (a, span, text)
 import React.DOM.Props as DOM
 import Reactix as R
 import Reactix.DOM.HTML as H
+import Record as Record
 import Toestand as T
+import Type.Proxy (Proxy(..))
 
 here :: R2.Here
-here = R2.here "Gargantext.Components.NgramsTable.Components"
-
-type SearchInputProps =
-  ( searchQuery :: T.Box String
-  )
-
--- "key": to prevent refreshing & losing input
-searchInput :: R2.Leaf ( key :: String | SearchInputProps )
-searchInput = R2.leafComponent searchInputCpt
-searchInputCpt :: R.Component ( key :: String | SearchInputProps )
-searchInputCpt = here.component "searchInput" cpt
-  where
-    cpt { searchQuery } _ = do
-      pure $ R2.row
-        [ H.div { className: "col-12" }
-          [ H.div { className: "input-group" }
-            [ searchButton { searchQuery } []
-            , searchFieldInput { searchQuery } []
-            ]
-          ]
-        ]
-
-type SearchButtonProps =
-  ( searchQuery :: T.Box String
-  )
-
-searchButton :: R2.Component SearchButtonProps
-searchButton = R.createElement searchButtonCpt
-searchButtonCpt :: R.Component SearchButtonProps
-searchButtonCpt = here.component "searchButton" cpt where
-  cpt { searchQuery } _ = do
-    searchQuery' <- T.useLive T.unequal searchQuery
-
-    pure $ H.div { className: "input-group-prepend" }
-      [ if searchQuery' /= ""
-        then
-          H.button { className: "btn btn-danger"
-                   , on: {click: \_ -> T.write "" searchQuery}}
-          [ H.span {className: "fa fa-times"} []]
-        else H.span { className: "fa fa-search input-group-text" } []
-      ]
-
-type SearchFieldInputProps =
-  ( searchQuery :: T.Box String
-  )
-
-searchFieldInput :: R2.Component SearchFieldInputProps
-searchFieldInput = R.createElement searchFieldInputCpt
-searchFieldInputCpt :: R.Component SearchFieldInputProps
-searchFieldInputCpt = here.component "searchFieldInput" cpt where
-  cpt { searchQuery } _ = do
-    -- searchQuery' <- T.useLive T.unequal searchQuery
-
-    pure $ H.input { className: "form-control"
-                   -- , defaultValue: searchQuery'
-                   , name: "search"
-                   , on: { input: \e -> T.write (R.unsafeEventValue e) searchQuery }
-                   , placeholder: "Search"
-                   , type: "value"
-                   }
-
-type SelectionCheckboxProps =
-  ( allNgramsSelected :: Boolean
-  , dispatch          :: Dispatch
-  , ngramsSelection   :: Set NgramsTerm
-  )
-
-selectionCheckbox :: Record SelectionCheckboxProps -> R.Element
-selectionCheckbox props = R.createElement selectionCheckboxCpt props []
-selectionCheckboxCpt :: R.Component SelectionCheckboxProps
-selectionCheckboxCpt = here.component "selectionCheckbox" cpt
-  where
-    cpt { allNgramsSelected, dispatch, ngramsSelection } _ = do
-      ref <- R.useRef null
-
-      R.useEffect' $ delay unit $ \_ -> do
-        let mCb = toMaybe $ R.readRef ref
-        case mCb of
-          Nothing -> pure unit
-          Just cb -> do
-            _ <- if allNgramsSelected || (Set.isEmpty ngramsSelection) then
-              R2.setIndeterminateCheckbox cb false
-            else
-              R2.setIndeterminateCheckbox cb true
-            pure unit
-
-      pure $ H.input { checked: allNgramsSelected
-                     , className: "checkbox"
-                     , on: { change: const $ dispatch $ ToggleSelectAll }
-                     , ref
-                     , type: "checkbox" }
+here = R2.here "Gargantext.Components.NgramsTable.Tree"
 
 
 type RenderNgramsTree =
-  ( ngrams      :: NgramsTerm
+  ( getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
+  --, ngramsChildren    :: List NgramsTerm
   , ngramsClick       :: NgramsClick
+  , ngramsDepth       :: NgramsDepth
   , ngramsEdit        :: NgramsClick
   , ngramsStyle       :: Array DOM.Props
-  , ngramsTable :: NgramsTable
+  --, ngramsTable    :: NgramsTable
+  , key               :: String -- used to refresh the tree on diff change
   )
 
 renderNgramsTree :: Record RenderNgramsTree -> R.Element
 renderNgramsTree p = R.createElement renderNgramsTreeCpt p []
-
 renderNgramsTreeCpt :: R.Component RenderNgramsTree
 renderNgramsTreeCpt = here.component "renderNgramsTree" cpt
   where
-    cpt { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit} _ =
-      pure $ H.ul {} [
-        H.span { className: "tree" } [
-          H.span { className: "righthanded" } [
-            tree { ngramsClick
-                 , ngramsDepth: {ngrams, depth: 0}
+    cpt { getNgramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = do
+      pure $ H.ul {}
+        [ H.span { className: "tree" }
+          [ H.span { className: "righthanded" }
+            [ tree { getNgramsChildren
+                     --, ngramsChildren
+                   , ngramsClick
+                   , ngramsDepth
                    , ngramsEdit
                    , ngramsStyle
-                 , ngramsTable
                    }
             ]
           ]
         ]
 
 
-type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
-type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
-
 type TagProps =
   ( ngramsClick :: NgramsClick
   , ngramsDepth :: NgramsDepth
@@ -165,24 +87,44 @@ tag tagProps =
 -}
 
 type TreeProps =
-  ( ngramsEdit  :: NgramsClick
-  , ngramsTable :: NgramsTable
+  ( getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
+  , ngramsEdit        :: NgramsClick
+  --, ngramsTable :: NgramsTable
   | TagProps
   )
 
 tree :: Record TreeProps -> R.Element
 tree p = R.createElement treeCpt p []
-
 treeCpt :: R.Component TreeProps
-treeCpt = here.component "tree" cpt
+treeCpt = here.component "tree" cpt where
+  cpt props@{ getNgramsChildren, ngramsDepth } _ = do
+    let loader p = do
+          res <- getNgramsChildren p
+          pure $ Right res
+    let render nc = treeLoaded (Record.merge props { ngramsChildren: L.fromFoldable nc })
+
+    useLoader { errorHandler
+              , loader
+              , path: ngramsDepth.ngrams
+              , render }
     where
-    cpt params@{ ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle, ngramsTable } _ =
+      errorHandler = logRESTError here "[tree]"
+
+type TreeLoaded =
+  ( ngramsChildren    :: List NgramsTerm
+  | TreeProps )
+
+treeLoaded :: Record TreeLoaded -> R.Element
+treeLoaded p = R.createElement treeLoadedCpt p []
+treeLoadedCpt :: R.Component TreeLoaded
+treeLoadedCpt = here.component "treeLoaded" cpt where
+  cpt params@{ ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = do
     pure $
-        H.li { style: {width : "100%"} }
+      H.li { style: { width : "100%" } }
       ([ H.i { className, style } [] ]
        <> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
        <> maybe [] edit (ngramsEdit ngramsDepth)
-           <> [ forest cs ]
+       <> [ forest ngramsChildren ]
       )
     where
       tag =
@@ -195,11 +137,11 @@ treeCpt = here.component "tree" cpt
                     , H.i { className: "fa fa-pencil"
                           , on: { click: const effect } } []
                     ]
-        leaf = L.null cs
+      leaf = L.null ngramsChildren
       className = "fa fa-chevron-" <> if open then "down" else "right"
       style = if leaf then {color: "#adb5bd"} else {color: ""}
       open = not leaf || false {- TODO -}
-        cs   = ngramsTable ^.. ix ngramsDepth.ngrams <<< _NgramsRepoElement <<< _children <<< folded
+      --cs   = ngramsTable ^.. ix ngramsDepth.ngrams <<< _NgramsRepoElement <<< _children <<< folded
       -- cs has a list is ok, the length is the number of direct children of an ngram which is generally < 10.
 
       forest =
@@ -207,15 +149,15 @@ treeCpt = here.component "tree" cpt
         if depth > 10 then
           const $ H.text "ERROR DEPTH > 10"
         else
-            H.ul {} <<< map (\ngrams -> tree (params { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable
+          H.ul {} <<< map (\ngrams -> tree ((Record.delete (Proxy :: Proxy "ngramsChildren") params) { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable
 
-
-type RenderNgramsItem = (
-    dispatch          :: Action -> Effect Unit
+type RenderNgramsItem =
+  ( dispatch          :: Action -> Effect Unit
+  , getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
+  , isEditing         :: T.Box Boolean
   , ngrams            :: NgramsTerm
   , ngramsElement     :: NgramsElement
   , ngramsLocalPatch  :: NgramsTablePatch
-  , ngramsParent      :: Maybe NgramsTerm
   , ngramsSelection   :: Set NgramsTerm
   , ngramsTable       :: NgramsTable
   )
@@ -226,32 +168,41 @@ renderNgramsItemCpt :: R.Component RenderNgramsItem
 renderNgramsItemCpt = here.component "renderNgramsItem" cpt
   where
     cpt { dispatch
+        --, getNgramsChildren
+        , isEditing
         , ngrams
         , ngramsElement
         , ngramsLocalPatch
-        , ngramsParent
         , ngramsSelection
         , ngramsTable
         } _ = do
-      pure $ Tbl.makeRow [
-          H.div { className: "ngrams-selector" } [
-            H.span { className: "ngrams-chooser fa fa-eye-slash"
+      isEditing' <- T.useLive T.unequal isEditing
+      
+      pure $ Tbl.makeRow
+        [ H.div { className: "ngrams-selector" }
+          [ H.span { className: "ngrams-chooser fa fa-eye-slash"
                    , on: { click: onClick } } []
           ]
         , selected
         , checkbox GT.MapTerm
         , checkbox GT.StopTerm
-        , H.div {} ( if ngramsParent == Nothing
-                       then [renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }]
-                       else [H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } }
-                                 [ H.i { className: "fa fa-plus" } []]
+        , H.div {}
+          ( if isEditing'
+            then [ H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } }
+                   [ H.i { className: "fa fa-plus" } [] ]
                  , R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ]
                  ]
+            else [ renderNgramsTree { getNgramsChildren: getNgramsChildren'
+                                    , ngramsClick
+                                    , ngramsDepth
+                                    , ngramsEdit
+                                    , ngramsStyle
+                                    , key: "" } ]
           )
         , H.text $ show (ngramsElement ^. _NgramsElement <<< _occurrences)
       ]
       where
-        ngramsDepth= {ngrams, depth: 0 }
+        ngramsDepth = { ngrams, depth: 0 }
         tag =
           case ngramsClick ngramsDepth of
             Just effect ->
@@ -263,7 +214,14 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
         --   R2.callTrigger toggleSidePanel unit
         termList    = ngramsElement ^. _NgramsElement <<< _list
         ngramsStyle = [termStyle termList ngramsOpacity]
-        ngramsEdit  = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams
+        ngramsEdit { ngrams: n } = Just $ dispatch $ SetParentResetChildren (Just n) (ngramsChildren n)
+        tbl = applyNgramsPatches { ngramsLocalPatch
+                                 , ngramsStagePatch: mempty
+                                 , ngramsValidPatch: mempty
+                                 , ngramsVersion: 0 } ngramsTable
+        getNgramsChildren' :: NgramsTerm -> Aff (Array NgramsTerm)
+        getNgramsChildren' n = pure $ A.fromFoldable $ ngramsChildren n
+        ngramsChildren n = tbl ^.. ix n <<< _NgramsRepoElement <<< _children <<< folded
         ngramsClick =
           Just <<< dispatch <<< CoreAction <<< cycleTermListItem <<< view _ngrams
           -- ^ This is the old behavior it is nicer to use since one can
@@ -314,10 +272,6 @@ termStyle GT.CandidateTerm opacity = DOM.style
   , opacity
   }
 
-tablePatchHasNgrams :: NgramsTablePatch -> NgramsTerm -> Boolean
-tablePatchHasNgrams ngramsTablePatch ngrams =
-  isJust $ ngramsTablePatch.ngramsPatches ^. _PatchMap <<< at ngrams
-
 
 nextTermList :: GT.TermList -> GT.TermList
 nextTermList GT.MapTerm       = GT.StopTerm

src/Gargantext/Components/Nodes/Annuaire.purs

@@ -151,16 +151,15 @@ pageLayoutCpt = here.component "pageLayout" cpt
         errorHandler = logRESTError here "[pageLayout]"
 
 type PageProps = 
-  ( session   :: Session
-  , frontends :: Frontends
+  ( frontends :: Frontends
   , pagePath  :: T.Box PagePath
   -- , info :: AnnuaireInfo
+  , session   :: Session
   , table     :: TableResult CT.NodeContact
   )
 
 page :: Record PageProps -> R.Element
 page props = R.createElement pageCpt props []
-
 pageCpt :: R.Component PageProps
 pageCpt = here.component "page" cpt
   where

src/Gargantext/Components/Nodes/Annuaire/Tabs.purs

@@ -12,7 +12,7 @@ import Gargantext.Components.App.Store (Boxes)
 import Gargantext.Components.DocsTable as DT
 import Gargantext.Components.DocsTable.Types (Year)
 import Gargantext.Components.NgramsTable as NT
-import Gargantext.Components.NgramsTable.Core as NTC
+import Gargantext.Core.NgramsTable.Functions as NTC
 import Gargantext.Components.Nodes.Lists.Types as LTypes
 import Gargantext.Components.Nodes.Texts.Types as TextsT
 import Gargantext.Components.Tab as Tab
@@ -113,19 +113,30 @@ ngramsViewCpt = here.component "ngramsView" cpt where
       NTC.initialPageParams session nodeId
       [ defaultListId ] (TabDocument TabDocs)
 
-    pure $ NT.mainNgramsTable (props' path) [] where
-      most = RX.pick props :: Record NTCommon
-      props' path =
+    onCancelRef <- R.useRef Nothing
+    onNgramsClickRef <- R.useRef Nothing
+    onSaveRef <- R.useRef Nothing
+    treeEditBox <- T.useBox NT.initialTreeEdit
+
+    let most = RX.pick props :: Record NTCommon
+        props' =
           (Record.merge most
            { afterSync
            , path
            , tabType:        TabPairing (TabNgramType $ modeTabType mode)
            , tabNgramType:   modeTabType' mode
+           , treeEdit: { box: treeEditBox
+                       , getNgramsChildren: \_ -> pure []
+                       , onCancelRef
+                       , onNgramsClickRef
+                       , onSaveRef }
            , withAutoUpdate: false }) :: Record NT.MainNgramsTableProps
-        where
         afterSync :: Unit -> Aff Unit
         afterSync _ = pure unit
 
+
+    pure $ NT.mainNgramsTable props' []
+
 type NTCommon =
   ( boxes         :: Boxes
   , cacheState    :: T.Box LTypes.CacheState

src/Gargantext/Components/Nodes/Annuaire/User/Contacts/Tabs.purs

@@ -11,7 +11,7 @@ import Gargantext.Components.App.Store (Boxes)
 import Gargantext.Components.DocsTable as DT
 import Gargantext.Components.DocsTable.Types (Year)
 import Gargantext.Components.NgramsTable as NT
-import Gargantext.Components.NgramsTable.Core as NTC
+import Gargantext.Core.NgramsTable.Functions as NTC
 import Gargantext.Components.Nodes.Lists.Types as LTypes
 import Gargantext.Components.Nodes.Texts.Types as TTypes
 import Gargantext.Components.Tab as Tab
@@ -146,6 +146,10 @@ ngramsViewCpt = here.component "ngramsView" cpt
         , nodeId
         , session } _ = do
       path <- T.useBox $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs)
+      onCancelRef <- R.useRef Nothing
+      onNgramsClickRef <- R.useRef Nothing
+      onSaveRef <- R.useRef Nothing
+      treeEditBox <- T.useBox NT.initialTreeEdit
 
       pure $ NT.mainNgramsTable {
           afterSync: \_ -> pure unit
@@ -156,6 +160,11 @@ ngramsViewCpt = here.component "ngramsView" cpt
         , session
         , tabNgramType
         , tabType
+        , treeEdit: { box: treeEditBox
+                    , getNgramsChildren: \_ -> pure []
+                    , onCancelRef
+                    , onNgramsClickRef
+                    , onSaveRef }
         , withAutoUpdate: false
         } []
       where

src/Gargantext/Components/Nodes/Lists/Tabs.purs

@@ -8,8 +8,7 @@ import Data.Tuple.Nested ((/\))
 import Effect.Class (liftEffect)
 import Gargantext.Components.App.Store (Boxes)
 import Gargantext.Components.NgramsTable as NT
-import Gargantext.Components.NgramsTable.Core (PageParams)
-import Gargantext.Components.NgramsTable.Core as NTC
+import Gargantext.Core.NgramsTable.Functions as NTC
 import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
 import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar)
 import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
@@ -17,6 +16,7 @@ import Gargantext.Components.Nodes.Corpus.Chart.Utils (mNgramsTypeFromTabType)
 import Gargantext.Components.Nodes.Corpus.Types (CorpusData)
 import Gargantext.Components.Tab as Tab
 import Gargantext.Components.Table.Types (Params)
+import Gargantext.Core.NgramsTable.Types (PageParams)
 import Gargantext.Prelude (bind, pure, unit, ($))
 import Gargantext.Sessions (Session)
 import Gargantext.Types (CTabNgramType(..), Mode(..), TabSubType(..), TabType(..), modeTabType)
@@ -89,6 +89,10 @@ ngramsViewCpt = here.component "ngramsView" cpt where
             , session
             , path } _ = do
       chartsReload <- T.useBox T2.newReload
+      onCancelRef <- R.useRef Nothing
+      onNgramsClickRef <- R.useRef Nothing
+      onSaveRef <- R.useRef Nothing
+      treeEditBox <- T.useBox NT.initialTreeEdit
 
       { listIds, nodeId, params } <- T.useLive T.unequal path
 
@@ -96,13 +100,13 @@ ngramsViewCpt = here.component "ngramsView" cpt where
         R.fragment
         [
           ngramsView'
-          { mode
-          , boxes
-          , session
-          , params
+          { boxes
+          , corpusData: props.corpusData
           , listIds
+          , mode
           , nodeId
-          , corpusData: props.corpusData
+          , params
+          , session
           } []
         ,
           NT.mainNgramsTable
@@ -114,6 +118,11 @@ ngramsViewCpt = here.component "ngramsView" cpt where
           , session
           , tabNgramType
           , tabType
+          , treeEdit: { box: treeEditBox
+                      , getNgramsChildren: NT.getNgramsChildrenAff session nodeId listIds tabType
+                      , onCancelRef
+                      , onNgramsClickRef
+                      , onSaveRef }
           , withAutoUpdate: false
           } []
         ]
@@ -139,26 +148,28 @@ ngramsViewCpt = here.component "ngramsView" cpt where
 
 -- @XXX re-render issue -> clone component
 type NgramsViewProps' =
-  ( mode          :: Mode
-  , boxes         :: Boxes
-  , session       :: Session
+  ( boxes         :: Boxes
+  , corpusData    :: CorpusData
   , listIds       :: Array Int
-  , params        :: Params
+  , mode          :: Mode
   , nodeId        :: Int
-  , corpusData    :: CorpusData
+  , params        :: Params
+  , session       :: Session
   )
 
 ngramsView' :: R2.Component NgramsViewProps'
 ngramsView' = R.createElement ngramsViewCpt'
-ngramsViewCpt' :: R.Memo NgramsViewProps'
-ngramsViewCpt' = R.memo' $ here.component "ngramsView_clone" cpt where
-  cpt { mode
-      , boxes
-      , session
+--ngramsViewCpt' :: R.Memo NgramsViewProps'
+--ngramsViewCpt' = R.memo' $ here.component "ngramsView_clone" cpt where
+ngramsViewCpt' :: R.Component NgramsViewProps'
+ngramsViewCpt' = here.component "ngramsView_clone" cpt where
+  cpt { boxes
+      , corpusData: { defaultListId }
       , listIds
-      , params
+      , mode
       , nodeId
-      , corpusData: { defaultListId }
+      , params
+      , session
       } _ = do
 
     let path' = {

src/Gargantext/Components/Nodes/Texts.purs

@@ -6,7 +6,6 @@ import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe(..))
 import Data.Show.Generic (genericShow)
 import Data.Tuple.Nested ((/\))
-import Effect (Effect)
 import Effect.Aff (launchAff_)
 import Gargantext.Components.App.Store (Boxes)
 import Gargantext.Components.App.Store as AppStore
@@ -128,7 +127,7 @@ textsLayoutWithKeyCpt = here.component "textsLayoutWithKey" cpt where
               }
     where
       errorHandler = logRESTError here "[textsLayoutWithKey]"
-      afterCacheStateChange cacheState = do
+      afterCacheStateChange _cacheState = do
         launchAff_ $ clearCache unit
         -- TODO
         --sessionUpdate $ setCacheState session nodeId cacheState
@@ -248,7 +247,7 @@ histoRender = R.createElement histoRenderCpt
 histoRenderCpt :: R.Component HistoProps
 histoRenderCpt = here.component "histoRender" cpt where
   cpt { boxes, path, onClick, onInit, reload, session } _ = do
-    reload' <- T.useLive T.unequal reload
+    _ <- T.useLive T.unequal reload
 
     pure $ histo { boxes, path, onClick, onInit, session }
 

src/Gargantext/Components/NgramsTable/Core.purs → src/Gargantext/Core/NgramsTable/Functions.purs

-module Gargantext.Components.NgramsTable.Core
-  ( PageParams
-  , CoreParams
-  , NgramsElement(..)
-  , _NgramsElement
-  , NgramsRepoElementT
-  , NgramsRepoElement(..)
-  , _NgramsRepoElement
-  , ngramsRepoElementToNgramsElement
-  , NgramsTable(..)
-  , NewElems
-  , NgramsPatch(..)
-  , NgramsPatches
-  , _NgramsTable
-  , NgramsTerm(..)
-  , normNgram
-  , ngramsTermText
-  , findNgramRoot
-  , findNgramTermList
-  , Version
-  , Versioned(..)
-  , Count
-  , VersionedWithCount(..)
-  , toVersioned
-  , VersionedNgramsPatches
-  , AsyncNgramsChartsUpdate(..)
-  , VersionedNgramsTable
-  , VersionedWithCountNgramsTable
-  , NgramsTablePatch
-  , CoreState
-  , HighlightElement
-  , highlightNgrams
-  , initialPageParams
-  , loadNgramsTable
-  , loadNgramsTableAll
-  , convOrderBy
-  , Replace(..) -- Ideally we should keep the constructors hidden
-  , replace
-  , PatchSet(..)
-  , PatchMap(..)
-  , _PatchMap
-  , patchSetFromMap
-  , applyPatchSet
---, applyNgramsTablePatch -- re-export only if we have a good reason not to use applyNgramsPatches
-  , applyNgramsPatches
-  , rootsOf
-  , singletonPatchMap
-  , fromNgramsPatches
-  , singletonNgramsTablePatch
-  , isEmptyNgramsTablePatch
-  , _list
-  , _occurrences
-  , _children
-  , _ngrams
-  , _parent
-  , _root
-  , _ngrams_repo_elements
-  , _ngrams_scores
-  , commitPatch
-  , putNgramsPatches
-  , postNgramsChartsAsync
-  , syncPatches
-  , addNewNgramP
-  , addNewNgramA
-  , setTermListP
-  , setTermListA
-  , CoreAction(..)
-  , CoreDispatch
-  , Action(..)
-  , Dispatch
-  , coreDispatch
-  , isSingleNgramsTerm
-  , filterTermSize
-
-  -- Reset Button TODO put elsewhere this file is too big
-  , SyncResetButtonsProps
-  , syncResetButtons
-  , chartsAfterSync
-  , useAutoSync
-  )
+module Gargantext.Core.NgramsTable.Functions
   where
 
 import Gargantext.Prelude
@@ -85,36 +6,24 @@ import Gargantext.Prelude
 import Control.Monad.State (class MonadState, execState)
 import Data.Array (head)
 import Data.Array as A
-import Data.Bifunctor (lmap)
 import Data.Either (Either(..))
-import Data.Eq.Generic (genericEq)
-import Data.Foldable (class Foldable, foldMap, foldl, foldr)
-import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)
-import Data.Generic.Rep (class Generic)
-import Data.Lens (Iso', Lens', use, view, (%=), (%~), (.~), (?=), (^?))
-import Data.Lens.At (class At, at)
+import Data.Foldable (foldl)
+import Data.Lens (use, view, (^?), (^.), (?=), (%~), (%=), (.~))
+import Data.Lens.At (at)
 import Data.Lens.Common (_Just)
 import Data.Lens.Fold (folded, traverseOf_)
-import Data.Lens.Index (class Index, ix)
 import Data.Lens.Iso.Newtype (_Newtype)
-import Data.Lens.Record (prop)
 import Data.List ((:), List(Nil))
 import Data.List as L
 import Data.Map (Map)
 import Data.Map as Map
 import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isJust)
-import Data.Monoid.Additive (Additive(..))
-import Data.Newtype (class Newtype)
-import Data.Ord.Generic (genericCompare)
 import Data.Set (Set)
-import Data.Set as Set
-import Data.Show.Generic (genericShow)
 import Data.String as S
 import Data.String.Common as DSC
 import Data.String.Regex (Regex, regex, replace) as R
 import Data.String.Regex.Flags (global, multiline) as R
 import Data.String.Utils as SU
-import Data.Symbol (SProxy(..))
 import Data.These (These(..))
 import Data.Traversable (for, traverse_, traverse)
 import Data.TraversableWithIndex (traverseWithIndex)
@@ -123,155 +32,30 @@ import Data.Tuple.Nested ((/\))
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff_)
 import Effect.Class (liftEffect)
-import Effect.Exception.Unsafe (unsafeThrow)
-import FFI.Simple.Functions (delay)
-import Foreign as F
-import Foreign.Object as FO
 import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Table as T
 import Gargantext.Components.Table.Types as T
 import Gargantext.Config.REST (AffRESTError, RESTError)
 import Gargantext.Config.Utils (handleRESTError)
+import Gargantext.Core.NgramsTable.Types
 import Gargantext.Routes (SessionRoute(..))
 import Gargantext.Sessions (Session, get, post, put)
-import Gargantext.Types (AsyncTask, AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), FrontendError, ListId, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
+import Gargantext.Types (AsyncTask, AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), FrontendError, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
 import Gargantext.Utils.Either (eitherMap)
 import Gargantext.Utils.KarpRabin (indicesOfAny)
 import Gargantext.Utils.Reactix as R2
 import Partial (crashWith)
 import Partial.Unsafe (unsafePartial)
-import Reactix (Component, Element, createElement) as R
 import Reactix as R
-import Reactix.DOM.HTML as H
-import Simple.JSON as JSON
 import Toestand as T
 
 here :: R2.Here
-here = R2.here "Gargantext.Components.NgramsTable.Core"
-
-type Endo a = a -> a
-
-
--- | Main Types
-type Version = Int
-
-newtype Versioned a = Versioned
-  { version :: Version
-  , data    :: a
-  }
-derive instance Generic (Versioned a) _
-derive instance Newtype (Versioned a) _
-instance Eq a => Eq (Versioned a) where eq = genericEq
-derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (Versioned a)
-derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (Versioned a)
-------------------------------------------------------------------------
-type Count = Int
-
-newtype VersionedWithCount a = VersionedWithCount
-  { version :: Version
-  , count   :: Count
-  , data    :: a
-  }
-derive instance Generic (VersionedWithCount a) _
-derive instance Newtype (VersionedWithCount a) _
-instance Eq a => Eq (VersionedWithCount a) where eq = genericEq
-derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (VersionedWithCount a)
-derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (VersionedWithCount a)
+here = R2.here "Gargantext.Core.NgramsTable.Functions"
 
 toVersioned :: forall a. VersionedWithCount a -> Tuple Count (Versioned a)
 toVersioned (VersionedWithCount { count, data: d, version }) = Tuple count $ Versioned { data: d, version }
 
 ------------------------------------------------------------------------
--- TODO replace by NgramsPatches directly
-type NgramsTablePatch = { ngramsPatches :: NgramsPatches }
-
-newtype PatchMap k p = PatchMap (Map k p)
-
-derive instance Generic (PatchMap k p) _
-derive instance Newtype (PatchMap k p) _
-derive instance (Eq k, Eq p) => Eq (PatchMap k p)
-
--- TODO generalize
-instance JSON.WriteForeign p => JSON.WriteForeign (PatchMap NgramsTerm p) where
-  writeImpl (PatchMap m) =
-    JSON.writeImpl $ FO.fromFoldable $ map (lmap ngramsTermText) (Map.toUnfoldable m :: Array _)
-instance (JSON.ReadForeign p, Monoid p) => JSON.ReadForeign (PatchMap NgramsTerm p) where
-  readImpl f = do
-    inst <- JSON.readImpl f
-    pure $ PatchMap $ foldlWithIndex (\k m v -> Map.insert (NormNgramsTerm k) v m) Map.empty (inst :: FO.Object p)
-    -- TODO we assume that the ngrams are already normalized ^^^^^^^^^^^^^
-
-type NgramsPatches = PatchMap NgramsTerm NgramsPatch
-
-data NgramsPatch
-  = NgramsReplace
-      { patch_old :: Maybe NgramsRepoElement
-      , patch_new :: Maybe NgramsRepoElement
-      }
-  | NgramsPatch
-      { patch_children :: PatchSet NgramsTerm
-      , patch_list     :: Replace TermList
-      }
-derive instance Generic NgramsPatch _
-derive instance Eq NgramsPatch
-instance Monoid NgramsPatch where
-  mempty = NgramsPatch { patch_children: mempty, patch_list: mempty }
-instance Semigroup NgramsPatch where
-  append (NgramsReplace p) (NgramsReplace q)
-    | p.patch_old /= q.patch_new = unsafeThrow "append/NgramsPatch: old != new"
-    | otherwise                  = ngramsReplace q.patch_old p.patch_new
-  append (NgramsPatch p)   (NgramsPatch q) = NgramsPatch
-    { patch_children: p.patch_children <> q.patch_children
-    , patch_list:     p.patch_list     <> q.patch_list
-    }
-  append (NgramsPatch p) (NgramsReplace q) = ngramsReplace q.patch_old (q.patch_new # _Just <<< _Newtype %~ applyNgramsPatch' p)
-  append (NgramsReplace p) (NgramsPatch q) = ngramsReplace (p.patch_old # _Just <<< _Newtype %~ applyNgramsPatch' (invert q)) p.patch_new
-instance JSON.WriteForeign NgramsPatch where
-  writeImpl (NgramsReplace { patch_old, patch_new }) = JSON.writeImpl { patch_old, patch_new }
-  writeImpl (NgramsPatch { patch_children, patch_list }) = JSON.writeImpl { patch_children, patch_list }
-instance JSON.ReadForeign NgramsPatch where
-  readImpl f = do
-    inst :: { patch_old :: Maybe NgramsRepoElement
-            , patch_new :: Maybe NgramsRepoElement
-            , patch_children :: PatchSet NgramsTerm
-            , patch_list :: Replace TermList } <- JSON.readImpl f
-    -- TODO handle empty fields
-    -- TODO handle patch_new
-    if isJust inst.patch_new || isJust inst.patch_old then
-      pure $ NgramsReplace { patch_old: inst.patch_old, patch_new: inst.patch_new }
-    else do
-      pure $ NgramsPatch { patch_list: inst.patch_list, patch_children: inst.patch_children }
-
-------------------------------------------------------------------------
-newtype NgramsTerm = NormNgramsTerm String
-derive instance Generic NgramsTerm _
-derive instance Newtype NgramsTerm _
-instance Eq NgramsTerm where eq = genericEq
-instance Ord NgramsTerm where compare = genericCompare
-instance Show NgramsTerm where show = genericShow
-derive newtype instance JSON.ReadForeign NgramsTerm
-derive newtype instance JSON.WriteForeign NgramsTerm
-derive newtype instance Monoid NgramsTerm
-
-------------------------------------------------------------------------
-
-type CoreParams s =
-  { nodeId  :: Int
-    -- ^ This node can be a corpus or contact.
-  , listIds :: Array Int
-  , tabType :: TabType
-  , session :: Session
-  | s
-  }
-
-type PageParams =
-  CoreParams
-    ( params         :: T.Params
-    , searchQuery    :: String
-    , termListFilter :: Maybe TermList -- Nothing means all
-    , termSizeFilter :: Maybe TermSize -- Nothing means all
-    , scoreType      :: ScoreType
-    )
 
 initialPageParams :: Session -> Int -> Array Int -> TabType -> PageParams
 initialPageParams session nodeId listIds tabType =
@@ -290,10 +74,6 @@ initialPageParams session nodeId listIds tabType =
 
 
 
-
-ngramsTermText :: NgramsTerm -> String
-ngramsTermText (NormNgramsTerm t) = t
-
 -- TODO
 normNgramInternal :: CTabNgramType -> String -> String
 normNgramInternal CTabAuthors    = identity
@@ -307,104 +87,6 @@ normNgramWithTrim nt = DSC.trim <<< normNgramInternal nt
 normNgram :: CTabNgramType -> String -> NgramsTerm
 normNgram tabType = NormNgramsTerm <<< normNgramWithTrim tabType
 
------------------------------------------------------------------------------------
-newtype NgramsElement = NgramsElement
-  { ngrams      :: NgramsTerm -- HERE
-  , size        :: Int -- MISSING
-  , list        :: TermList -- ok
-  , root        :: Maybe NgramsTerm -- ok
-  , parent      :: Maybe NgramsTerm -- ok
-  , children    :: Set NgramsTerm -- ok
-  , occurrences :: Int -- HERE
-  }
-
-derive instance Eq NgramsElement
-
-
-_parent :: forall parent row. Lens' { parent :: parent | row } parent
-_parent = prop (SProxy :: SProxy "parent")
-
-_root :: forall root row. Lens' { root :: root | row } root
-_root   = prop (SProxy :: SProxy "root")
-
-_ngrams :: forall row. Lens' { ngrams :: NgramsTerm | row } NgramsTerm
-_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")
-
-_ngrams_repo_elements :: forall a row. Lens' { ngrams_repo_elements :: a | row } a
-_ngrams_repo_elements = prop (SProxy :: SProxy "ngrams_repo_elements")
-
-_ngrams_scores :: forall a row. Lens' { ngrams_scores :: a | row } a
-_ngrams_scores = prop (SProxy :: SProxy "ngrams_scores")
-
-derive instance Newtype NgramsElement _
-derive instance Generic NgramsElement _
-instance Show NgramsElement where show = genericShow
-
-_NgramsElement  :: Iso' NgramsElement {
-    children    :: Set NgramsTerm
-  , size        :: Int
-  , list        :: TermList
-  , ngrams      :: NgramsTerm
-  , occurrences :: Int
-  , parent      :: Maybe NgramsTerm
-  , root        :: Maybe NgramsTerm
-  }
-_NgramsElement = _Newtype
-
-instance JSON.ReadForeign NgramsElement where
-  readImpl f = do
-    inst :: { children :: Array NgramsTerm
-            , size :: Int
-            , list :: TermList
-            , ngrams :: NgramsTerm
-            , occurrences :: Int
-            , parent :: Maybe NgramsTerm
-            , root :: Maybe NgramsTerm }<- JSON.readImpl f
-    pure $ NgramsElement $ inst { children = Set.fromFoldable inst.children }
-instance JSON.WriteForeign NgramsElement where
-  writeImpl (NgramsElement ne) =
-    JSON.writeImpl $ ne { children = Set.toUnfoldable ne.children :: Array _ }
-
-type NgramsRepoElementT =
-  ( size :: Int
-  , list     :: TermList
-  , root     :: Maybe NgramsTerm
-  , parent   :: Maybe NgramsTerm
-  )
-newtype NgramsRepoElement = NgramsRepoElement
-  { children :: Set NgramsTerm
-  | NgramsRepoElementT }
-derive instance Generic NgramsRepoElement _
-derive instance Newtype NgramsRepoElement _
-derive instance Eq NgramsRepoElement
-instance JSON.ReadForeign NgramsRepoElement where
-  readImpl f = do
-    inst :: { children :: Array NgramsTerm | NgramsRepoElementT } <- JSON.readImpl f
-    pure $ NgramsRepoElement $ inst { children = Set.fromFoldable inst.children }
-instance JSON.WriteForeign NgramsRepoElement where
-  writeImpl (NgramsRepoElement nre) =
-    JSON.writeImpl $ nre { children = Set.toUnfoldable nre.children :: Array _ }
-instance Show NgramsRepoElement where show = genericShow
-
-_NgramsRepoElement  :: Iso' NgramsRepoElement {
-    children    :: Set NgramsTerm
-  , size        :: Int
-  , list        :: TermList
-  , parent      :: Maybe NgramsTerm
-  , root        :: Maybe NgramsTerm
---  , occurrences :: Int
-  }
-_NgramsRepoElement = _Newtype
-
 ngramsRepoElementToNgramsElement :: NgramsTerm -> Int -> NgramsRepoElement -> NgramsElement
 ngramsRepoElementToNgramsElement ngrams occurrences (NgramsRepoElement { children, list, parent, root, size }) =
   NgramsElement
@@ -418,57 +100,6 @@ ngramsRepoElementToNgramsElement ngrams occurrences (NgramsRepoElement { childre
   }
 
 -----------------------------------------------------------------------------------
-{-
-  NgramsRepoElement does not have the occurrences field.
-  Instead NgramsTable has a ngrams_scores map.
-
-  Pro:
-  * Does not encumber NgramsRepoElement with the score which is not part of repo.
-  * Enables for multiple scores through multiple maps.
-  Cons:
-  * Having a map on the side is equivalent to a `occurrences :: Maybe Int`, which is
-    less precise.
-  * It is a tiny bit less performant to access the score.
--}
-newtype NgramsTable = NgramsTable
-  { ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement
-  , ngrams_scores        :: Map NgramsTerm (Additive Int)
-  }
-
-derive instance Newtype NgramsTable _
-derive instance Generic NgramsTable _
-instance Eq NgramsTable where eq = genericEq
-instance Show NgramsTable where show = genericShow
-
-_NgramsTable :: Iso' NgramsTable
-                     { ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement
-                     , ngrams_scores        :: Map NgramsTerm (Additive Int)
-                     }
-_NgramsTable = _Newtype
-
-instance Index NgramsTable NgramsTerm NgramsRepoElement where
-  ix k = _NgramsTable <<< _ngrams_repo_elements <<< ix k
-
-instance At NgramsTable NgramsTerm NgramsRepoElement where
-  at k = _NgramsTable <<< _ngrams_repo_elements <<< at k
-
-instance JSON.ReadForeign NgramsTable where
-  readImpl ff = do
-    inst <- JSON.readImpl ff
-    pure $ NgramsTable
-      { ngrams_repo_elements: Map.fromFoldable $ f <$> (inst :: Array NgramsElement)
-      , ngrams_scores:        Map.fromFoldable $ g <$> inst
-      }
-    where
-      f (NgramsElement {ngrams, size, list, root, parent, children}) =
-        Tuple ngrams (NgramsRepoElement {size, list, root, parent, children})
-      g (NgramsElement e) = Tuple e.ngrams (Additive e.occurrences)
-
-{- NOT USED
-instance EncodeJson NgramsTable where
-  encodeJson (NgramsTable {ngrams_repo_elements, ngrams_scores}) = encodeJson $ Map.values ... TODO
--}
------------------------------------------------------------------------------------
 
 lookupRootList :: NgramsTerm -> NgramsTable -> Maybe TermList
 lookupRootList ngram (NgramsTable {ngrams_repo_elements: elts}) =
@@ -493,9 +124,6 @@ wordBoundaryReg2 = case R.regex ("(" <> wordBoundaryChars <> ")\\1") (R.global <
   Left e  -> unsafePartial $ crashWith e
   Right r -> r
 
-type HighlightElement = Tuple String (List (Tuple NgramsTerm TermList))
-type HighlightAccumulator = List HighlightElement
-
 -- TODO: while this function works well with word boundaries,
 --       it inserts too many spaces.
 highlightNgrams :: CTabNgramType -> NgramsTable -> String -> Array HighlightElement
@@ -558,162 +186,22 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 =
                                fromMaybe' (\_ -> crashWith "highlightNgrams: out of bounds pattern") $
                                traverse (A.index pats) pis
 
------------------------------------------------------------------------------------
-
-type VersionedNgramsTable = Versioned NgramsTable
-type VersionedWithCountNgramsTable = VersionedWithCount NgramsTable
-
------------------------------------------------------------------------------------
-data Replace a
-  = Keep
-  | Replace { old :: a, new :: a }
-
-derive instance Generic (Replace a) _
-
-replace :: forall a. Eq a => a -> a -> Replace a
-replace old new
-  | old == new = Keep
-  | otherwise  = Replace { old, new }
-
-derive instance Eq a => Eq (Replace a)
-
-instance Eq a => Semigroup (Replace a) where
-  append Keep p = p
-  append p Keep = p
-  append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow "old != new"
-  append (Replace { new }) (Replace { old }) = replace old new
-
-instance Eq a => 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 JSON.WriteForeign a => JSON.WriteForeign (Replace a) where
-  writeImpl Keep = JSON.writeImpl { tag: "Keep" }
-  writeImpl (Replace {old, new}) = JSON.writeImpl { old, new, tag: "Replace" }
-instance (JSON.ReadForeign a, Eq a) => JSON.ReadForeign (Replace a) where
-  readImpl f = do
-    impl :: { old :: Maybe a, new :: Maybe a }  <- JSON.readImpl f
-    case Tuple impl.old impl.new of
-      Tuple (Just old) (Just new) -> pure $ replace old new
-      Tuple Nothing Nothing       -> pure Keep
-      _                           -> F.fail $ F.ForeignError "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
-  }
-
-derive instance Generic (PatchSet a) _
-derive instance Newtype (PatchSet a) _
-
-instance 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 Ord a => Monoid (PatchSet a) where
-  mempty = PatchSet { rem: Set.empty, add: Set.empty }
-
-instance JSON.WriteForeign a => JSON.WriteForeign (PatchSet a) where
-  writeImpl (PatchSet {rem, add}) = JSON.writeImpl { rem: (Set.toUnfoldable rem :: Array a)
-                                                   , add: (Set.toUnfoldable add :: Array a) }
-
-instance (Ord a, JSON.ReadForeign a) => JSON.ReadForeign (PatchSet a) where
-  readImpl f = do
-    -- TODO handle empty fields
-    inst :: { rem :: Array a, add :: Array a } <- JSON.readImpl f
-    let rem = mkSet inst.rem
-        add = mkSet inst.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
+--applyNgramsTablePatchToSingleTerm :: NgramsTerm -> NgramsTablePatch -> Set NgramsTerm -> Set NgramsTerm
+--applyNgramsTablePatchToSingleTerm ngram patch s =
+--  applyNgramsTablePatch patch $ 
 
 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
 
--- TODO shall we normalise as in replace? shall we make a type class Replaceable?
-ngramsReplace :: Maybe NgramsRepoElement -> Maybe NgramsRepoElement -> NgramsPatch
-ngramsReplace patch_old patch_new = NgramsReplace {patch_old, patch_new}
-
-derive instance Eq (PatchSet NgramsTerm)
-
--- TODO
-invert :: forall a. a -> a
-invert _ = unsafeThrow "invert: TODO"
 
 
-
-applyNgramsPatch' :: forall row.
-                          { patch_children :: PatchSet NgramsTerm
-                          , patch_list     :: Replace TermList
-                          } ->
-                     Endo { list     :: TermList
-                          , children :: Set NgramsTerm
-                          | row
-                          }
-applyNgramsPatch' p e =
-  e { list     = applyReplace p.patch_list e.list
-    , children = applyPatchSet p.patch_children e.children
-    }
-
 applyNgramsPatch :: NgramsPatch -> Maybe NgramsRepoElement -> Maybe NgramsRepoElement
 applyNgramsPatch (NgramsReplace {patch_new}) _ = patch_new
 applyNgramsPatch (NgramsPatch p)           m = m # _Just <<< _Newtype %~ applyNgramsPatch' p
 
 
-fromMap :: forall k p. Ord k => Eq p => Monoid p => Map k p -> PatchMap k p
-fromMap = PatchMap <<< Map.filter (\v -> v /= mempty)
-
-instance (Ord k, Eq p, Monoid p) => Semigroup (PatchMap k p) where
-  append (PatchMap p) (PatchMap q) = fromMap $ Map.unionWith append p q
-
-instance (Ord k, Eq p, Monoid p) => Monoid (PatchMap k p) where
-  mempty = PatchMap Map.empty
-
-_PatchMap :: forall k p. Iso' (PatchMap k p) (Map k p)
-_PatchMap = _Newtype
-
-{-
-instance Functor (PatchMap k) where
-  map f (PatchMap m) = PatchMap (map f m) -- NO NORM: fromMap would not typecheck
-
-instance FunctorWithIndex k (PatchMap k) where
-  mapWithIndex f (PatchMap m) = PatchMap (mapWithIndex f m) -- NO NORM: fromMap would not typecheck
--}
-
-instance 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 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
-
-{- fromMap is preventing these to type check:
-
-instance Ord k => Traversable (PatchMap k) where
-  traverse f (PatchMap m) = fromMap <$> traverse f m
-  sequence (PatchMap m) = fromMap <$> sequence m
-
-instance Ord k => TraversableWithIndex k (PatchMap k) where
-  traverseWithIndex f (PatchMap m) = fromMap <$> traverseWithIndex f m
--}
-
 traversePatchMapWithIndex :: forall f a b k.
                              Applicative f => Ord k => Eq b => Monoid b =>
                              (k -> a -> f b) -> PatchMap k a -> f (PatchMap k b)
@@ -744,26 +232,12 @@ applyPatchMap applyPatchValue (PatchMap pm) m =
   where
     go m' (Tuple k pv) = Map.alter (applyPatchValue pv) k m'
 
-type VersionedNgramsPatches = Versioned NgramsPatches
-
-newtype AsyncNgramsChartsUpdate = AsyncNgramsChartsUpdate {
-    listId  :: Maybe ListId
-  , tabType :: TabType
-  }
-derive instance Generic AsyncNgramsChartsUpdate _
-derive instance Newtype AsyncNgramsChartsUpdate _
-instance JSON.WriteForeign AsyncNgramsChartsUpdate where
-  writeImpl (AsyncNgramsChartsUpdate { listId, tabType }) =
-    JSON.writeImpl { list_id: listId, tab_type: tabType }
-
-type NewElems = Map NgramsTerm TermList
-
 ----------------------------------------------------------------------------------
 isEmptyNgramsTablePatch :: NgramsTablePatch -> Boolean
-isEmptyNgramsTablePatch {ngramsPatches} = isEmptyPatchMap ngramsPatches
+isEmptyNgramsTablePatch (NgramsTablePatch ngramsPatches) = isEmptyPatchMap ngramsPatches
 
 fromNgramsPatches :: NgramsPatches -> NgramsTablePatch
-fromNgramsPatches ngramsPatches = {ngramsPatches}
+fromNgramsPatches ngramsPatches = NgramsTablePatch ngramsPatches
 
 findNgramRoot :: NgramsTable -> NgramsTerm -> NgramsTerm
 findNgramRoot (NgramsTable m) n =
@@ -782,10 +256,6 @@ rootsOf (NgramsTable m) = Map.keys $ Map.mapMaybe isRoot m.ngrams_repo_elements
   where
     isRoot (NgramsRepoElement { parent }) = parent
 
-type RootParent = { root :: NgramsTerm, parent :: NgramsTerm }
-
-type ReParent a = forall m. MonadState NgramsTable m => a -> m Unit
-
 reRootMaxDepth :: Int
 reRootMaxDepth = 100 -- TODO: this is a hack
 
@@ -837,7 +307,7 @@ newElemsTable = mapWithIndex newElem
 -}
 
 applyNgramsTablePatch :: NgramsTablePatch -> NgramsTable -> NgramsTable
-applyNgramsTablePatch { ngramsPatches } (NgramsTable m) =
+applyNgramsTablePatch (NgramsTablePatch ngramsPatches) (NgramsTable m) =
   execState (reParentNgramsTablePatch ngramsPatches) $
   NgramsTable $ m { ngrams_repo_elements =
                       applyPatchMap applyNgramsPatch ngramsPatches m.ngrams_repo_elements }
@@ -846,19 +316,6 @@ applyNgramsPatches :: forall s. CoreState s -> NgramsTable -> NgramsTable
 applyNgramsPatches {ngramsLocalPatch, ngramsStagePatch, ngramsValidPatch} =
   applyNgramsTablePatch (ngramsLocalPatch <> ngramsStagePatch <> ngramsValidPatch)
   -- First the valid patch, then the stage patch, and finally the local patch.
------------------------------------------------------------------------------------
-
-type CoreState s =
-  { ngramsLocalPatch :: NgramsTablePatch
-                     -- ^ These patches are local and not yet staged.
-  , ngramsStagePatch :: NgramsTablePatch
-                     -- ^ These patches are staged (scheduled for synchronization).
-                     --   Requests are being performed at the moment.
-  , ngramsValidPatch :: NgramsTablePatch
-                     -- ^ These patches have been synchronized with the server.
-  , ngramsVersion    :: Version
-  | s
-  }
 
 {-
 postNewNgrams :: forall s. Array NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit
@@ -891,7 +348,7 @@ newNgramPatch list =
 
 addNewNgramP :: NgramsTerm -> TermList -> NgramsTablePatch
 addNewNgramP ngrams list =
-  { ngramsPatches: singletonPatchMap ngrams (newNgramPatch list) }
+  NgramsTablePatch $ singletonPatchMap ngrams (newNgramPatch list)
 
 addNewNgramA :: NgramsTerm -> TermList -> CoreAction
 addNewNgramA ngrams list = CommitPatch $ addNewNgramP ngrams list
@@ -910,7 +367,7 @@ putNgramsPatches { listIds, nodeId, session, tabType } = put session putNgrams
 
 syncPatches :: forall p s. CoreParams p -> T.Box (CoreState s) -> (Unit -> Aff Unit) -> Effect Unit
 syncPatches props state callback = do
-  { ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
+  { ngramsLocalPatch: ngramsLocalPatch@(NgramsTablePatch ngramsPatches)
   , ngramsStagePatch
   , ngramsVersion } <- T.read state
   when (isEmptyNgramsTablePatch ngramsStagePatch) $ do
@@ -987,8 +444,6 @@ loadNgramsTable
   --                         , termListFilter
   --                         , termSizeFilter } (Just nodeId)
 
-type NgramsListByTabType = Map TabType VersionedNgramsTable
-
 loadNgramsTableAll :: PageParams -> AffRESTError NgramsListByTabType
 loadNgramsTableAll { nodeId, listIds, session } = do
   let
@@ -1013,35 +468,13 @@ convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc
 convOrderBy (T.ASC  _) = TermAsc
 convOrderBy (T.DESC _) = TermDesc
 
-data CoreAction
-  = CommitPatch NgramsTablePatch
-  | Synchronize { afterSync  :: Unit -> Aff Unit }
-  | ResetPatches
-
-data Action
-  = CoreAction CoreAction
-  | SetParentResetChildren (Maybe NgramsTerm)
-  -- ^ This sets `ngramsParent` and resets `ngramsChildren`.
-  | ToggleChild Boolean NgramsTerm
-  -- ^ Toggles the NgramsTerm in the `PatchSet` `ngramsChildren`.
-  -- If the `Boolean` is `true` it means we want to add it if it is not here,
-  -- if it is `false` it is meant to be removed if not here.
-  | AddTermChildren
-  | ToggleSelect NgramsTerm
-  -- ^ Toggles the NgramsTerm in the `Set` `ngramsSelection`.
-  | ToggleSelectAll
-
-
-type CoreDispatch = CoreAction -> Effect Unit
-type Dispatch = Action -> Effect Unit
-
 coreDispatch :: forall p s. CoreParams p -> T.Box (CoreState s) -> CoreDispatch
 coreDispatch path state (Synchronize { afterSync }) =
   syncPatches path state afterSync
 coreDispatch _ state (CommitPatch pt) =
   commitPatch pt state
 coreDispatch _ state ResetPatches =
-  T.modify_ (_ { ngramsLocalPatch = { ngramsPatches: mempty } }) state
+  T.modify_ (_ { ngramsLocalPatch = mempty :: NgramsTablePatch }) state
 
 isSingleNgramsTerm :: NgramsTerm -> Boolean
 isSingleNgramsTerm nt = isSingleTerm $ ngramsTermText nt
@@ -1058,111 +491,7 @@ filterTermSize _                _  = true
 
 
 ------------------------------------------------------------------------
--- | Reset Button
-type SyncResetButtonsProps =
-  ( afterSync        :: Unit -> Aff Unit
-  , ngramsLocalPatch :: NgramsTablePatch
-  , performAction    :: CoreDispatch
-  )
-
-syncResetButtons :: Record SyncResetButtonsProps -> R.Element
-syncResetButtons p = R.createElement syncResetButtonsCpt p []
-syncResetButtonsCpt :: R.Component SyncResetButtonsProps
-syncResetButtonsCpt = here.component "syncResetButtons" cpt
-  where
-    cpt { afterSync, ngramsLocalPatch, performAction } _ = do
-      synchronizing <- T.useBox false
-      synchronizing' <- T.useLive T.unequal synchronizing
-
-      let
-        hasChanges = ngramsLocalPatch /= mempty
-        hasChangesClass = if hasChanges then "" else " disabled"
-
-        synchronizingClass = if synchronizing' then " disabled" else ""
-
-        resetClick _ = do
-          performAction ResetPatches
-
-        synchronizeClick _ = delay unit $ \_ -> do
-          T.write_ true synchronizing
-          performAction $ Synchronize { afterSync: newAfterSync }
-
-        newAfterSync x = do
-          afterSync x
-          liftEffect $ T.write_ false synchronizing
-
-      pure $ H.div { className: "btn-toolbar" }
-        [ H.div { className: "btn-group mr-2" }
-          [ H.button { className: "btn btn-danger " <> hasChangesClass <> synchronizingClass
-                     , on: { click: resetClick }
-                     } [ H.text "Reset" ]
-          ]
-        , H.div { className: "btn-group mr-2" }
-          [ H.button { className: "btn btn-primary " <> hasChangesClass <> synchronizingClass
-                     , on: { click: synchronizeClick }
-                     } [ H.text "Sync" ]
-          ]
-        ]
 
-------------------------------------------------------------------
-
-
-type AutoSyncInput s =
-  ( state  :: T.Box (CoreState s)
-  , action :: CoreDispatch
-  )
-
-type AutoSyncOutput =
-  -- @XXX: cannot use an Either here due to the mecanism of `syncPatches` only
-  --       returning an `Aff Unit`
-  -- ( result :: T.Box (Maybe (Either RESTError Unit))
-  ( result    :: T.Box (Maybe Unit)
-  , onPending :: T.Box Boolean
-  )
-
-useAutoSync :: forall s.
-     Record (AutoSyncInput s)
-  -> R.Hooks (Record AutoSyncOutput)
-useAutoSync { state, action } = do
-  -- States
-  onPending <- T.useBox false
-  result    <- T.useBox Nothing
-
-  ngramsLocalPatch <-
-    T.useFocused
-      (_.ngramsLocalPatch)
-      (\a b -> b { ngramsLocalPatch = a }) state
-
-  -- Computed
-  let
-    exec { new } =
-      let hasChanges = new /= mempty
-      in when hasChanges do
-        T.write_ true onPending
-        T.write_ Nothing result
-        action $ Synchronize
-          { afterSync: onSuccess
-          }
-
-    onSuccess _ = liftEffect do
-      T.write_ false onPending
-      T.write_ (Just unit) result
-
-  -- Hooks
-  R.useEffectOnce' $ T.listen exec ngramsLocalPatch
-
-  -- Output
-  pure
-    { onPending
-    , result
-    }
-
-------------------------------------------------------------------
-
-type ResetButton = (Unit -> Aff Unit)
-               -> { ngramsPatches :: PatchMap NgramsTerm NgramsPatch }
-               -> (Action -> Effect Unit)
-               -> Array R.Element
 
 chartsAfterSync :: forall props discard.
   { listIds :: Array Int
@@ -1189,3 +518,8 @@ postNgramsChartsAsync { listIds, nodeId, session, tabType } = do
     acu = AsyncNgramsChartsUpdate { listId: head listIds
                                   , tabType }
     putNgramsAsync = PostNgramsChartsAsync (Just nodeId)
+
+
+tablePatchHasNgrams :: NgramsTablePatch -> NgramsTerm -> Boolean
+tablePatchHasNgrams (NgramsTablePatch ngramsPatches) ngrams =
+  isJust $ ngramsPatches ^. _PatchMap <<< at ngrams

src/Gargantext/Core/NgramsTable/Types.purs

+module Gargantext.Core.NgramsTable.Types where
+
+import Control.Monad.State (class MonadState, execState)
+import Data.Bifunctor (lmap)
+import Data.Eq.Generic (genericEq)
+import Data.Foldable (class Foldable, foldMap, foldl, foldr)
+import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)
+import Data.Generic.Rep (class Generic)
+import Data.Lens (Iso', Lens', use, view, (%=), (%~), (.~), (?=), (^?))
+import Data.Lens.At (class At, at)
+import Data.Lens.Common (_Just)
+import Data.Lens.Index (class Index, ix)
+import Data.Lens.Iso.Newtype (_Newtype)
+import Data.Lens.Record (prop)
+import Data.List (List)
+import Data.Map (Map)
+import Data.Map as Map
+import Data.Maybe (Maybe(..), isJust)
+import Data.Monoid.Additive (Additive(..))
+import Data.Newtype (class Newtype)
+import Data.Ord.Generic (genericCompare)
+import Data.Show.Generic (genericShow)
+import Data.Set (Set)
+import Data.Set as Set
+import Data.String.Regex (Regex, regex, replace) as R
+import Data.Symbol (SProxy(..))
+import Data.Tuple (Tuple(..))
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Effect.Exception.Unsafe (unsafeThrow)
+import Foreign as F
+import Foreign.Object as FO
+import Gargantext.Components.Table.Types as T
+import Gargantext.Prelude
+import Gargantext.Sessions (Session)
+import Gargantext.Types as GT
+import Simple.JSON as JSON
+import Reactix as R
+
+type Endo a = a -> a
+
+
+-- | Main Types
+type Version = Int
+
+newtype Versioned a = Versioned
+  { version :: Version
+  , data    :: a
+  }
+derive instance Generic (Versioned a) _
+derive instance Newtype (Versioned a) _
+instance Eq a => Eq (Versioned a) where eq = genericEq
+derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (Versioned a)
+derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (Versioned a)
+------------------------------------------------------------------------
+type Count = Int
+
+newtype VersionedWithCount a = VersionedWithCount
+  { version :: Version
+  , count   :: Count
+  , data    :: a
+  }
+derive instance Generic (VersionedWithCount a) _
+derive instance Newtype (VersionedWithCount a) _
+instance Eq a => Eq (VersionedWithCount a) where eq = genericEq
+derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (VersionedWithCount a)
+derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (VersionedWithCount a)
+
+---------------------------------------------------
+newtype NgramsTablePatch = NgramsTablePatch NgramsPatches
+derive instance Generic NgramsTablePatch _
+derive instance Newtype NgramsTablePatch _
+instance Eq NgramsTablePatch where eq = genericEq
+derive newtype instance JSON.ReadForeign NgramsTablePatch
+derive newtype instance JSON.WriteForeign NgramsTablePatch
+derive newtype instance Semigroup NgramsTablePatch
+derive newtype instance Monoid NgramsTablePatch
+
+
+type NgramsPatches = PatchMap NgramsTerm NgramsPatch
+
+
+
+fromMap :: forall k p. Ord k => Eq p => Monoid p => Map k p -> PatchMap k p
+fromMap = PatchMap <<< Map.filter (\v -> v /= mempty)
+
+
+
+ngramsTermText :: NgramsTerm -> String
+ngramsTermText (NormNgramsTerm t) = t
+
+
+
+newtype PatchMap k p = PatchMap (Map k p)
+derive instance Generic (PatchMap k p) _
+derive instance Newtype (PatchMap k p) _
+derive instance (Eq k, Eq p) => Eq (PatchMap k p)
+-- TODO generalize
+instance JSON.WriteForeign p => JSON.WriteForeign (PatchMap NgramsTerm p) where
+  writeImpl (PatchMap m) =
+    JSON.writeImpl $ FO.fromFoldable $ map (lmap ngramsTermText) (Map.toUnfoldable m :: Array _)
+instance (JSON.ReadForeign p, Monoid p) => JSON.ReadForeign (PatchMap NgramsTerm p) where
+  readImpl f = do
+    inst <- JSON.readImpl f
+    pure $ PatchMap $ foldlWithIndex (\k m v -> Map.insert (NormNgramsTerm k) v m) Map.empty (inst :: FO.Object p)
+    -- TODO we assume that the ngrams are already normalized ^^^^^^^^^^^^^
+instance (Ord k, Eq p, Monoid p) => Semigroup (PatchMap k p) where
+  append (PatchMap p) (PatchMap q) = fromMap $ Map.unionWith append p q
+instance (Ord k, Eq p, Monoid p) => Monoid (PatchMap k p) where
+  mempty = PatchMap Map.empty
+instance 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 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 Functor (PatchMap k) where
+  map f (PatchMap m) = PatchMap (map f m) -- NO NORM: fromMap would not typecheck
+
+instance FunctorWithIndex k (PatchMap k) where
+  mapWithIndex f (PatchMap m) = PatchMap (mapWithIndex f m) -- NO NORM: fromMap would not typecheck
+-}
+
+{- fromMap is preventing these to type check:
+
+instance Ord k => Traversable (PatchMap k) where
+  traverse f (PatchMap m) = fromMap <$> traverse f m
+  sequence (PatchMap m) = fromMap <$> sequence m
+
+instance Ord k => TraversableWithIndex k (PatchMap k) where
+  traverseWithIndex f (PatchMap m) = fromMap <$> traverseWithIndex f m
+-}
+
+_PatchMap :: forall k p. Iso' (PatchMap k p) (Map k p)
+_PatchMap = _Newtype
+
+
+
+-- TODO shall we normalise as in replace? shall we make a type class Replaceable?
+ngramsReplace :: Maybe NgramsRepoElement -> Maybe NgramsRepoElement -> NgramsPatch
+ngramsReplace patch_old patch_new = NgramsReplace {patch_old, patch_new}
+
+
+applyReplace :: forall a. Eq a => Replace a -> a -> a
+applyReplace Keep a = a
+applyReplace (Replace { old, new }) a
+  | a == old  = new
+  | otherwise = a
+
+
+
+applyPatchSet :: forall a. Ord a => PatchSet a -> Set a -> Set a
+applyPatchSet (PatchSet p) s = Set.difference s p.rem <> p.add
+
+
+
+applyNgramsPatch' :: forall row.
+                          { patch_children :: PatchSet NgramsTerm
+                          , patch_list     :: Replace GT.TermList
+                          } ->
+                     Endo { list     :: GT.TermList
+                          , children :: Set NgramsTerm
+                          | row
+                          }
+applyNgramsPatch' p e =
+  e { list     = applyReplace p.patch_list e.list
+    , children = applyPatchSet p.patch_children e.children
+    }
+
+
+-- TODO
+invert :: forall a. a -> a
+invert _ = unsafeThrow "invert: TODO"
+
+
+
+data NgramsPatch
+  = NgramsReplace
+      { patch_old :: Maybe NgramsRepoElement
+      , patch_new :: Maybe NgramsRepoElement
+      }
+  | NgramsPatch
+      { patch_children :: PatchSet NgramsTerm
+      , patch_list     :: Replace GT.TermList
+      }
+derive instance Generic NgramsPatch _
+derive instance Eq NgramsPatch
+instance Monoid NgramsPatch where
+  mempty = NgramsPatch { patch_children: mempty, patch_list: mempty }
+instance Semigroup NgramsPatch where
+  append (NgramsReplace p) (NgramsReplace q)
+    | p.patch_old /= q.patch_new = unsafeThrow "append/NgramsPatch: old != new"
+    | otherwise                  = ngramsReplace q.patch_old p.patch_new
+  append (NgramsPatch p)   (NgramsPatch q) = NgramsPatch
+    { patch_children: p.patch_children <> q.patch_children
+    , patch_list:     p.patch_list     <> q.patch_list
+    }
+  append (NgramsPatch p) (NgramsReplace q) = ngramsReplace q.patch_old (q.patch_new # _Just <<< _Newtype %~ applyNgramsPatch' p)
+  append (NgramsReplace p) (NgramsPatch q) = ngramsReplace (p.patch_old # _Just <<< _Newtype %~ applyNgramsPatch' (invert q)) p.patch_new
+instance JSON.WriteForeign NgramsPatch where
+  writeImpl (NgramsReplace { patch_old, patch_new }) = JSON.writeImpl { patch_old, patch_new }
+  writeImpl (NgramsPatch { patch_children, patch_list }) = JSON.writeImpl { patch_children, patch_list }
+instance JSON.ReadForeign NgramsPatch where
+  readImpl f = do
+    inst :: { patch_old :: Maybe NgramsRepoElement
+            , patch_new :: Maybe NgramsRepoElement
+            , patch_children :: PatchSet NgramsTerm
+            , patch_list :: Replace GT.TermList } <- JSON.readImpl f
+    -- TODO handle empty fields
+    -- TODO handle patch_new
+    if isJust inst.patch_new || isJust inst.patch_old then
+      pure $ NgramsReplace { patch_old: inst.patch_old, patch_new: inst.patch_new }
+    else do
+      pure $ NgramsPatch { patch_list: inst.patch_list, patch_children: inst.patch_children }
+
+-----------------------------------------------------
+newtype NgramsTerm = NormNgramsTerm String
+derive instance Generic NgramsTerm _
+derive instance Newtype NgramsTerm _
+instance Eq NgramsTerm where eq = genericEq
+instance Ord NgramsTerm where compare = genericCompare
+instance Show NgramsTerm where show = genericShow
+derive newtype instance JSON.ReadForeign NgramsTerm
+derive newtype instance JSON.WriteForeign NgramsTerm
+derive newtype instance Monoid NgramsTerm
+
+--------------------------------------------------------
+type CoreParams s =
+  { nodeId  :: Int
+    -- ^ This node can be a corpus or contact.
+  , listIds :: Array Int
+  , tabType :: GT.TabType
+  , session :: Session
+  | s
+  }
+
+type PageParams =
+  CoreParams
+    ( params         :: T.Params
+    , searchQuery    :: String
+    , termListFilter :: Maybe GT.TermList -- Nothing means all
+    , termSizeFilter :: Maybe GT.TermSize -- Nothing means all
+    , scoreType      :: GT.ScoreType
+    )
+
+-----------------------------------------------------------------------------------
+newtype NgramsElement = NgramsElement
+  { ngrams      :: NgramsTerm -- HERE
+  , size        :: Int -- MISSING
+  , list        :: GT.TermList -- ok
+  , root        :: Maybe NgramsTerm -- ok
+  , parent      :: Maybe NgramsTerm -- ok
+  , children    :: Set NgramsTerm -- ok
+  , occurrences :: Int -- HERE
+  }
+derive instance Eq NgramsElement
+derive instance Newtype NgramsElement _
+derive instance Generic NgramsElement _
+instance Show NgramsElement where show = genericShow
+instance JSON.ReadForeign NgramsElement where
+  readImpl f = do
+    inst :: { children :: Array NgramsTerm
+            , size :: Int
+            , list :: GT.TermList
+            , ngrams :: NgramsTerm
+            , occurrences :: Int
+            , parent :: Maybe NgramsTerm
+            , root :: Maybe NgramsTerm }<- JSON.readImpl f
+    pure $ NgramsElement $ inst { children = Set.fromFoldable inst.children }
+instance JSON.WriteForeign NgramsElement where
+  writeImpl (NgramsElement ne) =
+    JSON.writeImpl $ ne { children = Set.toUnfoldable ne.children :: Array _ }
+
+_parent :: forall parent row. Lens' { parent :: parent | row } parent
+_parent = prop (SProxy :: SProxy "parent")
+
+_root :: forall root row. Lens' { root :: root | row } root
+_root   = prop (SProxy :: SProxy "root")
+
+_ngrams :: forall row. Lens' { ngrams :: NgramsTerm | row } NgramsTerm
+_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")
+
+_ngrams_repo_elements :: forall a row. Lens' { ngrams_repo_elements :: a | row } a
+_ngrams_repo_elements = prop (SProxy :: SProxy "ngrams_repo_elements")
+
+_ngrams_scores :: forall a row. Lens' { ngrams_scores :: a | row } a
+_ngrams_scores = prop (SProxy :: SProxy "ngrams_scores")
+
+_NgramsElement  :: Iso' NgramsElement {
+    children    :: Set NgramsTerm
+  , size        :: Int
+  , list        :: GT.TermList
+  , ngrams      :: NgramsTerm
+  , occurrences :: Int
+  , parent      :: Maybe NgramsTerm
+  , root        :: Maybe NgramsTerm
+  }
+_NgramsElement = _Newtype
+
+type NgramsRepoElementT =
+  ( size :: Int
+  , list     :: GT.TermList
+  , root     :: Maybe NgramsTerm
+  , parent   :: Maybe NgramsTerm
+  )
+newtype NgramsRepoElement = NgramsRepoElement
+  { children :: Set NgramsTerm
+  | NgramsRepoElementT }
+derive instance Generic NgramsRepoElement _
+derive instance Newtype NgramsRepoElement _
+derive instance Eq NgramsRepoElement
+instance JSON.ReadForeign NgramsRepoElement where
+  readImpl f = do
+    inst :: { children :: Array NgramsTerm | NgramsRepoElementT } <- JSON.readImpl f
+    pure $ NgramsRepoElement $ inst { children = Set.fromFoldable inst.children }
+instance JSON.WriteForeign NgramsRepoElement where
+  writeImpl (NgramsRepoElement nre) =
+    JSON.writeImpl $ nre { children = Set.toUnfoldable nre.children :: Array _ }
+instance Show NgramsRepoElement where show = genericShow
+
+_NgramsRepoElement  :: Iso' NgramsRepoElement {
+    children    :: Set NgramsTerm
+  , size        :: Int
+  , list        :: GT.TermList
+  , parent      :: Maybe NgramsTerm
+  , root        :: Maybe NgramsTerm
+--  , occurrences :: Int
+  }
+_NgramsRepoElement = _Newtype
+
+-----------------------------------------------------------------------------------
+{-
+  NgramsRepoElement does not have the occurrences field.
+  Instead NgramsTable has a ngrams_scores map.
+
+  Pro:
+  * Does not encumber NgramsRepoElement with the score which is not part of repo.
+  * Enables for multiple scores through multiple maps.
+  Cons:
+  * Having a map on the side is equivalent to a `occurrences :: Maybe Int`, which is
+    less precise.
+  * It is a tiny bit less performant to access the score.
+-}
+newtype NgramsTable = NgramsTable
+  { ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement
+  , ngrams_scores        :: Map NgramsTerm (Additive Int)
+  }
+derive instance Newtype NgramsTable _
+derive instance Generic NgramsTable _
+instance Eq NgramsTable where eq = genericEq
+instance Show NgramsTable where show = genericShow
+instance JSON.ReadForeign NgramsTable where
+  readImpl ff = do
+    inst <- JSON.readImpl ff
+    pure $ NgramsTable
+      { ngrams_repo_elements: Map.fromFoldable $ f <$> (inst :: Array NgramsElement)
+      , ngrams_scores:        Map.fromFoldable $ g <$> inst
+      }
+    where
+      f (NgramsElement {ngrams, size, list, root, parent, children}) =
+        Tuple ngrams (NgramsRepoElement {size, list, root, parent, children})
+      g (NgramsElement e) = Tuple e.ngrams (Additive e.occurrences)
+
+_NgramsTable :: Iso' NgramsTable
+                     { ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement
+                     , ngrams_scores        :: Map NgramsTerm (Additive Int)
+                     }
+_NgramsTable = _Newtype
+
+instance Index NgramsTable NgramsTerm NgramsRepoElement where
+  ix k = _NgramsTable <<< _ngrams_repo_elements <<< ix k
+
+instance At NgramsTable NgramsTerm NgramsRepoElement where
+  at k = _NgramsTable <<< _ngrams_repo_elements <<< at k
+
+{- NOT USED
+instance EncodeJson NgramsTable where
+  encodeJson (NgramsTable {ngrams_repo_elements, ngrams_scores}) = encodeJson $ Map.values ... TODO
+-}
+--------------------------------------------
+
+type HighlightElement = Tuple String (List (Tuple NgramsTerm GT.TermList))
+type HighlightAccumulator = List HighlightElement
+
+-----------------------------------------------------------------------------------
+
+type VersionedNgramsTable = Versioned NgramsTable
+type VersionedWithCountNgramsTable = VersionedWithCount NgramsTable
+
+-----------------------------------------------------------------------------------
+
+replace :: forall a. Eq a => a -> a -> Replace a
+replace old new
+  | old == new = Keep
+  | otherwise  = Replace { old, new }
+
+
+data Replace a
+  = Keep
+  | Replace { old :: a, new :: a }
+derive instance Generic (Replace a) _
+derive instance Eq a => Eq (Replace a)
+instance Eq a => Semigroup (Replace a) where
+  append Keep p = p
+  append p Keep = p
+  append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow "old != new"
+  append (Replace { new }) (Replace { old }) = replace old new
+instance Eq a => Monoid (Replace a) where mempty = Keep
+instance JSON.WriteForeign a => JSON.WriteForeign (Replace a) where
+  writeImpl Keep = JSON.writeImpl { tag: "Keep" }
+  writeImpl (Replace {old, new}) = JSON.writeImpl { old, new, tag: "Replace" }
+instance (JSON.ReadForeign a, Eq a) => JSON.ReadForeign (Replace a) where
+  readImpl f = do
+    impl :: { old :: Maybe a, new :: Maybe a }  <- JSON.readImpl f
+    case Tuple impl.old impl.new of
+      Tuple (Just old) (Just new) -> pure $ replace old new
+      Tuple Nothing Nothing       -> pure Keep
+      _                           -> F.fail $ F.ForeignError "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
+  }
+derive instance Generic (PatchSet a) _
+derive instance Newtype (PatchSet a) _
+instance 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 Ord a => Monoid (PatchSet a) where
+  mempty = PatchSet { rem: Set.empty, add: Set.empty }
+instance JSON.WriteForeign a => JSON.WriteForeign (PatchSet a) where
+  writeImpl (PatchSet {rem, add}) = JSON.writeImpl { rem: (Set.toUnfoldable rem :: Array a)
+                                                   , add: (Set.toUnfoldable add :: Array a) }
+instance (Ord a, JSON.ReadForeign a) => JSON.ReadForeign (PatchSet a) where
+  readImpl f = do
+    -- TODO handle empty fields
+    inst :: { rem :: Array a, add :: Array a } <- JSON.readImpl f
+    let rem = mkSet inst.rem
+        add = mkSet inst.add
+    pure $ PatchSet { rem, add }
+   where
+    mkSet :: forall b. Ord b => Array b -> Set b
+    mkSet = Set.fromFoldable
+derive instance Eq (PatchSet NgramsTerm)
+-----------------------------------------------------
+
+type VersionedNgramsPatches = Versioned NgramsPatches
+
+newtype AsyncNgramsChartsUpdate = AsyncNgramsChartsUpdate {
+    listId  :: Maybe GT.ListId
+  , tabType :: GT.TabType
+  }
+derive instance Generic AsyncNgramsChartsUpdate _
+derive instance Newtype AsyncNgramsChartsUpdate _
+instance JSON.WriteForeign AsyncNgramsChartsUpdate where
+  writeImpl (AsyncNgramsChartsUpdate { listId, tabType }) =
+    JSON.writeImpl { list_id: listId, tab_type: tabType }
+
+type NewElems = Map NgramsTerm GT.TermList
+
+type RootParent = { root :: NgramsTerm, parent :: NgramsTerm }
+
+type ReParent a = forall m. MonadState NgramsTable m => a -> m Unit
+-----------------------------------------------------------------------------------
+
+type CoreState s =
+  { ngramsLocalPatch :: NgramsTablePatch
+                     -- ^ These patches are local and not yet staged.
+  , ngramsStagePatch :: NgramsTablePatch
+                     -- ^ These patches are staged (scheduled for synchronization).
+                     --   Requests are being performed at the moment.
+  , ngramsValidPatch :: NgramsTablePatch
+                     -- ^ These patches have been synchronized with the server.
+  , ngramsVersion    :: Version
+  | s
+  }
+
+type NgramsListByTabType = Map GT.TabType VersionedNgramsTable
+
+data CoreAction
+  = CommitPatch NgramsTablePatch
+  | Synchronize { afterSync  :: Unit -> Aff Unit }
+  | ResetPatches
+
+data Action
+  = CoreAction CoreAction
+  | ClearTreeEdit
+  | SetParentResetChildren (Maybe NgramsTerm) (List NgramsTerm)
+  -- ^ This sets `ngramsParent` and resets `ngramsChildren`.
+  | ToggleChild Boolean NgramsTerm
+  -- ^ Toggles the NgramsTerm in the `PatchSet` `ngramsChildren`.
+  -- If the `Boolean` is `true` it means we want to add it if it is not here,
+  -- if it is `false` it is meant to be removed if not here.
+  | AddTermChildren
+  | ToggleSelect NgramsTerm
+  -- ^ Toggles the NgramsTerm in the `Set` `ngramsSelection`.
+  | ToggleSelectAll
+
+
+type CoreDispatch = CoreAction -> Effect Unit
+type Dispatch = Action -> Effect Unit
+
+
+
+type NgramsDepth = { ngrams :: NgramsTerm, depth :: Int }
+type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
+type NgramsActionRef = R.Ref (Maybe (Unit -> Effect Unit))
+
+
+type ResetButton = (Unit -> Aff Unit)
+               -> NgramsTablePatch
+               -> (Action -> Effect Unit)
+               -> Array R.Element

src/Gargantext/Utils/Reactix.js

@@ -39,6 +39,16 @@ function blur(el) {
     return el.blur();
 }
 
+function triggerEvent(el, evtType) {
+  // https://stackoverflow.com/questions/8789423/trigger-onchange-event
+  var event = new UIEvent(evtType, {
+    view: window,
+    bubbles: true,
+    cancelable: true
+  });
+  el.dispatchEvent(event);
+}
+
 exports._addRootElement = addRootElement;
 exports._getSelection = getSelection;
 exports._stringify = stringify;
@@ -53,3 +63,4 @@ exports._keyCode = function(e) {
     // https://www.w3schools.com/jsref/event_key_keycode.asp
     return e.which || e.keyCode;
 }
+exports._triggerEvent = triggerEvent;

src/Gargantext/Utils/Reactix.purs

@@ -3,25 +3,25 @@ module Gargantext.Utils.Reactix where
 import Prelude
 
 import ConvertableOptions as CO
-import DOM.Simple as DOM
-import DOM.Simple.Console (log2)
-import DOM.Simple.Document (document)
-import DOM.Simple.Element as Element
-import DOM.Simple.Event as DE
-import DOM.Simple.Types (class IsNode, class IsElement, DOMRect)
 import Data.Array as A
 import Data.Either (hush)
 import Data.Function.Uncurried (Fn1, runFn1, Fn2, runFn2)
 import Data.Maybe (Maybe(..), fromJust, fromMaybe)
 import Data.Maybe as Maybe
-import Data.Nullable (Nullable, null, toMaybe)
+import Data.Nullable (Nullable, notNull, null, toMaybe)
 import Data.Tuple (Tuple)
 import Data.Tuple.Nested ((/\))
+import DOM.Simple as DOM
+import DOM.Simple.Console (log2)
+import DOM.Simple.Document (document)
+import DOM.Simple.Element as Element
+import DOM.Simple.Event as DE
+import DOM.Simple.Types (class IsNode, class IsElement, DOMRect)
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
 import Effect.Class (liftEffect)
 import Effect.Exception (error)
-import Effect.Uncurried (EffectFn1, EffectFn3, mkEffectFn1, mkEffectFn2, runEffectFn1, runEffectFn3)
+import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, mkEffectFn1, mkEffectFn2, runEffectFn1, runEffectFn2, runEffectFn3)
 import FFI.Simple (applyTo, args2, args3, defineProperty, delay, getProperty, (..), (...), (.=))
 import Gargantext.Utils.Console (RowConsole)
 import Gargantext.Utils.Console as Console
@@ -601,3 +601,17 @@ externalOpeningFlag event = ado
   metaKey     <- SE.metaKey event
   middleClick <- SE.button event
   in ctrlKey || shiftKey || metaKey || (middleClick == 1.0)
+
+foreign import _triggerEvent
+  :: forall e. EffectFn2 e String Unit
+
+triggerEvent :: forall el. el -> String -> Effect Unit
+triggerEvent = runEffectFn2 _triggerEvent
+-------------------------------------------------------
+setInputValue :: R.Ref (Nullable DOM.Element) -> String -> Effect Unit
+setInputValue elNullableRef val = case toMaybe (R.readRef elNullableRef) of
+  Nothing -> pure unit
+  Just el -> do
+    _ <- pure $ (el .= "value") val
+    triggerEvent el "change"
+    triggerEvent el "input"

src/Gargantext/Utils/Toestand.purs

@@ -55,4 +55,3 @@ useMemberBox val box = T.useFocused (Set.member val) (toggleSet val) box
 toggleSet :: forall s. Ord s => s -> Boolean -> Set s -> Set s
 toggleSet val true  set = Set.insert val set
 toggleSet val false set = Set.delete val set
-

test/Gargantext/Components/NgramsTable/Spec.purs

@@ -12,7 +12,8 @@ import Test.Spec (Spec, describe, it)
 
 import Test.Utils (shouldEqualArray)
 
-import Gargantext.Components.NgramsTable.Core (highlightNgrams, HighlightElement, NgramsElement(..), NgramsRepoElement(..), NgramsTable(..), NgramsTerm, normNgram)
+import Gargantext.Core.NgramsTable.Functions (highlightNgrams, normNgram)
+import Gargantext.Core.NgramsTable.Types (HighlightElement, NgramsElement(..), NgramsRepoElement(..), NgramsTable(..), NgramsTerm)
 import Gargantext.Types (CTabNgramType(..), TermList(..))