Merge branch 'dev' into 551-dev-annotation-fix

package.json

 {
     "name": "Gargantext",
-    "version": "0.0.6.9.9.5.2",
+    "version": "0.0.6.9.9.5.4",
     "scripts": {
         "generate-purs-packages-nix": "./nix/generate-purs-packages.nix",
         "generate-psc-packages-nix": "./nix/generate-packages-json.bash",

src/Gargantext/Components/Annotation/Field.purs

@@ -18,7 +18,6 @@ import Data.FoldableWithIndex (foldlWithIndex, foldrWithIndex)
 import Data.List (List(..), (:))
 import Data.Map (Map)
 import Data.Maybe (Maybe(..), maybe)
-import Data.Set as Set
 import Data.String.Common (joinWith)
 import Data.Tuple (Tuple(..), snd)
 import Data.Tuple.Nested ((/\))
@@ -26,7 +25,7 @@ import DOM.Simple.Event as DE
 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.Functions (Cache, findNgramTermList, highlightNgrams, normNgram)
 import Gargantext.Core.NgramsTable.Types (HighlightElement, NgramsRepoElement(..), NgramsTable(..), NgramsTerm(..), parentMap)
 import Gargantext.Types (CTabNgramType(..), TermList)
 import Gargantext.Utils.Reactix as R2
@@ -46,6 +45,7 @@ type Props =
   , setTermList  :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
   , text         :: Maybe String
   , mode         :: ModeType
+  , cache        :: Record Cache
   )
 type MouseEvent = E.SyntheticEvent DE.MouseEvent
 
@@ -81,6 +81,7 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
       , setTermList
       , text: fieldText
       , mode
+      , cache
       } _ = do
     -- | States
     -- |
@@ -91,7 +92,7 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
     -- | Computed
     -- |
     let
-      wrap :: HighlightElement -> Record RunProps
+      wrap :: Tuple String (List (Tuple NgramsTerm TermList)) -> Record RunProps
       wrap (text /\ list)
         = { list
           , onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList }
@@ -113,7 +114,7 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
 
             H.div
             { className: "annotated-field-runs" }
-            ((\p -> annotateRun p) <$> wrap <$> compileCached ngrams fieldText)
+            ((\p -> annotateRun p) <$> wrap <$> compile cache ngrams fieldText)
 
 
           AdditionMode ->
@@ -134,24 +135,12 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
 
 -----------------------------------------------------------
 
-compileCached :: NgramsTable
-              -> Maybe String
-              -> Array HighlightElement
-compileCached ngrams = compile ngrams { pm, pats }
-  where
-    NgramsTable { ngrams_repo_elements } = ngrams
-    pm = parentMap 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
-
 compile ::
-     NgramsTable
-  -> { pm :: Map NgramsTerm NgramsTerm, pats :: Array NgramsTerm }
+     Record Cache
+  -> NgramsTable
   -> Maybe String
   -> Array HighlightElement
-compile ngrams cache = maybe [] (highlightNgrams CTabTerms ngrams cache)
+compile cache ngrams = maybe [] (highlightNgrams CTabTerms ngrams cache)
 
 -- 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 "annotationMenu" cpt where
+annotationMenuCpt = here.component "main" cpt where
   cpt { menuRef } _ = do
     -- Render
     pure $

src/Gargantext/Components/Document/Layout.purs

@@ -19,7 +19,7 @@ import Gargantext.Components.Category (ratingSimpleLoader)
 import Gargantext.Components.Document.Types (DocPath, Document(..), LoadedData, initialState)
 import Gargantext.Components.NgramsTable.AutoSync (useAutoSync)
 import Gargantext.Components.Node (NodePoly(..))
-import Gargantext.Core.NgramsTable.Functions (addNewNgramA, applyNgramsPatches, coreDispatch, findNgramRoot, setTermListA)
+import Gargantext.Core.NgramsTable.Functions (addNewNgramA, applyNgramsPatches, coreDispatch, findNgramRoot, setTermListA, computeCache)
 import Gargantext.Core.NgramsTable.Types (CoreAction(..), Versioned(..), replace)
 import Gargantext.Hooks.FirstEffect (useFirstEffect')
 import Gargantext.Utils ((?))
@@ -88,11 +88,14 @@ layoutCpt = here.component "layout" cpt where
 
       ngrams = applyNgramsPatches state' initTable
 
+      cache = computeCache ngrams
+
       annotate text = AnnotatedField.annotatedField
         { ngrams
         , setTermList
         , text
         , mode: mode'
+        , cache
         }
 
       setTermListOrAddA ngram Nothing        =

src/Gargantext/Components/NgramsTable/Tree.purs

@@ -11,6 +11,7 @@ import Data.List as L
 import Data.Maybe (Maybe(..), maybe)
 import Data.Set (Set)
 import Data.Set as Set
+import Data.Traversable (traverse_)
 import Data.Tuple.Nested ((/\))
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff_)
@@ -19,7 +20,7 @@ import Gargantext.Components.Bootstrap as B
 import Gargantext.Components.Bootstrap.Types (Variant(..))
 import Gargantext.Components.Table as Tbl
 import Gargantext.Core.NgramsTable.Functions (applyNgramsPatches, setTermListA, tablePatchHasNgrams)
-import Gargantext.Core.NgramsTable.Types (Action(..), NgramsClick, NgramsDepth, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm, _NgramsElement, _NgramsRepoElement, _children, _list, _ngrams, _occurrences, ngramsTermText, replace)
+import Gargantext.Core.NgramsTable.Types (Action(..), CoreAction, NgramsClick, NgramsDepth, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm, _NgramsElement, _NgramsRepoElement, _children, _list, _ngrams, _occurrences, ngramsTermText, replace)
 import Gargantext.Hooks.FirstEffect (useFirstEffect')
 import Gargantext.Types as GT
 import Gargantext.Utils ((?))
@@ -297,18 +298,23 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
             Nothing ->
               span ngramsStyle
 
+        termList :: GT.TermList
         termList    = ngramsElement ^. _NgramsElement <<< _list
+        ngramsStyle :: Array DOM.Props
         ngramsStyle = [termStyle termList ngramsOpacity]
         ngramsEdit { ngrams: n } = Just $ dispatch $ SetParentResetChildren (Just n) (ngramsChildren n)
+        tbl :: NgramsTable
         tbl = applyNgramsPatches { ngramsLocalPatch
                                  , ngramsStagePatch: mempty
                                  , ngramsValidPatch: mempty
                                  , ngramsVersion: 0 } ngramsTable
         getNgramsChildren' :: NgramsTerm -> Array NgramsTerm
         getNgramsChildren' n = A.fromFoldable $ ngramsChildren n
+        ngramsChildren :: NgramsTerm -> List NgramsTerm
         ngramsChildren n = tbl ^.. ix n <<< _NgramsRepoElement <<< _children <<< folded
-        ngramsClick =
-          Just <<< dispatch <<< CoreAction <<< cycleTermListItem <<< view _ngrams
+        ngramsClick :: { depth :: Int, ngrams :: NgramsTerm } -> Maybe (Effect Unit)
+        ngramsClick p = Just $ do
+          traverse_ (dispatch <<< CoreAction <<< cycleTermListItem) (A.cons p.ngrams $ getNgramsChildren' p.ngrams)
           -- ^ This is the old behavior it is nicer to use since one can
           --   rapidly change the ngram list without waiting for confirmation.
           --   However this might expose bugs. One of them can be reproduced
@@ -361,6 +367,7 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
           | ngramsTransient = 0.5
           | otherwise       = 1.0
 
+        cycleTermListItem :: NgramsTerm -> CoreAction
         cycleTermListItem n = setTermListA n (replace termList (nextTermList termList))
 
 

src/Gargantext/Components/Nodes/Home.purs

 module Gargantext.Components.Nodes.Home
-  ( Action(..)
+  ( HomeAction(..)
   , HomeProps
   , State(..)
   , Tuto(..)
@@ -18,7 +18,7 @@ module Gargantext.Components.Nodes.Home
   , jumboTitle
   , langLandingData
   , license
-  , performAction
+  , performHomeAction
   , playTutos
   , startTutos
   , summary
@@ -36,13 +36,14 @@ import Data.Newtype (class Newtype)
 import Effect (Effect)
 import Gargantext.Components.App.Store (Boxes)
 import Gargantext.Components.Bootstrap as B
+import Gargantext.Components.Bootstrap.Types (ComponentStatus(..), Elevation(..), ModalSizing(..), Position(..), TooltipPosition(..), Variant(..))
 import Gargantext.Components.Data.Landing (BlockText(..), BlockTexts(..), Button(..), LandingData(..))
 import Gargantext.Components.FolderView as FV
 import Gargantext.Components.Lang (LandingLang(..))
 import Gargantext.Components.Lang.Landing.EnUS as En
 import Gargantext.Components.Lang.Landing.FrFR as Fr
 import Gargantext.Config as Config
-import Gargantext.Sessions (Sessions)
+import Gargantext.Sessions (Session(..), Sessions, Action(Logout), unSessions)
 import Gargantext.Sessions as Sessions
 import Gargantext.Sessions.Types (Session(..), cleanBackendUrl)
 import Gargantext.Utils.Reactix as R2
@@ -51,6 +52,9 @@ import Reactix.DOM.HTML as H
 import Routing.Hash (setHash)
 import Toestand as T
 
+import Effect.Console (log)
+
+
 here :: R2.Here
 here = R2.here "Gargantext.Components.Nodes.Home"
 
@@ -61,17 +65,17 @@ derive instance Newtype State _
 initialState :: State
 initialState = State { userName: "", password: "" }
 
-data Action
+data HomeAction
   = Documentation
   | Enter
   | Login
   | SignUp
 
-performAction :: Action -> Effect Unit
-performAction Documentation = pure unit
-performAction Enter = void $ setHash "/search"
-performAction Login = void $ setHash "/login"
-performAction SignUp = pure unit
+performHomeAction :: HomeAction -> Effect Unit
+performHomeAction Documentation = pure unit
+performHomeAction Enter = void $ setHash "/search"
+performHomeAction Login = void $ setHash "/login"
+performHomeAction SignUp = pure unit
 
 langLandingData :: LandingLang -> LandingData
 langLandingData LL_FR = Fr.landingData
@@ -226,7 +230,7 @@ tutorial :: R2.Leaf TutorialProps
 tutorial = R2.leaf tutorialCpt
 tutorialCpt :: R.Component TutorialProps
 tutorialCpt = here.component "tutorial" cpt where
-  cpt { sessions } _ = do
+  cpt { boxes, sessions } _ = do
 
     pure $
 
@@ -249,6 +253,9 @@ tutorialCpt = here.component "tutorial" cpt where
         [ video x.id, H.h4 {} [ H.text x.title ], H.p  {} [ H.text x.text ] ]
       -}
 
+      onSignOutClick session = void $ Sessions.change (Logout session) boxes.sessions
+
+
       makeFolders :: Array Session -> Array R.Element
       makeFolders s = sessionToFolder <$> s
         where
@@ -266,14 +273,33 @@ tutorialCpt = here.component "tutorial" cpt where
                 B.wad
                 [ "d-flex", "align-items-center" ]
                 [
-                  B.icon
-                  { name: "user" }
-                ,
-                  B.wad_
-                  [ "virtual-space", "w-1" ]
+                  B.wad
+                  [ "text-left", "w-10/12" ]
+                  [
+                    B.icon
+                    { name: "user", className: "pr-1" }
+                  ,
+                    B.span_ $
+                    username <> "@" <> cleanBackendUrl backend
+                  ]
                 ,
-                  B.span_ $
-                  username <> "@" <> cleanBackendUrl backend
+                  B.wad
+                  [ "text-right", "w-2/12" ]
+                  [
+                    B.tooltipContainer
+                    { position: TooltipPosition Top
+                    , delayShow: 600
+                    , tooltipSlot:
+                        B.span_ "Log out"
+                    , defaultSlot:
+                        B.iconButton
+                        { name: "sign-out"
+                        , callback: \_ -> onSignOutClick session
+                        , elevation: Level2
+                        , className: "text-light"
+                        }
+                    }
+                  ]
                 ]
               ]
             ,
@@ -286,6 +312,7 @@ tutorialCpt = here.component "tutorial" cpt where
                 }
               ]
             ]
+      
 
 startTutos :: Array Tuto
 startTutos =

src/Gargantext/Core/NgramsTable/Functions.purs

@@ -114,7 +114,7 @@ lookupRootList ngram (NgramsTable {ngrams_repo_elements: elts}) =
         Nothing -> Nothing
         Just (NgramsRepoElement {list}) -> Just list -- assert root == Nothing
 
-lookupRootListWithChildren :: NgramsTerm -> NgramsTable -> Cache -> Maybe TermList
+lookupRootListWithChildren :: NgramsTerm -> NgramsTable -> Record Cache -> Maybe TermList
 lookupRootListWithChildren ngram table@(NgramsTable {ngrams_repo_elements: elts}) { pm, pats } =
   case Map.lookup ngram elts of
     Nothing -> -- try to find in children
@@ -140,12 +140,23 @@ wordBoundaryReg2 = case R.regex ("(" <> wordBoundaryChars <> ")\\1") (R.global <
   Left e  -> unsafePartial $ crashWith e
   Right r -> r
 
-type Cache = { pm :: Map NgramsTerm NgramsTerm
-             , pats :: Array NgramsTerm }
+type Cache =
+  ( pm :: Map NgramsTerm NgramsTerm
+  , pats :: Array NgramsTerm )
+
+computeCache :: NgramsTable -> Record Cache
+computeCache ngrams = { pm, pats }
+  where
+    NgramsTable { ngrams_repo_elements } = ngrams
+    pm = parentMap 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
 
 -- TODO: while this function works well with word boundaries,
 --       it inserts too many spaces.
-highlightNgrams :: CTabNgramType -> NgramsTable -> Cache -> String -> Array HighlightElement
+highlightNgrams :: CTabNgramType -> NgramsTable -> Record Cache -> String -> Array HighlightElement
 highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) { pm, pats } input0 =
     -- trace {pats, input0, input, ixs} \_ ->
     A.fromFoldable ((\(s /\ ls)-> undb s /\ ls) <$> unsafePartial (foldl goFold ((input /\ Nil) : Nil) ixs))