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
f1619d14
Commit
f1619d14
authored
Sep 16, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[annotation] some attempts to fix annotation menu
parent
5c8c3efa
Changes
2
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
50 additions
and
14 deletions
+50
-14
AnnotatedField.purs
src/Gargantext/Components/Annotation/AnnotatedField.purs
+47
-12
Menu.purs
src/Gargantext/Components/Annotation/Menu.purs
+3
-2
No files found.
src/Gargantext/Components/Annotation/AnnotatedField.purs
View file @
f1619d14
...
@@ -12,10 +12,10 @@
...
@@ -12,10 +12,10 @@
module Gargantext.Components.Annotation.AnnotatedField where
module Gargantext.Components.Annotation.AnnotatedField where
import Prelude
import Prelude
import Data.Maybe ( Maybe(..), maybe )
import Data.Maybe ( Maybe(..), maybe
, isJust, isNothing
)
import Data.Tuple ( Tuple(..) )
import Data.Tuple ( Tuple(..) )
import Data.Tuple.Nested ( (/\) )
import Data.Tuple.Nested ( (/\) )
import DOM.Simple.Console (log2)
import DOM.Simple.Console (log
, log
2)
import DOM.Simple.Event as DE
import DOM.Simple.Event as DE
import Effect ( Effect )
import Effect ( Effect )
import Effect.Uncurried ( mkEffectFn1 )
import Effect.Uncurried ( mkEffectFn1 )
...
@@ -30,6 +30,7 @@ import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, M
...
@@ -30,6 +30,7 @@ import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, M
import Gargantext.Utils.Selection as Sel
import Gargantext.Utils.Selection as Sel
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Annotation.AnnotatedField"
thisModule = "Gargantext.Components.Annotation.AnnotatedField"
type Props =
type Props =
...
@@ -50,13 +51,16 @@ annotatedFieldComponent :: R.Component Props
...
@@ -50,13 +51,16 @@ annotatedFieldComponent :: R.Component Props
annotatedFieldComponent = R2.hooksComponent thisModule "annotatedField" cpt
annotatedFieldComponent = R2.hooksComponent thisModule "annotatedField" cpt
where
where
cpt {ngrams,setTermList,text} _ = do
cpt {ngrams,setTermList,text} _ = do
mMenu@(_ /\ setMenu) <- R.useState $ const Nothing
mMenu@(_ /\ setMenu) <- R.useState' Nothing
menuRef <- R.useRef Nothing
let wrapperProps =
let wrapperProps =
{ className: "annotated-field-wrapper" }
{ className: "annotated-field-wrapper" }
onSelect text' Nothing event = do
onSelect text' Nothing event = do
log2 "[onSelect] text'" text'
log2 "[onSelect] text'" text'
maybeShowMenu setMenu setTermList ngrams event
maybeShowMenu setMenu
menuRef
setTermList ngrams event
onSelect text' (Just list) event = do
onSelect text' (Just list) event = do
log2 "[onSelect] text'" text'
log2 "[onSelect] text'" text'
log2 "[onSelect] list" list
log2 "[onSelect] list" list
...
@@ -64,19 +68,47 @@ annotatedFieldComponent = R2.hooksComponent thisModule "annotatedField" cpt
...
@@ -64,19 +68,47 @@ annotatedFieldComponent = R2.hooksComponent thisModule "annotatedField" cpt
y = E.clientY event
y = E.clientY event
setList t = do
setList t = do
setTermList (normNgram CTabTerms text') (Just list) t
setTermList (normNgram CTabTerms text') (Just list) t
setMenu (const Nothing)
--setMenu (const Nothing)
setMenu (const $ Just {x, y, list: Just list, menuType: SetTermListItem, setList} )
R.setRef menuRef Nothing
menu = Just {x, y, list: Just list, menuType: SetTermListItem, setList}
--setMenu (const $ menu)
R.setRef menuRef menu
mapCompile (Tuple t l) = {text: t, list: l, onSelect}
mapCompile (Tuple t l) = {text: t, list: l, onSelect}
compiled = map mapCompile $ compile ngrams text
compiled = map mapCompile $ compile ngrams text
runs =
runs =
HTML.div { className: "annotated-field-runs" } $ map annotateRun compiled
HTML.div { className: "annotated-field-runs" } $ map annotateRun compiled
pure $ HTML.div wrapperProps [maybeAddMenu mMenu runs]
--pure $ HTML.div wrapperProps [maybeAddMenu mMenu runs]
pure $ HTML.div wrapperProps [ addMenu { menuRef }, runs ]
type AddMenuProps = (
menuRef :: R.Ref (Maybe AnnotationMenu)
)
addMenu :: Record AddMenuProps -> R.Element
addMenu p = R.createElement addMenuCpt p []
addMenuCpt :: R.Component AddMenuProps
addMenuCpt = R2.hooksComponent thisModule "addMenu" cpt
where
cpt { menuRef } _ = do
(mMenu /\ setmMenu) <- R.useState' (Nothing :: Maybe AnnotationMenu)
R.useEffect' $ do
let m = R.readRef menuRef
log2 "[addMenu] menuRef" m
log2 "[addMenu] mMenu" mMenu
setmMenu $ const m
pure $ case mMenu of
Nothing -> HTML.div {} []
Just menu -> annotationMenu setmMenu menu
-- forall e. IsMouseEvent e => R2.Setter (Maybe AnnotationMenu) -> R2.Setter ? -> ? -> e -> Effect Unit
-- forall e. IsMouseEvent e => R2.Setter (Maybe AnnotationMenu) -> R2.Setter ? -> ? -> e -> Effect Unit
maybeShowMenu setMenu setTermList ngrams event = do
maybeShowMenu setMenu
menuRef
setTermList ngrams event = do
s <- Sel.getSelection
s <- Sel.getSelection
case s of
case s of
Just sel -> do
Just sel -> do
...
@@ -89,11 +121,14 @@ maybeShowMenu setMenu setTermList ngrams event = do
...
@@ -89,11 +121,14 @@ maybeShowMenu setMenu setTermList ngrams event = do
list = findNgramTermList ngrams n
list = findNgramTermList ngrams n
setList t = do
setList t = do
setTermList n list t
setTermList n list t
setMenu (const Nothing)
--setMenu (const Nothing)
R.setRef menuRef Nothing
E.preventDefault event
E.preventDefault event
range <- Sel.getRange sel 0
range <- Sel.getRange sel 0
log2 "[maybeShowMenu] selection range" $ Sel.rangeToTuple range
log2 "[maybeShowMenu] selection range" $ Sel.rangeToTuple range
setMenu (const $ Just { x, y, list, menuType: NewNgram, setList })
let menu = Just { x, y, list, menuType: NewNgram, setList }
--setMenu (const $ menu)
R.setRef menuRef menu
Nothing -> pure unit
Nothing -> pure unit
maybeAddMenu
maybeAddMenu
...
@@ -109,9 +144,9 @@ compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
...
@@ -109,9 +144,9 @@ compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- Runs
-- Runs
type Run =
type Run =
( text :: String
( list :: (Maybe TermList)
, list :: (Maybe TermList)
, onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
, onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
, text :: String
)
)
annotateRun :: Record Run -> R.Element
annotateRun :: Record Run -> R.Element
...
...
src/Gargantext/Components/Annotation/Menu.purs
View file @
f1619d14
...
@@ -16,6 +16,7 @@ import Gargantext.Components.Annotation.Utils (termBootstrapClass)
...
@@ -16,6 +16,7 @@ import Gargantext.Components.Annotation.Utils (termBootstrapClass)
import Gargantext.Components.ContextMenu.ContextMenu as CM
import Gargantext.Components.ContextMenu.ContextMenu as CM
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Annotation.Menu"
thisModule = "Gargantext.Components.Annotation.Menu"
data MenuType = NewNgram | SetTermListItem
data MenuType = NewNgram | SetTermListItem
...
@@ -48,8 +49,8 @@ addToList {list: Just t'} t
...
@@ -48,8 +49,8 @@ addToList {list: Just t'} t
| t == t' = Nothing
| t == t' = Nothing
addToList {menuType, setList} t = Just $ CM.contextMenuItem [ link ]
addToList {menuType, setList} t = Just $ CM.contextMenuItem [ link ]
where
where
link = HTML.a { on
Click: click
, className: className } [ HTML.text (label menuType) ]
link = HTML.a { on
: { click }
, className: className } [ HTML.text (label menuType) ]
label NewNgram = "Add to " <> termListName t
label NewNgram = "Add to " <> termListName t
label SetTermListItem = "Change to " <> termListName t
label SetTermListItem = "Change to " <> termListName t
className = "list-group-item list-group-item-" <> (termBootstrapClass t)
className = "list-group-item list-group-item-" <> (termBootstrapClass t)
click
= mkEffectFn1 $ \_ ->
setList t
click
_ =
setList t
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