Merge branch 'dev' into 213-dev-node-user

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

@@ -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 (HighlightElement, NgramsTable, NgramsTerm(..))
+import Gargantext.Core.NgramsTable.Types (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 :: HighlightElement -> Record RunProps
+      wrap :: Tuple String (List (Tuple NgramsTerm TermList)) -> 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 HighlightElement
+  -> Array (Tuple String (List (Tuple NgramsTerm TermList)))
 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 "annotationMenu" cpt where
+annotationMenuCpt = here.component "main" cpt where
   cpt { menuRef } _ = do
     -- Render
     pure $

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

@@ -8,7 +8,6 @@ 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)
@@ -20,7 +19,6 @@ 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
@@ -114,19 +112,6 @@ 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 = "[ .,;:!?'\\{}()]"
 
@@ -153,10 +138,7 @@ 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 :: Array NgramsTerm
-    pats = A.fromFoldable $
-             foldlWithIndex (\term acc (NgramsRepoElement nre) -> Set.union acc $ Set.insert term nre.children) Set.empty elts
+    pats = A.fromFoldable (Map.keys elts)
     hashStruct = SSKR.hashStruct (sp <<< ngramsTermText <$> pats)
     ixs = SSKR.indicesOfAnyHashStruct hashStruct (normNgramInternal ntype input)
 
@@ -185,12 +167,9 @@ 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 lookupRootListWithChildren pat table parentMap' of
+      case lookupRootList pat table of
         Nothing ->
           crashWith "highlightNgrams: pattern missing from table"
         Just ne_list ->

src/Gargantext/Core/NgramsTable/Types.purs

@@ -13,7 +13,6 @@ 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
@@ -348,18 +347,6 @@ _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.