Merge remote-tracking branch 'origin/551-dev-annotation-fix' into dev-merge

src/Gargantext/Components/Annotation/Field.purs

@@ -14,7 +14,6 @@ module Gargantext.Components.Annotation.Field where
 import Gargantext.Prelude
 
 import Data.Array as A
-import Data.FoldableWithIndex (foldlWithIndex, foldrWithIndex)
 import Data.List (List(..), (:))
 import Data.Map (Map)
 import Data.Maybe (Maybe(..), maybe)

src/Gargantext/Components/Document/Layout.purs

@@ -5,8 +5,11 @@ module Gargantext.Components.Document.Layout
 import Gargantext.Prelude
 
 import Data.Array as A
+import Data.Map as Map
 import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
 import Data.Ord (greaterThan)
+import Data.Set (Set)
+import Data.Set as Set
 import Data.String (length)
 import Data.String as String
 import Data.Tuple.Nested ((/\))
@@ -17,16 +20,21 @@ import Gargantext.Components.Bootstrap as B
 import Gargantext.Components.Bootstrap.Types (ComponentStatus(..), SpinnerTheme(..))
 import Gargantext.Components.Category (ratingSimpleLoader)
 import Gargantext.Components.Document.Types (DocPath, Document(..), LoadedData, initialState)
+import Gargantext.Components.GraphQL.Endpoints (getContextNgrams)
 import Gargantext.Components.NgramsTable.AutoSync (useAutoSync)
 import Gargantext.Components.Node (NodePoly(..))
+import Gargantext.Config.REST (logRESTError)
 import Gargantext.Core.NgramsTable.Functions (addNewNgramA, applyNgramsPatches, coreDispatch, findNgramRoot, setTermListA, computeCache)
-import Gargantext.Core.NgramsTable.Types (CoreAction(..), Versioned(..), replace)
+import Gargantext.Core.NgramsTable.Types (CoreAction(..), NgramsTable(..), NgramsTerm, Versioned(..), replace)
 import Gargantext.Hooks.FirstEffect (useFirstEffect')
+import Gargantext.Hooks.Loader (useLoader)
+import Gargantext.Sessions (Session)
 import Gargantext.Utils ((?))
 import Gargantext.Utils as U
 import Gargantext.Utils.Reactix as R2
 import Reactix as R
 import Reactix.DOM.HTML as H
+import Record as Record
 import Toestand as T
 
 -------------------------------------------------------------------------
@@ -36,6 +44,7 @@ import Toestand as T
 type Props =
   ( loaded   :: LoadedData
   , path     :: DocPath
+  , session  :: Session
   | Options
   )
 
@@ -55,8 +64,30 @@ layout :: forall r. R2.OptLeaf Options Props r
 layout = R2.optLeaf layoutCpt options
 layoutCpt :: R.Component Props
 layoutCpt = here.component "layout" cpt where
+  cpt props@{ path: path@{ listIds
+                         , nodeId }
+            , session } _ = do
+    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 } }
+    where
+      errorHandler = logRESTError here "[layout]"
+
+type WithContextNgramsProps =
+  ( contextNgrams :: Array NgramsTerm
+  | Props )
+
+layoutWithContextNgrams :: forall r. R2.OptLeaf Options WithContextNgramsProps r
+layoutWithContextNgrams = R2.optLeaf layoutWithContextNgramsCpt options
+layoutWithContextNgramsCpt :: R.Component WithContextNgramsProps
+layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where
   -- Component
-  cpt { path
+  cpt { contextNgrams
+      , path
       , loaded:
           loaded@{ ngramsTable: Versioned
           { data: initTable }
@@ -88,7 +119,7 @@ layoutCpt = here.component "layout" cpt where
 
       ngrams = applyNgramsPatches state' initTable
 
-      cache = computeCache ngrams
+      cache = computeCache ngrams $ Set.fromFoldable contextNgrams
 
       annotate text = AnnotatedField.annotatedField
         { ngrams
@@ -111,6 +142,11 @@ layoutCpt = here.component "layout" cpt where
     -- | Hooks
     -- |
 
+    -- R.useEffect' $ do
+    --   let NgramsTable { ngrams_repo_elements } = ngrams
+    --   here.log2 "[layout] length of ngrams" $ Map.size ngrams_repo_elements
+    --   here.log2 "[layout] length of pats" $ A.length cache.pats
+    --   here.log2 "[layout] contextNgrams" contextNgrams
 
     -- | Behaviors
     -- |

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

@@ -89,6 +89,7 @@ docFocusCpt = here.component "main" cpt where
               layout
               { loaded
               , path
+              , session
               , sideControlsSlot: Just $
                   H.div
                   { className: "graph-doc-focus__header" }

src/Gargantext/Components/GraphQL.purs

@@ -74,6 +74,7 @@ queryGql session name q = do
 -- Schema
 type Schema
   = { annuaire_contacts :: { contact_id :: Int } ==> Array AnnuaireContact
+    , context_ngrams :: { context_id :: Int, list_id :: Int } ==> Array String
     , contexts :: { context_id :: Int, node_id :: Int } ==> Array GQLCTX.NodeContext
     , contexts_for_ngrams :: { corpus_id :: Int, ngrams_terms :: Array String } ==> Array GQLCTX.Context
     , imt_schools :: {} ==> Array GQLIMT.School

src/Gargantext/Components/GraphQL/Context.purs

@@ -8,6 +8,7 @@ module Gargantext.Components.GraphQL.Context
   , nodeContextQuery
   , NodeContextCategoryM
   , contextsForNgramsQuery
+  , contextNgramsQuery
   , NgramsTerms(..)
   ) where
 
@@ -132,6 +133,18 @@ contextsForNgramsQuery
       GGQL.getFieldsStandard (Proxy :: _ Context)
     }
 
+type ContextNgramsQuery
+  = { context_ngrams :: Args
+    { context_id :: Var "context_id" Int
+    , list_id    :: Var "list_id" Int }
+    Unit }
+
+contextNgramsQuery :: ContextNgramsQuery
+contextNgramsQuery
+  = { context_ngrams:
+      { context_id: Var :: _ "context_id" Int
+      , list_id:    Var :: _ "list_id" Int } =>> unit }
+
 ------------------------------------------------------------------------
 
 type NodeContextCategoryM

src/Gargantext/Components/GraphQL/Endpoints.purs

@@ -20,6 +20,7 @@ import Gargantext.Components.GraphQL.Tree (TreeFirstLevel, treeFirstLevelQuery)
 import Gargantext.Components.GraphQL.User (UserInfo, userInfoQuery)
 import Gargantext.Components.Lang (Lang)
 import Gargantext.Config.REST (RESTError(..), AffRESTError)
+import Gargantext.Core.NgramsTable.Types (NgramsTerm(..))
 import Gargantext.Sessions (Session(..))
 import Gargantext.Types (NodeType)
 import Gargantext.Utils.Reactix as R2
@@ -152,3 +153,10 @@ getLanguages session = do
   liftEffect $ here.log2 "[getLanguages] languages" languages
 
   pure $ Right $ Map.fromFoldable $ (\{ key, value } -> Tuple key value) <$> languages
+
+getContextNgrams :: Session -> Int -> Int -> AffRESTError (Array NgramsTerm)
+getContextNgrams session context_id list_id = do
+  client <- liftEffect $ getClient session
+  let query = GQLCTX.contextNgramsQuery `withVars` { context_id, list_id }
+  { context_ngrams } <- queryGql session "get context ngrams" query
+  pure $ Right $ NormNgramsTerm <$> context_ngrams

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

@@ -29,7 +29,6 @@ here = R2.here "Gargantext.Components.Nodes.Corpus.Document"
 
 node :: R2.Leaf ( key :: String | Props )
 node = R2.leaf nodeCpt
-
 nodeCpt :: R.Component ( key :: String | Props )
 nodeCpt = here.component "node" cpt where
   cpt { listId
@@ -86,5 +85,6 @@ nodeCpt = here.component "node" cpt where
             layout
             { loaded
             , path
+            , session
             }
       }

src/Gargantext/Components/Nodes/Texts.purs

@@ -595,6 +595,7 @@ sideTextCpt = here.component "sideText" cpt where
               layout
               { loaded
               , path
+              , session
               }
         }
       ]

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

@@ -89,6 +89,7 @@ docFocusCpt = here.component "main" cpt where
               layout
               { loaded
               , path
+              , session
               , sideControlsSlot: Just $
                   H.div
                   { className: "phylo-doc-focus__header" }

src/Gargantext/Core/NgramsTable/Functions.purs

@@ -141,23 +141,29 @@ wordBoundaryReg2 = case R.regex ("(" <> wordBoundaryChars <> ")\\1") (R.global <
   Right r -> r
 
 type Cache =
-  ( pm :: Map NgramsTerm NgramsTerm
-  , pats :: Array NgramsTerm )
+  ( contextNgrams :: Set NgramsTerm
+  , pm            :: Map NgramsTerm NgramsTerm
+  , pats          :: Array NgramsTerm )
 
-computeCache :: NgramsTable -> Record Cache
-computeCache ngrams = { pm, pats }
+computeCache :: NgramsTable -> Set NgramsTerm -> Record Cache
+computeCache ngrams contextNgrams = { contextNgrams, pm, pats }
   where
     NgramsTable { ngrams_repo_elements } = ngrams
     pm = parentMap ngrams_repo_elements
 
+    contextRepoElements = Map.filterWithKey (\k _v -> Set.member k contextNgrams) ngrams_repo_elements
+
     pats :: Array NgramsTerm
     pats = A.fromFoldable $
-           foldrWithIndex (\term (NgramsRepoElement nre) acc -> Set.union acc $ Set.insert term nre.children) Set.empty ngrams_repo_elements
+           foldlWithIndex (\term acc (NgramsRepoElement nre) -> Set.union acc $ Set.insert term nre.children) Set.empty contextRepoElements
+
+    -- pats = A.fromFoldable $
+    --        foldrWithIndex (\term (NgramsRepoElement nre) acc -> Set.union acc $ Set.insert term nre.children) Set.empty ngrams_repo_elements
 
 -- TODO: while this function works well with word boundaries,
 --       it inserts too many spaces.
 highlightNgrams :: CTabNgramType -> NgramsTable -> Record Cache -> String -> Array HighlightElement
-highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) { pm, pats } input0 =
+highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) cache@{ pm, pats } input0 =
     -- trace {pats, input0, input, ixs} \_ ->
     A.fromFoldable ((\(s /\ ls)-> undb s /\ ls) <$> unsafePartial (foldl goFold ((input /\ Nil) : Nil) ixs))
   where
@@ -206,7 +212,7 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) { pm, pat
 
     goAcc :: Partial => Int -> HighlightAccumulator -> Tuple NgramsTerm Int -> HighlightAccumulator
     goAcc i acc (pat /\ lpat) =
-      case lookupRootListWithChildren pat table { pm, pats } of
+      case lookupRootListWithChildren pat table cache of
         Nothing ->
           crashWith "highlightNgrams: pattern missing from table"
         Just ne_list ->