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
8b7aae81
Commit
8b7aae81
authored
5 years ago
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[NgramsTable] annotation works now and type checks
Menu actions still need some work.
parent
59961292
No related merge requests found
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
20 additions
and
23 deletions
+20
-23
AnnotatedField.purs
src/Gargantext/Components/Annotation/AnnotatedField.purs
+17
-19
Menu.purs
src/Gargantext/Components/Annotation/Menu.purs
+3
-4
No files found.
src/Gargantext/Components/Annotation/AnnotatedField.purs
View file @
8b7aae81
...
...
@@ -37,6 +37,7 @@ type Props =
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
, text :: Maybe String
)
type MouseEvent = E.SyntheticEvent DE.MouseEvent
-- UNUSED
-- defaultProps :: Record Props
...
...
@@ -49,22 +50,26 @@ annotatedFieldComponent :: R.Component Props
annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt
where
cpt {ngrams,setTermList,text} _ = do
menu /\ setMenu <- R.useState $ \_ -> pure
(Nothing :: Maybe AnnotationMenu)
menu /\ setMenu <- R.useState $ \_ -> pure
Nothing
let wrapperProps =
{ className: "annotated-field-wrapper" }
onSelect _ Nothing event = maybeShowMenu
text setMenu setTermList
event
onSelect _ Nothing event = maybeShowMenu
setMenu setTermList ngrams
event
onSelect text' (Just list) event = do
let x = E.clientX event
y = E.clientY event
setList = setTermList text' (Just list)
setMenu $ Just {x, y, text: text', list, menuType: SetTermListItem, setList}
setMenu $ Just {x, y, list: Just list, menuType: SetTermListItem, setList}
mapCompile (Tuple t l) = {text: t, list: l, onSelect}
compiled = map mapCompile $ compile ngrams text
runs =
HTML.div { className: "annotated-field-runs" } $ map annotateRun
(compile ngrams text) onSelect
HTML.div { className: "annotated-field-runs" } $ map annotateRun
compiled
pure $ HTML.div wrapperProps [maybeAddMenu setMenu runs menu]
maybeShowMenu text setMenu setTermList event = do
maybeShowMenu setMenu setTermList ngrams event = do
s <- Sel.getSelection
case s of
Just sel -> do
...
...
@@ -73,10 +78,10 @@ maybeShowMenu text setMenu setTermList event = do
sel' -> do
let x = E.clientX event
y = E.clientY event
list = findNgram
text
sel'
list = findNgram
ngrams
sel'
setList = setTermList sel' list
E.preventDefault event
setMenu $ Just { x, y,
sel,
list, menuType: NewNgram, setList }
setMenu $ Just { x, y, list, menuType: NewNgram, setList }
Nothing -> pure unit
maybeAddMenu
...
...
@@ -87,7 +92,7 @@ maybeAddMenu
maybeAddMenu setMenu e (Just props) = annotationMenu setMenu props <> e
maybeAddMenu _ e _ = e
--compile :: NgramsTable -> Maybe String -> Array Run
compile :: NgramsTable -> Maybe String -> Array (Tuple String (Maybe TermList))
compile ngrams = maybe [] (highlightNgrams ngrams)
findNgram :: NgramsTable -> String -> Maybe TermList
...
...
@@ -98,19 +103,13 @@ findNgram (NgramsTable m) s = m ^? at s <<< _Just <<< _NgramsElement <<< _list
type Run =
( text :: String
, list :: (Maybe TermList)
--, onSelect :: a
, onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
)
annotateRun :: Record Run -> R.Element
annotateRun {text, list, onSelect} = R.createElement annotatedRunComponent { text, list, onSelect } []
type RunProps =
( text :: String
, list :: Maybe TermList
--, onSelect :: a
)
annotateRun p = R.createElement annotatedRunComponent p []
annotatedRunComponent :: R.Component Run
Props
annotatedRunComponent :: R.Component Run
annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
where
cpt { text, list: Nothing, onSelect } _ =
...
...
@@ -118,8 +117,7 @@ annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
cpt { text, list: (Just list), onSelect } _ =
HTML.span { className: className list
, onClick: mkEffectFn1 $ \e -> onSelect text (Just list) e
} [ HTML.text text ]
, onClick: mkEffectFn1 $ \e -> onSelect text (Just list) e} [ HTML.text text ]
where
className list = "annotation-run " <> termClass list
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Components/Annotation/Menu.purs
View file @
8b7aae81
...
...
@@ -20,8 +20,7 @@ import Gargantext.Utils.Selection (Selection, selectionToString)
data MenuType = NewNgram | SetTermListItem
type Props =
( sel :: Selection
, list :: Maybe TermList
( list :: Maybe TermList
, menuType :: MenuType
, setList :: TermList -> Effect Unit
)
...
...
@@ -31,9 +30,9 @@ type AnnotationMenu = { x :: Number, y :: Number | Props }
-- | An Annotation Menu is parameterised by a Maybe Termlist of the
-- | TermList the currently selected text belongs to
annotationMenu :: (Maybe AnnotationMenu -> Effect Unit) -> AnnotationMenu -> R.Element
annotationMenu setMenu { x,y,
sel,
list,menuType,setList } =
annotationMenu setMenu { x,y,list,menuType,setList } =
CM.contextMenu { x,y,setMenu } [
R.createElement annotationMenuCpt {
sel,
list,menuType,setList} []
R.createElement annotationMenuCpt {list,menuType,setList} []
]
annotationMenuCpt :: R.Component Props
...
...
This diff is collapsed.
Click to expand it.
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