1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
-- | The AnnotatedField Component is for colouring ngrams that appear in a text
-- |
-- | Given an array of ngrams and a text, it:
-- |
-- | 1. Searches the text for the ngrams
-- | 2. Renders each the resulting runs according to the Maybe TermList they appear in
-- |
-- | Notes:
-- |
-- | 1. We must only re-search the text when the ngrams change for performance
-- | 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 Effect ( Effect )
import Effect.Uncurried ( mkEffectFn1 )
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 )
import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) )
import Gargantext.Utils.Selection as Sel
type Props =
( ngrams :: NgramsTable
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
, text :: Maybe String
)
type MouseEvent = E.SyntheticEvent DE.MouseEvent
-- UNUSED
-- defaultProps :: Record Props
-- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit }
annotatedField :: Record Props -> R.Element
annotatedField p = R.createElement annotatedFieldComponent p []
annotatedFieldComponent :: R.Component Props
annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt
where
cpt {ngrams,setTermList,text} _ = do
mMenu@(_ /\ setMenu) <- R.useState $ const Nothing
let wrapperProps =
{ className: "annotated-field-wrapper" }
onSelect text' Nothing event = do
log2 "[onSelect] text'" text'
maybeShowMenu setMenu setTermList ngrams event
onSelect text' (Just list) event = do
log2 "[onSelect] text'" text'
log2 "[onSelect] list" list
let x = E.clientX event
y = E.clientY event
setList t = do
setTermList (normNgram CTabTerms text') (Just list) t
setMenu (const Nothing)
setMenu (const $ 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 compiled
pure $ HTML.div wrapperProps [maybeAddMenu mMenu runs]
-- forall e. IsMouseEvent e => R2.Setter (Maybe AnnotationMenu) -> R2.Setter ? -> ? -> e -> Effect Unit
maybeShowMenu setMenu setTermList ngrams event = do
s <- Sel.getSelection
case s of
Just sel -> do
case Sel.selectionToString sel of
"" -> pure unit
sel' -> do
let x = E.clientX event
y = E.clientY event
n = normNgram CTabTerms sel'
list = findNgramTermList ngrams n
setList t = do
setTermList n list t
setMenu (const Nothing)
E.preventDefault event
range <- Sel.getRange sel 0
log2 "[maybeShowMenu] selection range" $ Sel.rangeToTuple range
setMenu (const $ Just { x, y, list, menuType: NewNgram, setList })
Nothing -> pure unit
maybeAddMenu
:: R.State (Maybe AnnotationMenu)
-> R.Element
-> R.Element
maybeAddMenu (Just props /\ setMenu) e = annotationMenu setMenu props <> e
maybeAddMenu _ e = e
compile :: NgramsTable -> Maybe String -> Array (Tuple String (Maybe TermList))
compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- Runs
type Run =
( text :: String
, list :: (Maybe TermList)
, onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
)
annotateRun :: Record Run -> R.Element
annotateRun p = R.createElement annotatedRunComponent p []
annotatedRunComponent :: R.Component Run
annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
where
cpt { text, list: Nothing, onSelect } _ =
HTML.span { onMouseUp: mkEffectFn1 $ \e -> onSelect text Nothing e } [ HTML.text text ]
cpt { text, list: (Just list), onSelect } _ =
HTML.span { className: className list
, onClick: mkEffectFn1 $ \e -> onSelect text (Just list) e} [ HTML.text text ]
where
className list' = "annotation-run bg-" <> termBootstrapClass list'