[annotation] fix for highlighting terms where it belongs to a child

src/Gargantext/Components/Annotation/Field.purs

@@ -24,7 +24,7 @@ import Effect (Effect)
 import Gargantext.Components.Annotation.Menu (annotationMenu, AnnotationMenu)
 import Gargantext.Components.Annotation.Types (MenuType(..), ModeType(..), termClass)
 import Gargantext.Core.NgramsTable.Functions (findNgramTermList, highlightNgrams, normNgram)
-import Gargantext.Core.NgramsTable.Types (NgramsTable, NgramsTerm(..))
+import Gargantext.Core.NgramsTable.Types (HighlightElement, NgramsTable, NgramsTerm(..))
 import Gargantext.Types (CTabNgramType(..), TermList)
 import Gargantext.Utils.Reactix as R2
 import Gargantext.Utils.Selection as Sel
@@ -88,7 +88,7 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
     -- | Computed
     -- |
     let
-      wrap :: Tuple String (List (Tuple NgramsTerm TermList)) -> Record RunProps
+      wrap :: HighlightElement -> Record RunProps
       wrap (text /\ list)
         = { list
           , onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList }
@@ -134,7 +134,7 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
 compile ::
      NgramsTable
   -> Maybe String
-  -> Array (Tuple String (List (Tuple NgramsTerm TermList)))
+  -> Array HighlightElement
 compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
 
 -- Runs

src/Gargantext/Components/Annotation/Menu.purs

@@ -37,7 +37,7 @@ type AnnotationMenu =
 annotationMenu :: R2.Leaf Props
 annotationMenu = R2.leaf annotationMenuCpt
 annotationMenuCpt :: R.Component Props
-annotationMenuCpt = here.component "main" cpt where
+annotationMenuCpt = here.component "annotationMenu" cpt where
   cpt { menuRef } _ = do
     -- Render
     pure $

src/Gargantext/Core/NgramsTable/Functions.purs

@@ -8,6 +8,7 @@ import Data.Array (head)
 import Data.Array as A
 import Data.Either (Either(..))
 import Data.Foldable (foldl)
+import Data.FoldableWithIndex (foldlWithIndex)
 import Data.Lens (use, view, (^?), (^.), (?=), (%~), (%=), (.~))
 import Data.Lens.At (at)
 import Data.Lens.Common (_Just)
@@ -19,6 +20,7 @@ import Data.Map (Map)
 import Data.Map as Map
 import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isJust)
 import Data.Set (Set)
+import Data.Set as Set
 import Data.String as S
 import Data.String.Common as DSC
 import Data.String.Regex (Regex, regex, replace) as R
@@ -112,6 +114,19 @@ lookupRootList ngram (NgramsTable {ngrams_repo_elements: elts}) =
         Nothing -> Nothing
         Just (NgramsRepoElement {list}) -> Just list -- assert root == Nothing
 
+lookupRootListWithChildren :: NgramsTerm -> NgramsTable -> Map NgramsTerm NgramsTerm -> Maybe TermList
+lookupRootListWithChildren ngram table@(NgramsTable {ngrams_repo_elements: elts}) parentMap' =
+  case Map.lookup ngram elts of
+    Nothing -> -- try to find in children
+      case Map.lookup ngram parentMap' of
+        Nothing -> Nothing
+        Just parent' -> lookupRootList parent' table
+    Just (NgramsRepoElement {list, root: Nothing}) -> Just list
+    Just (NgramsRepoElement {root: Just root}) ->
+      case Map.lookup root elts of
+        Nothing -> Nothing
+        Just (NgramsRepoElement {list}) -> Just list -- assert root == Nothing
+
 wordBoundaryChars :: String
 wordBoundaryChars = "[ .,;:!?'\\{}()]"
 
@@ -138,7 +153,10 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 =
     sp x = " " <> db x <> " "
     undb = R.replace wordBoundaryReg2 "$1"
     input = spR input0
-    pats = A.fromFoldable (Map.keys elts)
+    -- pats = A.fromFoldable (Map.keys elts)
+    pats :: Array NgramsTerm
+    pats = A.fromFoldable $
+             foldlWithIndex (\term acc (NgramsRepoElement nre) -> Set.union acc $ Set.insert term nre.children) Set.empty elts
     hashStruct = SSKR.hashStruct (sp <<< ngramsTermText <$> pats)
     ixs = SSKR.indicesOfAnyHashStruct hashStruct (normNgramInternal ntype input)
 
@@ -167,9 +185,12 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 =
 
     addNgramElt ng ne_list (elt /\ elt_lists) = (elt /\ ((ng /\ ne_list) : elt_lists))
 
+    parentMap' :: Map NgramsTerm NgramsTerm
+    parentMap' = parentMap elts
+
     goAcc :: Partial => Int -> HighlightAccumulator -> Tuple NgramsTerm Int -> HighlightAccumulator
     goAcc i acc (pat /\ lpat) =
-      case lookupRootList pat table of
+      case lookupRootListWithChildren pat table parentMap' of
         Nothing ->
           crashWith "highlightNgrams: pattern missing from table"
         Just ne_list ->

src/Gargantext/Core/NgramsTable/Types.purs

@@ -13,6 +13,7 @@ import Data.Lens.Index (class Index, ix)
 import Data.Lens.Iso.Newtype (_Newtype)
 import Data.Lens.Record (prop)
 import Data.List (List)
+import Data.List as List
 import Data.List.Types (NonEmptyList(..))
 import Data.Map (Map)
 import Data.Map as Map
@@ -347,6 +348,18 @@ _NgramsRepoElement  :: Iso' NgramsRepoElement {
   }
 _NgramsRepoElement = _Newtype
 
+-- | Given a `Map NgramsTerm NgramsRepoElement` (e.g. from
+-- | `NgramsTable.ngrams_repo_elements`), produce a map of child ->
+-- | parent mappings.
+parentMap :: Map NgramsTerm NgramsRepoElement -> Map NgramsTerm NgramsTerm
+parentMap m = Map.fromFoldable rev
+  where
+    mf :: Map NgramsTerm (List NgramsTerm)
+    mf = (\(NgramsRepoElement nre) -> List.fromFoldable nre.children) <$> m
+    rev :: List (Tuple NgramsTerm NgramsTerm)
+    rev = foldlWithIndex (\term (acc :: List (Tuple NgramsTerm NgramsTerm)) children ->
+                           acc <> ((\c -> Tuple c term) <$> children)) List.Nil mf
+
 -----------------------------------------------------------------------------------
 {-
   NgramsRepoElement does not have the occurrences field.