Verified Commit 56af9fe1 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

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

parents 87dbea39 cff56727
{ {
"name": "Gargantext", "name": "Gargantext",
"version": "0.0.6.9.9.5.2", "version": "0.0.6.9.9.5.4",
"scripts": { "scripts": {
"generate-purs-packages-nix": "./nix/generate-purs-packages.nix", "generate-purs-packages-nix": "./nix/generate-purs-packages.nix",
"generate-psc-packages-nix": "./nix/generate-packages-json.bash", "generate-psc-packages-nix": "./nix/generate-packages-json.bash",
......
...@@ -24,7 +24,7 @@ import Effect (Effect) ...@@ -24,7 +24,7 @@ import Effect (Effect)
import Gargantext.Components.Annotation.Menu (annotationMenu, AnnotationMenu) import Gargantext.Components.Annotation.Menu (annotationMenu, AnnotationMenu)
import Gargantext.Components.Annotation.Types (MenuType(..), ModeType(..), termClass) import Gargantext.Components.Annotation.Types (MenuType(..), ModeType(..), termClass)
import Gargantext.Core.NgramsTable.Functions (findNgramTermList, highlightNgrams, normNgram) 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.Types (CTabNgramType(..), TermList)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Selection as Sel import Gargantext.Utils.Selection as Sel
...@@ -88,7 +88,7 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where ...@@ -88,7 +88,7 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
-- | Computed -- | Computed
-- | -- |
let let
wrap :: HighlightElement -> Record RunProps wrap :: Tuple String (List (Tuple NgramsTerm TermList)) -> Record RunProps
wrap (text /\ list) wrap (text /\ list)
= { list = { list
, onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } , onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList }
...@@ -134,7 +134,7 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where ...@@ -134,7 +134,7 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
compile :: compile ::
NgramsTable NgramsTable
-> Maybe String -> Maybe String
-> Array HighlightElement -> Array (Tuple String (List (Tuple NgramsTerm TermList)))
compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams) compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- Runs -- Runs
......
...@@ -37,7 +37,7 @@ type AnnotationMenu = ...@@ -37,7 +37,7 @@ type AnnotationMenu =
annotationMenu :: R2.Leaf Props annotationMenu :: R2.Leaf Props
annotationMenu = R2.leaf annotationMenuCpt annotationMenu = R2.leaf annotationMenuCpt
annotationMenuCpt :: R.Component Props annotationMenuCpt :: R.Component Props
annotationMenuCpt = here.component "annotationMenu" cpt where annotationMenuCpt = here.component "main" cpt where
cpt { menuRef } _ = do cpt { menuRef } _ = do
-- Render -- Render
pure $ pure $
......
...@@ -11,6 +11,7 @@ import Data.List as L ...@@ -11,6 +11,7 @@ import Data.List as L
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.Traversable (traverse_)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
...@@ -19,7 +20,7 @@ import Gargantext.Components.Bootstrap as B ...@@ -19,7 +20,7 @@ import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (Variant(..)) import Gargantext.Components.Bootstrap.Types (Variant(..))
import Gargantext.Components.Table as Tbl import Gargantext.Components.Table as Tbl
import Gargantext.Core.NgramsTable.Functions (applyNgramsPatches, setTermListA, tablePatchHasNgrams) 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.Hooks.FirstEffect (useFirstEffect')
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils ((?)) import Gargantext.Utils ((?))
...@@ -297,18 +298,23 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt ...@@ -297,18 +298,23 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
Nothing -> Nothing ->
span ngramsStyle span ngramsStyle
termList :: GT.TermList
termList = ngramsElement ^. _NgramsElement <<< _list termList = ngramsElement ^. _NgramsElement <<< _list
ngramsStyle :: Array DOM.Props
ngramsStyle = [termStyle termList ngramsOpacity] ngramsStyle = [termStyle termList ngramsOpacity]
ngramsEdit { ngrams: n } = Just $ dispatch $ SetParentResetChildren (Just n) (ngramsChildren n) ngramsEdit { ngrams: n } = Just $ dispatch $ SetParentResetChildren (Just n) (ngramsChildren n)
tbl :: NgramsTable
tbl = applyNgramsPatches { ngramsLocalPatch tbl = applyNgramsPatches { ngramsLocalPatch
, ngramsStagePatch: mempty , ngramsStagePatch: mempty
, ngramsValidPatch: mempty , ngramsValidPatch: mempty
, ngramsVersion: 0 } ngramsTable , ngramsVersion: 0 } ngramsTable
getNgramsChildren' :: NgramsTerm -> Array NgramsTerm getNgramsChildren' :: NgramsTerm -> Array NgramsTerm
getNgramsChildren' n = A.fromFoldable $ ngramsChildren n getNgramsChildren' n = A.fromFoldable $ ngramsChildren n
ngramsChildren :: NgramsTerm -> List NgramsTerm
ngramsChildren n = tbl ^.. ix n <<< _NgramsRepoElement <<< _children <<< folded ngramsChildren n = tbl ^.. ix n <<< _NgramsRepoElement <<< _children <<< folded
ngramsClick = ngramsClick :: { depth :: Int, ngrams :: NgramsTerm } -> Maybe (Effect Unit)
Just <<< dispatch <<< CoreAction <<< cycleTermListItem <<< view _ngrams 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 -- ^ This is the old behavior it is nicer to use since one can
-- rapidly change the ngram list without waiting for confirmation. -- rapidly change the ngram list without waiting for confirmation.
-- However this might expose bugs. One of them can be reproduced -- However this might expose bugs. One of them can be reproduced
...@@ -361,6 +367,7 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt ...@@ -361,6 +367,7 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
| ngramsTransient = 0.5 | ngramsTransient = 0.5
| otherwise = 1.0 | otherwise = 1.0
cycleTermListItem :: NgramsTerm -> CoreAction
cycleTermListItem n = setTermListA n (replace termList (nextTermList termList)) cycleTermListItem n = setTermListA n (replace termList (nextTermList termList))
......
module Gargantext.Components.Nodes.Home module Gargantext.Components.Nodes.Home
( Action(..) ( HomeAction(..)
, HomeProps , HomeProps
, State(..) , State(..)
, Tuto(..) , Tuto(..)
...@@ -18,7 +18,7 @@ module Gargantext.Components.Nodes.Home ...@@ -18,7 +18,7 @@ module Gargantext.Components.Nodes.Home
, jumboTitle , jumboTitle
, langLandingData , langLandingData
, license , license
, performAction , performHomeAction
, playTutos , playTutos
, startTutos , startTutos
, summary , summary
...@@ -36,13 +36,14 @@ import Data.Newtype (class Newtype) ...@@ -36,13 +36,14 @@ import Data.Newtype (class Newtype)
import Effect (Effect) import Effect (Effect)
import Gargantext.Components.App.Store (Boxes) import Gargantext.Components.App.Store (Boxes)
import Gargantext.Components.Bootstrap as B 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.Data.Landing (BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.FolderView as FV import Gargantext.Components.FolderView as FV
import Gargantext.Components.Lang (LandingLang(..)) import Gargantext.Components.Lang (LandingLang(..))
import Gargantext.Components.Lang.Landing.EnUS as En import Gargantext.Components.Lang.Landing.EnUS as En
import Gargantext.Components.Lang.Landing.FrFR as Fr import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Config as Config 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 as Sessions
import Gargantext.Sessions.Types (Session(..), cleanBackendUrl) import Gargantext.Sessions.Types (Session(..), cleanBackendUrl)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -51,6 +52,9 @@ import Reactix.DOM.HTML as H ...@@ -51,6 +52,9 @@ import Reactix.DOM.HTML as H
import Routing.Hash (setHash) import Routing.Hash (setHash)
import Toestand as T import Toestand as T
import Effect.Console (log)
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Home" here = R2.here "Gargantext.Components.Nodes.Home"
...@@ -61,17 +65,17 @@ derive instance Newtype State _ ...@@ -61,17 +65,17 @@ derive instance Newtype State _
initialState :: State initialState :: State
initialState = State { userName: "", password: "" } initialState = State { userName: "", password: "" }
data Action data HomeAction
= Documentation = Documentation
| Enter | Enter
| Login | Login
| SignUp | SignUp
performAction :: Action -> Effect Unit performHomeAction :: HomeAction -> Effect Unit
performAction Documentation = pure unit performHomeAction Documentation = pure unit
performAction Enter = void $ setHash "/search" performHomeAction Enter = void $ setHash "/search"
performAction Login = void $ setHash "/login" performHomeAction Login = void $ setHash "/login"
performAction SignUp = pure unit performHomeAction SignUp = pure unit
langLandingData :: LandingLang -> LandingData langLandingData :: LandingLang -> LandingData
langLandingData LL_FR = Fr.landingData langLandingData LL_FR = Fr.landingData
...@@ -226,7 +230,7 @@ tutorial :: R2.Leaf TutorialProps ...@@ -226,7 +230,7 @@ tutorial :: R2.Leaf TutorialProps
tutorial = R2.leaf tutorialCpt tutorial = R2.leaf tutorialCpt
tutorialCpt :: R.Component TutorialProps tutorialCpt :: R.Component TutorialProps
tutorialCpt = here.component "tutorial" cpt where tutorialCpt = here.component "tutorial" cpt where
cpt { sessions } _ = do cpt { boxes, sessions } _ = do
pure $ pure $
...@@ -249,6 +253,9 @@ tutorialCpt = here.component "tutorial" cpt where ...@@ -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 ] ] [ 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 :: Array Session -> Array R.Element
makeFolders s = sessionToFolder <$> s makeFolders s = sessionToFolder <$> s
where where
...@@ -265,16 +272,35 @@ tutorialCpt = here.component "tutorial" cpt where ...@@ -265,16 +272,35 @@ tutorialCpt = here.component "tutorial" cpt where
[ [
B.wad B.wad
[ "d-flex", "align-items-center" ] [ "d-flex", "align-items-center" ]
[
B.wad
[ "text-left", "w-10/12" ]
[ [
B.icon B.icon
{ name: "user" } { name: "user", className: "pr-1" }
,
B.wad_
[ "virtual-space", "w-1" ]
, ,
B.span_ $ B.span_ $
username <> "@" <> cleanBackendUrl backend 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"
}
}
]
]
] ]
, ,
H.div H.div
...@@ -287,6 +313,7 @@ tutorialCpt = here.component "tutorial" cpt where ...@@ -287,6 +313,7 @@ tutorialCpt = here.component "tutorial" cpt where
] ]
] ]
startTutos :: Array Tuto startTutos :: Array Tuto
startTutos = startTutos =
[ Tuto { title: "The tree to manage your data" [ Tuto { title: "The tree to manage your data"
......
...@@ -8,7 +8,6 @@ import Data.Array (head) ...@@ -8,7 +8,6 @@ import Data.Array (head)
import Data.Array as A import Data.Array as A
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Foldable (foldl) import Data.Foldable (foldl)
import Data.FoldableWithIndex (foldlWithIndex)
import Data.Lens (use, view, (^?), (^.), (?=), (%~), (%=), (.~)) import Data.Lens (use, view, (^?), (^.), (?=), (%~), (%=), (.~))
import Data.Lens.At (at) import Data.Lens.At (at)
import Data.Lens.Common (_Just) import Data.Lens.Common (_Just)
...@@ -20,7 +19,6 @@ import Data.Map (Map) ...@@ -20,7 +19,6 @@ import Data.Map (Map)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isJust) import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isJust)
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set
import Data.String as S import Data.String as S
import Data.String.Common as DSC import Data.String.Common as DSC
import Data.String.Regex (Regex, regex, replace) as R import Data.String.Regex (Regex, regex, replace) as R
...@@ -114,19 +112,6 @@ lookupRootList ngram (NgramsTable {ngrams_repo_elements: elts}) = ...@@ -114,19 +112,6 @@ lookupRootList ngram (NgramsTable {ngrams_repo_elements: elts}) =
Nothing -> Nothing Nothing -> Nothing
Just (NgramsRepoElement {list}) -> Just list -- assert root == 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 :: String
wordBoundaryChars = "[ .,;:!?'\\{}()]" wordBoundaryChars = "[ .,;:!?'\\{}()]"
...@@ -153,10 +138,7 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 = ...@@ -153,10 +138,7 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 =
sp x = " " <> db x <> " " sp x = " " <> db x <> " "
undb = R.replace wordBoundaryReg2 "$1" undb = R.replace wordBoundaryReg2 "$1"
input = spR input0 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) hashStruct = SSKR.hashStruct (sp <<< ngramsTermText <$> pats)
ixs = SSKR.indicesOfAnyHashStruct hashStruct (normNgramInternal ntype input) ixs = SSKR.indicesOfAnyHashStruct hashStruct (normNgramInternal ntype input)
...@@ -185,12 +167,9 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 = ...@@ -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)) 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 :: Partial => Int -> HighlightAccumulator -> Tuple NgramsTerm Int -> HighlightAccumulator
goAcc i acc (pat /\ lpat) = goAcc i acc (pat /\ lpat) =
case lookupRootListWithChildren pat table parentMap' of case lookupRootList pat table of
Nothing -> Nothing ->
crashWith "highlightNgrams: pattern missing from table" crashWith "highlightNgrams: pattern missing from table"
Just ne_list -> Just ne_list ->
......
...@@ -13,7 +13,6 @@ import Data.Lens.Index (class Index, ix) ...@@ -13,7 +13,6 @@ import Data.Lens.Index (class Index, ix)
import Data.Lens.Iso.Newtype (_Newtype) import Data.Lens.Iso.Newtype (_Newtype)
import Data.Lens.Record (prop) import Data.Lens.Record (prop)
import Data.List (List) import Data.List (List)
import Data.List as List
import Data.List.Types (NonEmptyList(..)) import Data.List.Types (NonEmptyList(..))
import Data.Map (Map) import Data.Map (Map)
import Data.Map as Map import Data.Map as Map
...@@ -348,18 +347,6 @@ _NgramsRepoElement :: Iso' NgramsRepoElement { ...@@ -348,18 +347,6 @@ _NgramsRepoElement :: Iso' NgramsRepoElement {
} }
_NgramsRepoElement = _Newtype _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. NgramsRepoElement does not have the occurrences field.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment