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
141
Issues
141
List
Board
Labels
Milestones
Merge Requests
3
Merge Requests
3
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
gargantext
purescript-gargantext
Commits
ef07fc0b
Commit
ef07fc0b
authored
Feb 05, 2021
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[annotation] refactoring of AnnotatedField.purs
parent
13f92554
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
67 additions
and
53 deletions
+67
-53
AnnotatedField.purs
src/Gargantext/Components/Annotation/AnnotatedField.purs
+67
-53
No files found.
src/Gargantext/Components/Annotation/AnnotatedField.purs
View file @
ef07fc0b
...
...
@@ -11,22 +11,23 @@
-- | 2. We will need a more ambitious search algorithm for skipgrams.
module Gargantext.Components.Annotation.AnnotatedField where
import Prelude
import Data.Maybe ( Maybe(..), maybe )
import Data.Tuple ( Tuple )
import Data.Tuple.Nested ( (/\) )
--import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE
import Data.Tuple ( Tuple )
import Data.Tuple.Nested ( (/\) )
import Effect ( Effect )
import Reactix as R
import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E
import Gargantext.Types (CTabNgramType(..), TermList)
import Gargantext.Components.Annotation.Utils ( termBootstrapClass, termClass )
import Gargantext.Components.NgramsTable.Core
import Gargantext.Components.Annotation.Menu ( annotationMenu, MenuType(..) )
import Gargantext.Prelude
import Gargantext.Components.Annotation.Menu ( annotationMenu, AnnotationMenu, MenuType(..) )
import Gargantext.Components.Annotation.Utils (termClass)
import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
import Gargantext.Utils.Selection as Sel
import Gargantext.Types (CTabNgramType(..), TermList)
thisModule :: String
thisModule = "Gargantext.Components.Annotation.AnnotatedField"
...
...
@@ -48,27 +49,65 @@ annotatedField p = R.createElement annotatedFieldComponent p []
annotatedFieldComponent :: R.Component Props
annotatedFieldComponent = R.hooksComponentWithModule thisModule "annotatedField" cpt
where
cpt {ngrams,
setTermList,
text: fieldText} _ = do
cpt {ngrams,
setTermList,
text: fieldText} _ = do
(_ /\ setRedrawMenu) <- R.useState' false
menuRef <- R.useRef
Nothing
menuRef <- R.useRef
(Nothing :: Maybe AnnotationMenu)
let wrapperProps = { className: "annotated-field-wrapper" }
redrawMenu = setRedrawMenu not
wrap (text /\ list) = { list
, onSelect: onAnnotationSelect { menuRef, ngrams, setRedrawMenu, setTermList }
, text }
hideMenu = do
R.setRef menuRef Nothing
redrawMenu
pure $ HTML.div wrapperProps
[ maybe (HTML.div {} []) annotationMenu $ R.readRef menuRef
, HTML.div { className: "annotated-field-runs" }
$ annotateRun
<$> wrap
<$> compile ngrams fieldText
]
compile :: NgramsTable -> Maybe String -> Array (Tuple String (Maybe TermList))
compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- Runs
showMenu { event, text, getList, menuType } = do
onAnnotationSelect { menuRef, ngrams, setRedrawMenu, setTermList } text mList event =
case mList of
Just list ->
showMenu { event
, getList: const (Just list)
, menuRef
, menuType: SetTermListItem
, setRedrawMenu
, setTermList
, text }
Nothing -> do
s <- Sel.getSelection
case s of
Just sel -> do
case Sel.selectionToString sel of
"" -> hideMenu { menuRef, setRedrawMenu }
sel' -> do
showMenu { event
, getList: findNgramTermList ngrams
, menuRef
, menuType: NewNgram
, setRedrawMenu
, setTermList
, text: sel' }
Nothing -> hideMenu { menuRef, setRedrawMenu }
showMenu { event, getList, menuRef, menuType, setRedrawMenu, setTermList, text } = do
let x = E.clientX event
y = E.clientY event
n = normNgram CTabTerms text
list = getList n
redrawMenu = setRedrawMenu not
setList t = do
setTermList n list t
hideMenu
hideMenu { menuRef, setRedrawMenu }
E.preventDefault event
--range <- Sel.getRange sel 0
--log2 "[showMenu] selection range" $ Sel.rangeToTuple range
...
...
@@ -77,41 +116,16 @@ annotatedFieldComponent = R.hooksComponentWithModule thisModule "annotatedField"
, y
, list
, menuType
, onClose: hideMenu
, onClose: hideMenu { menuRef, setRedrawMenu }
, setList
}
R.setRef menuRef menu
redrawMenu
onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
onSelect text mList event =
case mList of
Just list ->
showMenu { event, text, getList: const (Just list), menuType: SetTermListItem }
Nothing -> do
s <- Sel.getSelection
case s of
Just sel -> do
case Sel.selectionToString sel of
"" -> hideMenu
sel' -> do
showMenu { event, text: sel', getList: findNgramTermList ngrams, menuType: NewNgram }
Nothing -> hideMenu
wrap (text /\ list) = {text, list, onSelect}
pure $ HTML.div wrapperProps
[ maybe (HTML.div {} []) annotationMenu $ R.readRef menuRef
, HTML.div { className: "annotated-field-runs" }
$ annotateRun
<$> wrap
<$> compile ngrams fieldText
]
compile :: NgramsTable -> Maybe String -> Array (Tuple String (Maybe TermList))
compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- Runs
hideMenu { menuRef, setRedrawMenu } = do
let redrawMenu = setRedrawMenu not
R.setRef menuRef Nothing
redrawMenu
type Run =
( list :: (Maybe TermList)
...
...
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