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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
module Gargantext.Components.NgramsTable.Components where
import Data.Lens ((^..), (^.), view)
import Data.Lens.At (at)
import Data.Lens.Fold (folded)
import Data.Lens.Index (ix)
import Data.List (null, toUnfoldable) as L
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Nullable (null, toMaybe)
import Data.Set (Set)
import Data.Set as Set
import Effect (Effect)
import FFI.Simple (delay)
import Gargantext.Components.NgramsTable.Core (Action(..), Dispatch, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm, _NgramsElement, _NgramsRepoElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace, setTermListA)
import Gargantext.Components.Table as Tbl
import Gargantext.Prelude (Unit, bind, const, discard, map, not, otherwise, pure, show, unit, ($), (+), (/=), (<<<), (<>), (==), (>), (||))
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import React.DOM (a, span, text)
import React.DOM.Props as DOM
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.NgramsTable.Components"
type SearchInputProps =
( key :: String -- to prevent refreshing & losing input
, searchQuery :: T.Box String
)
searchInput :: R2.Leaf SearchInputProps
searchInput props = R.createElement searchInputCpt props []
searchInputCpt :: R.Component SearchInputProps
searchInputCpt = here.component "searchInput" cpt
where
cpt { searchQuery } _ = do
pure $ R2.row [
H.div { className: "col-12" } [
H.div { className: "input-group" }
[ searchButton { searchQuery } []
, searchFieldInput { searchQuery } []
]
]
]
type SearchButtonProps =
( searchQuery :: T.Box String
)
searchButton :: R2.Component SearchButtonProps
searchButton = R.createElement searchButtonCpt
searchButtonCpt :: R.Component SearchButtonProps
searchButtonCpt = here.component "searchButton" cpt where
cpt { searchQuery } _ = do
searchQuery' <- T.useLive T.unequal searchQuery
pure $ H.div { className: "input-group-prepend" }
[ if searchQuery' /= ""
then
H.button { className: "btn btn-danger"
, on: {click: \_ -> T.write "" searchQuery}}
[ H.span {className: "fa fa-times"} []]
else H.span { className: "fa fa-search input-group-text" } []
]
type SearchFieldInputProps =
( searchQuery :: T.Box String
)
searchFieldInput :: R2.Component SearchFieldInputProps
searchFieldInput = R.createElement searchFieldInputCpt
searchFieldInputCpt :: R.Component SearchFieldInputProps
searchFieldInputCpt = here.component "searchFieldInput" cpt where
cpt { searchQuery } _ = do
-- searchQuery' <- T.useLive T.unequal searchQuery
pure $ H.input { className: "form-control"
-- , defaultValue: searchQuery'
, name: "search"
, on: { input: \e -> T.write (R.unsafeEventValue e) searchQuery }
, placeholder: "Search"
, type: "value"
}
type SelectionCheckboxProps =
( allNgramsSelected :: Boolean
, dispatch :: Dispatch
, ngramsSelection :: Set NgramsTerm
)
selectionCheckbox :: Record SelectionCheckboxProps -> R.Element
selectionCheckbox props = R.createElement selectionCheckboxCpt props []
selectionCheckboxCpt :: R.Component SelectionCheckboxProps
selectionCheckboxCpt = here.component "selectionCheckbox" cpt
where
cpt { allNgramsSelected, dispatch, ngramsSelection } _ = do
ref <- R.useRef null
R.useEffect' $ delay unit $ \_ -> do
let mCb = toMaybe $ R.readRef ref
case mCb of
Nothing -> pure unit
Just cb -> do
_ <- if allNgramsSelected || (Set.isEmpty ngramsSelection) then
R2.setIndeterminateCheckbox cb false
else
R2.setIndeterminateCheckbox cb true
pure unit
pure $ H.input { checked: allNgramsSelected
, className: "checkbox"
, on: { change: const $ dispatch $ ToggleSelectAll }
, ref
, type: "checkbox" }
type RenderNgramsTree =
( ngrams :: NgramsTerm
, ngramsClick :: NgramsClick
, ngramsEdit :: NgramsClick
, ngramsStyle :: Array DOM.Props
, ngramsTable :: NgramsTable
)
renderNgramsTree :: Record RenderNgramsTree -> R.Element
renderNgramsTree p = R.createElement renderNgramsTreeCpt p []
renderNgramsTreeCpt :: R.Component RenderNgramsTree
renderNgramsTreeCpt = here.component "renderNgramsTree" cpt
where
cpt { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit} _ =
pure $ H.ul {} [
H.span { className: "tree" } [
H.span { className: "righthanded" } [
tree { ngramsClick
, ngramsDepth: {ngrams, depth: 0}
, ngramsEdit
, ngramsStyle
, ngramsTable
}
]
]
]
type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
type TagProps =
( ngramsClick :: NgramsClick
, ngramsDepth :: NgramsDepth
, ngramsStyle :: Array DOM.Props
)
{- TODO refactor here
-- tag :: TagProps -> Array R.Element -> R.Element
tag tagProps =
case tagProps.ngramsClick tagProps.ngramsDepth of
Just effect ->
a (tagProps.ngramsStyle <> [DOM.onClick $ const effect])
Nothing ->
span tagProps.ngramsStyle
-}
type TreeProps =
( ngramsEdit :: NgramsClick
, ngramsTable :: NgramsTable
| TagProps
)
tree :: Record TreeProps -> R.Element
tree p = R.createElement treeCpt p []
treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt
where
cpt params@{ ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle, ngramsTable } _ =
pure $
H.li { style: {width : "100%"} }
([ H.i { className, style } [] ]
<> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
<> maybe [] edit (ngramsEdit ngramsDepth)
<> [ forest cs ]
)
where
tag =
case ngramsClick ngramsDepth of
Just effect ->
a (ngramsStyle <> [DOM.onClick $ const effect])
Nothing ->
span ngramsStyle
edit effect = [ H.text " "
, H.i { className: "fa fa-pencil"
, on: { click: const effect } } []
]
leaf = L.null cs
className = "fa fa-chevron-" <> if open then "down" else "right"
style = if leaf then {color: "#adb5bd"} else {color: ""}
open = not leaf || false {- TODO -}
cs = ngramsTable ^.. ix ngramsDepth.ngrams <<< _NgramsRepoElement <<< _children <<< folded
-- cs has a list is ok, the length is the number of direct children of an ngram which is generally < 10.
forest =
let depth = ngramsDepth.depth + 1 in
if depth > 10 then
const $ H.text "ERROR DEPTH > 10"
else
H.ul {} <<< map (\ngrams -> tree (params { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable
type RenderNgramsItem = (
dispatch :: Action -> Effect Unit
, ngrams :: NgramsTerm
, ngramsElement :: NgramsElement
, ngramsLocalPatch :: NgramsTablePatch
, ngramsParent :: Maybe NgramsTerm
, ngramsSelection :: Set NgramsTerm
, ngramsTable :: NgramsTable
)
renderNgramsItem :: R2.Component RenderNgramsItem
renderNgramsItem = R.createElement renderNgramsItemCpt
renderNgramsItemCpt :: R.Component RenderNgramsItem
renderNgramsItemCpt = here.component "renderNgramsItem" cpt
where
cpt { dispatch
, ngrams
, ngramsElement
, ngramsLocalPatch
, ngramsParent
, ngramsSelection
, ngramsTable
} _ = do
pure $ Tbl.makeRow [
H.div { className: "ngrams-selector" } [
H.span { className: "ngrams-chooser fa fa-eye-slash"
, on: { click: onClick } } []
]
, selected
, checkbox GT.MapTerm
, checkbox GT.StopTerm
, H.div {} ( if ngramsParent == Nothing
then [renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }]
else [H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } }
[ H.i { className: "fa fa-plus" } []]
, R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ]
]
)
, H.text $ show (ngramsElement ^. _NgramsElement <<< _occurrences)
]
where
ngramsDepth= {ngrams, depth: 0 }
tag =
case ngramsClick ngramsDepth of
Just effect ->
a (ngramsStyle <> [DOM.onClick $ const effect])
Nothing ->
span ngramsStyle
onClick _ = pure unit :: Effect Unit
-- onClick _ = do
-- R2.callTrigger toggleSidePanel unit
termList = ngramsElement ^. _NgramsElement <<< _list
ngramsStyle = [termStyle termList ngramsOpacity]
ngramsEdit = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams
ngramsClick
= Just <<< dispatch <<< CoreAction <<< cycleTermListItem <<< view _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
-- by clicking a multiple times on the same ngram, sometimes it stays
-- transient.
-- | ngramsTransient = const Nothing
-- | otherwise = Just <<< dispatch <<< cycleTermListItem <<< view _ngrams
selected =
H.input { checked: Set.member ngrams ngramsSelection
, className: "checkbox"
, on: { change: const $ dispatch $ ToggleSelect ngrams }
, type: "checkbox"
}
checkbox termList' =
let chkd = termList == termList'
termList'' = if chkd then GT.CandidateTerm else termList'
in
H.input { checked: chkd
, className: "checkbox"
, on: { change: const $ dispatch $ CoreAction $
setTermListA ngrams (replace termList termList'') }
, readOnly: ngramsTransient
, type: "checkbox" }
ngramsTransient = tablePatchHasNgrams ngramsLocalPatch ngrams
-- ^ TODO here we do not look at ngramsNewElems, shall we?
ngramsOpacity
| ngramsTransient = 0.5
| otherwise = 1.0
cycleTermListItem n = setTermListA n (replace termList (nextTermList termList))
termStyle :: GT.TermList -> Number -> DOM.Props
termStyle GT.MapTerm opacity = DOM.style { color: "green", opacity }
termStyle GT.StopTerm opacity = DOM.style { color: "red", opacity
, textDecoration: "line-through" }
termStyle GT.CandidateTerm opacity = DOM.style { color: "#767676", opacity }
tablePatchHasNgrams :: NgramsTablePatch -> NgramsTerm -> Boolean
tablePatchHasNgrams ngramsTablePatch ngrams =
isJust $ ngramsTablePatch.ngramsPatches ^. _PatchMap <<< at ngrams
nextTermList :: GT.TermList -> GT.TermList
nextTermList GT.MapTerm = GT.StopTerm
nextTermList GT.StopTerm = GT.CandidateTerm
nextTermList GT.CandidateTerm = GT.MapTerm