Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Grégoire Locqueville
purescript-gargantext
Commits
60577438
Verified
Commit
60577438
authored
Jun 01, 2023
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev' into 551-dev-annotation-fix
parents
a1538c90
cff56727
Changes
7
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
83 additions
and
46 deletions
+83
-46
package.json
package.json
+1
-1
Field.purs
src/Gargantext/Components/Annotation/Field.purs
+8
-19
Menu.purs
src/Gargantext/Components/Annotation/Menu.purs
+1
-1
Layout.purs
src/Gargantext/Components/Document/Layout.purs
+4
-1
Tree.purs
src/Gargantext/Components/NgramsTable/Tree.purs
+10
-3
Home.purs
src/Gargantext/Components/Nodes/Home.purs
+44
-17
Functions.purs
src/Gargantext/Core/NgramsTable/Functions.purs
+15
-4
No files found.
package.json
View file @
60577438
{
"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
View file @
60577438
...
...
@@ -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 <$> compile
Cached
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 ::
NgramsTabl
e
->
{ pm :: Map NgramsTerm NgramsTerm, pats :: Array NgramsTerm }
Record Cach
e
->
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
View file @
60577438
...
...
@@ -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
View file @
60577438
...
...
@@ -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
View file @
60577438
...
...
@@ -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
View file @
60577438
module Gargantext.Components.Nodes.Home
( Action(..)
(
Home
Action(..)
, HomeProps
, State(..)
, Tuto(..)
...
...
@@ -18,7 +18,7 @@ module Gargantext.Components.Nodes.Home
, jumboTitle
, langLandingData
, license
, performAction
, perform
Home
Action
, 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), unSession
s)
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
Home
Action
= Documentation
| Enter
| Login
| SignUp
perform
Action ::
Action -> Effect Unit
performAction Documentation = pure unit
performAction Enter = void $ setHash "/search"
performAction Login = void $ setHash "/login"
performAction SignUp = pure unit
perform
HomeAction :: Home
Action -> Effect Unit
perform
Home
Action Documentation = pure unit
perform
Home
Action Enter = void $ setHash "/search"
perform
Home
Action Login = void $ setHash "/login"
perform
Home
Action 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
View file @
60577438
...
...
@@ -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))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment