[ngrams] fixes to highlighting of ngrams

src/Gargantext/Components/Annotation/Field.purs

@@ -20,6 +20,7 @@ import DOM.Simple.Event as DE
 import Data.Array as A
 import Data.List (List(..), (:))
 import Data.Map (Map)
+import Data.Map as Map
 import Data.Maybe (Maybe(..), maybe)
 import Data.String.Common (joinWith)
 import Data.Tuple (Tuple(..), snd)
@@ -37,19 +38,22 @@ import Reactix as R
 import Reactix.DOM.HTML as H
 import Reactix.SyntheticEvent as E
 import Record as Record
+import Record.Extra as RX
 import Toestand as T
 
 here :: R2.Here
 here = R2.here "Gargantext.Components.Annotation.Field"
 
 -- @NOTE #386: add parameter "type" ("Authors", "Terms")
-type Props =
-  ( ngrams       :: NgramsTable
-  , setTermList  :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
+type CommonProps =
+  ( setTermList  :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
   , text         :: Maybe String
   , mode         :: ModeType
   , cache        :: Record Cache
   )
+type AnnotatedFieldProps =
+  ( ngrams       :: T.Box NgramsTable
+  | CommonProps )
 type MouseEvent = E.SyntheticEvent DE.MouseEvent
 
 -- UNUSED
@@ -57,24 +61,33 @@ type MouseEvent = E.SyntheticEvent DE.MouseEvent
 -- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit }
 
 
-annotatedField :: R2.Leaf Props
+annotatedField :: R2.Leaf AnnotatedFieldProps
 annotatedField = R2.leaf annotatedFieldCpt
-annotatedFieldCpt :: R.Component Props
+annotatedFieldCpt :: R.Component AnnotatedFieldProps
 annotatedFieldCpt = here.component "annotatedField" cpt where
   cpt props _ = do
+    ngrams' <- T.useLive T.unequal props.ngrams
+
     menuRef <- R.useRef (Nothing :: Maybe (Record AnnotationMenu))
     redrawMenu <- T.useBox false
     reload <- T.useBox T2.newReload
 
-    pure $ annotatedFieldInner (Record.merge { menuRef, redrawMenu, reload } props)
+    let commonProps = RX.pick props :: Record CommonProps
+
+    -- R.useEffect' $ do
+    --   let NgramsTable { ngrams_repo_elements: nre } = ngrams'
+    --   here.log2 "[annotatedField] ngrams' keys" $ A.fromFoldable $ Map.keys nre
+
+    pure $ annotatedFieldInner (Record.merge { menuRef, ngrams: ngrams', redrawMenu, reload } commonProps)
 
 -----------------------------------------------------------------
 
 type InnerProps =
-  ( menuRef    :: R.Ref (Maybe (Record AnnotationMenu))
+  ( ngrams     :: NgramsTable
+  , menuRef    :: R.Ref (Maybe (Record AnnotationMenu))
   , redrawMenu :: T.Box Boolean
   , reload     :: T2.ReloadS
-  | Props
+  | CommonProps
   )
 
 annotatedFieldInner :: R2.Leaf InnerProps
@@ -121,7 +134,7 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
 
             H.div
             { className: "annotated-field-runs"
-            , aria: { expanded: false } 
+            , aria: { expanded: false }
             }
             ((\p -> annotateRun p) <$> wrap <$> compile cache ngrams fieldText)
 

src/Gargantext/Components/Document/Layout.purs

@@ -5,6 +5,7 @@ module Gargantext.Components.Document.Layout
 import Gargantext.Prelude
 
 import Data.Array as A
+import Data.Lens ((^.))
 import Data.Map as Map
 import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
 import Data.Ord (greaterThan)
@@ -32,6 +33,7 @@ import Gargantext.Sessions (Session)
 import Gargantext.Utils ((?))
 import Gargantext.Utils as U
 import Gargantext.Utils.Reactix as R2
+import Gargantext.Utils.Toestand as T2
 import Reactix as R
 import Reactix.DOM.HTML as H
 import Record as Record
@@ -44,6 +46,7 @@ import Toestand as T
 type Props =
   ( loaded   :: LoadedData
   , path     :: DocPath
+  , reload  :: T2.ReloadS
   , session  :: Session
   | Options
   )
@@ -66,14 +69,17 @@ layoutCpt :: R.Component Props
 layoutCpt = here.component "layout" cpt where
   cpt props@{ path: path@{ listIds
                          , nodeId }
+            , reload
             , session } _ = do
+    reload' <- T.useLive T.unequal reload
     case A.head listIds of
       Nothing -> pure $ H.div {} [ H.text "No list supplied!" ]
       Just listId ->
         useLoader { errorHandler
                   , loader: \p -> getContextNgrams session p.contextId p.listId
-                  , path: { contextId: nodeId, listId }
-                  , render: \contextNgrams -> layoutWithContextNgrams $ Record.merge props { contextNgrams } }
+                  , path: { contextId: nodeId, listId, reload: reload' }
+                  , render: \contextNgrams ->
+                      layoutWithContextNgrams $ Record.merge props { contextNgrams } }
     where
       errorHandler = logRESTError here "[layout]"
 
@@ -88,17 +94,16 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where
   -- Component
   cpt { contextNgrams
       , path
+      , reload
       , loaded:
-          loaded@{ ngramsTable: Versioned
-          { data: initTable }
-          , document: NodePoly
-            { hyperdata: Document doc
-            }
+          loaded@{ ngramsTable: Versioned { data: initTable }
+                 , document: NodePoly { hyperdata: Document doc }
           }
       , sideControlsSlot
       } _ = do
     -- | States
     -- |
+    reload' <- T.useLive T.unequal reload
 
     state'@{ ngramsLocalPatch } /\ state <-
       R2.useBox' $ initialState { loaded }
@@ -111,34 +116,45 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where
     onPending' <- R2.useLive' onPending
     result'    <- R2.useLive' result
 
+    ngrams <- T.useBox initTable
+    ngrams' <- T.useLive T.unequal ngrams
+
     -- | Computed
     -- |
     let
 
       withAutoUpdate = false
 
-      ngrams = applyNgramsPatches state' initTable
-
-      cache = computeCache ngrams $ Set.fromFoldable contextNgrams
+      -- ngrams = applyNgramsPatches state' initTable
 
-      annotate text = AnnotatedField.annotatedField
-        { ngrams
-        , setTermList
-        , text
-        , mode: mode'
-        , cache
-        }
+      cache = computeCache ngrams' $ Set.fromFoldable contextNgrams
 
       setTermListOrAddA ngram Nothing        =
         addNewNgramA ngram
       setTermListOrAddA ngram (Just oldList) =
         setTermListA ngram <<< replace oldList
 
-      setTermList ngram mOldList =
-        dispatch <<< setTermListOrAddA (findNgramRoot ngrams ngram) mOldList
+      setTermList ngram mOldList termList = do
+        let root = findNgramRoot ngrams' ngram
+        -- here.log2 "[setTermList] ngram" ngram
+        -- here.log2 "[setTermList] root" root
+        let patch = setTermListOrAddA root mOldList termList
+        -- here.log2 "[setTermList] patch" patch
+        dispatch patch
+        T.write_ (applyNgramsPatches state' initTable) ngrams
+        -- here.log2 "[setTermList] calling reload" reload'
+        T2.reload reload
 
       hasAbstract =  maybe false (not String.null) doc.abstract
 
+      annotate text = AnnotatedField.annotatedField
+                      { ngrams
+                      , setTermList
+                      , text
+                      , mode: mode'
+                      , cache
+                      }
+
     -- | Hooks
     -- |
 
@@ -153,6 +169,14 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where
     let
       onModeChange = read >>> fromMaybe AFT.EditionMode >>> flip T.write_ mode
 
+    -- R.useEffect' $ do
+    --   here.log2 "[layoutWithContextNgrams] cache" cache
+    --   here.log2 "[layoutWithContextNgrams] ngramsLocalPatch" ngramsLocalPatch
+    --   let NgramsTable { ngrams_repo_elements: nre } = initTable
+    --   here.log2 "[layoutWithContextNgrams] ngrams_repo_elements" $ A.fromFoldable $ Map.keys nre
+    --   let NgramsTable { ngrams_repo_elements: nre' } = ngrams'
+    --   here.log2 "[layoutWithContextNgrams] ngrams (after apply patches)" $ A.fromFoldable $ Map.keys nre'
+
     -- | Render
     -- |
     pure $

src/Gargantext/Components/GraphExplorer/Frame/DocFocus.purs

@@ -18,8 +18,10 @@ import Gargantext.Hooks.Loader (useLoaderEffect)
 import Gargantext.Sessions (Session)
 import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
 import Gargantext.Utils.Reactix as R2
+import Gargantext.Utils.Toestand as T2
 import Reactix as R
 import Reactix.DOM.HTML as H
+import Toestand as T
 
 
 here :: R2.Here
@@ -33,7 +35,6 @@ type Props =
 
 docFocus :: R2.Leaf ( key :: String | Props )
 docFocus = R2.leaf docFocusCpt
-
 docFocusCpt :: R.Component ( key :: String | Props )
 docFocusCpt = here.component "main" cpt where
   cpt { graphSideDoc: GraphSideDoc { docId, listId, corpusId }
@@ -43,6 +44,8 @@ docFocusCpt = here.component "main" cpt where
     -- | States
     -- |
     state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData)
+    reload <- T.useBox T2.newReload
+    reload' <- T.useLive T.unequal reload
 
     -- | Computed
     -- |
@@ -89,6 +92,7 @@ docFocusCpt = here.component "main" cpt where
               layout
               { loaded
               , path
+              , reload
               , session
               , sideControlsSlot: Just $
                   H.div

src/Gargantext/Components/Node.purs

@@ -34,6 +34,15 @@ instance JSON.ReadForeign a => JSON.ReadForeign (NodePoly a) where
                     , name: inst.name
                     , date: inst.date
                     , hyperdata: inst.hyperdata }
+instance JSON.WriteForeign a => JSON.WriteForeign (NodePoly a) where
+  writeImpl (NodePoly np) = do
+    JSON.writeImpl { user_id   : np.userId
+                   , parent_id : np.parentId
+                   , id        : np.id
+                   , typename  : np.typename
+                   , name      : np.name
+                   , date      : np.date
+                   , hyperdata : np.hyperdata}
 
 newtype HyperdataList = HyperdataList { preferences :: Maybe String }
 derive instance Generic HyperdataList _

src/Gargantext/Components/Nodes/Corpus/Document.purs

@@ -16,7 +16,9 @@ import Gargantext.Hooks.Loader (useLoaderEffect)
 import Gargantext.Hooks.Session (useSession)
 import Gargantext.Types (CTabNgramType(..), ListId, NodeID, TabSubType(..), TabType(..))
 import Gargantext.Utils.Reactix as R2
+import Gargantext.Utils.Toestand as T2
 import Reactix as R
+import Toestand as T
 
 type Props =
   ( listId    :: ListId
@@ -40,6 +42,8 @@ nodeCpt = here.component "node" cpt where
     session <- useSession
 
     state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData)
+    reload <- T.useBox T2.newReload
+    reload' <- T.useLive T.unequal reload
 
     -- | Computed
     -- |
@@ -85,6 +89,7 @@ nodeCpt = here.component "node" cpt where
             layout
             { loaded
             , path
+            , reload
             , session
             }
       }

src/Gargantext/Components/Nodes/Texts.purs

@@ -41,6 +41,7 @@ import Gargantext.Utils.Reactix as R2
 import Gargantext.Utils.Toestand as T2
 import Reactix as R
 import Reactix.DOM.HTML as H
+import Simple.JSON as JSON
 import Toestand as T
 
 here :: R2.Here
@@ -548,7 +549,15 @@ sideTextCpt = here.component "sideText" cpt where
       } _ = do
     -- | States
     -- |
-    state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData)
+    -- state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData)
+    -- state <- T.useBox (Nothing :: Maybe LoadedData)
+    -- state' <- T.useLive T.unequal state
+
+    -- R.useEffect' $ do
+    --   here.log2 "[sideText] state'" state'
+
+    reload <- T.useBox T2.newReload
+    reload' <- T.useLive T.unequal reload
 
     -- | Computed
     -- |
@@ -568,34 +577,58 @@ sideTextCpt = here.component "sideText" cpt where
 
     -- | Hooks
     -- |
-    useLoaderEffect
-      { errorHandler: logRESTError here "[sidePanelText]"
-      , loader: loadData
-      , path
-      , state
-      }
-
-    -- | Render
-    -- |
-    pure $
-
-
-      H.div
-      { className: "graph-doc-focus" }
-      [
-        B.cloak
-        { isDisplayed: isJust state'
-        , idlingPhaseDuration: Just 150
-        , cloakSlot:
-            B.preloader
-            {}
-
-        , defaultSlot:
-            R2.fromMaybe state' \loaded ->
-              layout
-              { loaded
-              , path
-              , session
+    -- useLoaderEffect
+    --   { errorHandler: logRESTError here "[sidePanelText]"
+    --   , loader: loadData
+    --   , path
+    --   , state
+    --   }
+
+    useLoader { errorHandler: logRESTError here "[sidePanelText]"
+              , loader: \{ path, reload'} -> loadData path
+              , path: { path, reload' }
+              , render: \loaded -> loadedSideText { loaded
+                                                  , path
+                                                  , reload
+                                                  , session }
               }
-        }
-      ]
+
+    -- -- | Render
+    -- -- |
+    -- pure $
+
+
+    --   H.div
+    --   { className: "graph-doc-focus" }
+    --   [
+    --     B.cloak
+    --     { isDisplayed: isJust state'
+    --     , idlingPhaseDuration: Just 150
+    --     , cloakSlot:
+    --         B.preloader
+    --         {}
+
+    --     , defaultSlot:
+    --         R2.fromMaybe state' \loaded ->
+    --           layout
+    --           { loaded
+    --           , path
+    --           , session
+    --           , key: JSON.writeJSON loaded
+    --           }
+    --     }
+    --   ]
+
+type LoadedSideTextProps =
+  ( loaded :: LoadedData
+  , path :: DocPath
+  , reload :: T2.ReloadS
+  , session :: Session )
+
+loadedSideText :: R2.Leaf LoadedSideTextProps
+loadedSideText = R2.leaf loadedSideTextCpt
+loadedSideTextCpt :: R.Component LoadedSideTextProps
+loadedSideTextCpt = here.component "loadedSideText" cpt where
+  cpt { loaded, path, reload, session } _ = do
+    pure $ H.div { className: "graph-doc-focus" }
+      [ layout { loaded, path, reload, session } ]

src/Gargantext/Components/PhyloExplorer/Frame/DocFocus.purs

@@ -18,8 +18,10 @@ import Gargantext.Hooks.Loader (useLoaderEffect)
 import Gargantext.Sessions (Session)
 import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
 import Gargantext.Utils.Reactix as R2
+import Gargantext.Utils.Toestand as T2
 import Reactix as R
 import Reactix.DOM.HTML as H
+import Toestand as T
 
 
 here :: R2.Here
@@ -33,7 +35,6 @@ type Props =
 
 docFocus :: R2.Leaf ( key :: String | Props )
 docFocus = R2.leaf docFocusCpt
-
 docFocusCpt :: R.Component ( key :: String | Props )
 docFocusCpt = here.component "main" cpt where
   cpt { frameDoc: FrameDoc { docId, listId, corpusId }
@@ -44,6 +45,9 @@ docFocusCpt = here.component "main" cpt where
     -- |
     state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData)
 
+    reload <- T.useBox T2.newReload
+    reload' <- T.useLive T.unequal reload
+
     -- | Computed
     -- |
     let
@@ -89,6 +93,7 @@ docFocusCpt = here.component "main" cpt where
               layout
               { loaded
               , path
+              , reload
               , session
               , sideControlsSlot: Just $
                   H.div