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
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
-- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.DocsTable where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>), encodeJson)
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Lens ((^.))
import Data.Lens.At (at)
import Data.Lens.Record (prop)
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isJust)
import Data.Ord.Down (Down(..))
import Data.Sequence as Seq
import Data.Set (Set)
import Data.Set as Set
import Data.String as Str
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Event as DE
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Components.Category
import Gargantext.Components.Table as T
import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoaderWithCacheAPI, HashedResponse(..))
import Gargantext.Utils.Seq (sortWith) as Seq
import Gargantext.Utils.Reactix as R2
import Gargantext.Routes as Routes
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, sessionId, get, delete, put)
import Gargantext.Types (NodeType(..), OrderBy(..), TableResult, TabType, showTabType')
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
thisModule = "Gargantext.Components.DocsTable"
------------------------------------------------------------------------
type TotalRecords = Int
type LayoutProps =
( nodeId :: Int
, totalRecords :: Int
, chart :: R.Element
, tabType :: TabType
, listId :: Int
, corpusId :: Maybe Int
, showSearch :: Boolean
, frontends :: Frontends
, session :: Session )
-- ^ tabType is not ideal here since it is too much entangled with tabs and
-- ngramtable. Let's see how this evolves. )
type PageLayoutProps =
( nodeId :: Int
, totalRecords :: Int
, tabType :: TabType
, listId :: Int
, corpusId :: Maybe Int
, query :: Query
, session :: Session
, frontends :: Frontends
, params :: T.Params )
type LocalCategories = Map Int Category
type Query = String
_documentIdsDeleted = prop (SProxy :: SProxy "documentIdsDeleted")
_localCategories = prop (SProxy :: SProxy "localCategories")
data Action
= MarkCategory Int Category
newtype DocumentsView
= DocumentsView
{ _id :: Int
, category :: Category
, date :: Int
, ngramCount :: Int
, source :: String
, title :: String
, url :: String
}
{-
derive instance genericDocumentsView :: Generic DocumentsView _
instance showDocumentsView :: Show DocumentsView where
show = genericShow
instance decodeJsonSearchType :: Argonaut.DecodeJson SearchType where
decodeJson = genericSumDecodeJson
instance encodeJsonSearchType :: Argonaut.EncodeJson SearchType where
encodeJson = genericSumEncodeJson
-}
instance decodeDocumentsView :: DecodeJson DocumentsView where
decodeJson json = do
obj <- decodeJson json
_id <- obj .: "id"
category <- obj .: "category"
date <- obj .: "date"
ngramCount <- obj .: "ngramCount"
source <- obj .: "source"
title <- obj .: "title"
url <- obj .: "url"
pure $ DocumentsView { _id, category, date, ngramCount, source, title, url }
instance encodeDocumentsView :: EncodeJson DocumentsView where
encodeJson (DocumentsView dv) =
"id" := dv._id
~> "category" := dv.category
~> "date" := dv.date
~> "ngramCount" := dv.ngramCount
~> "source" := dv.source
~> "title" := dv.title
~> "url" := dv.url
~> jsonEmptyObject
newtype Response = Response
{ cid :: Int
, hyperdata :: Hyperdata
, category :: Category
, ngramCount :: Int
, title :: String
}
newtype Hyperdata = Hyperdata
{ title :: String
, source :: String
, pub_year :: Int
}
instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do
obj <- decodeJson json
title <- obj .: "title"
source <- obj .: "source"
pub_year <- obj .: "publication_year"
pure $ Hyperdata { title,source, pub_year}
instance decodeResponse :: DecodeJson Response where
decodeJson json = do
obj <- decodeJson json
cid <- obj .: "id"
category <- obj .: "category"
ngramCount <- obj .: "id"
title <- obj .: "title"
hyperdata <- obj .: "hyperdata"
pure $ Response { cid, title, category: decodeCategory category, ngramCount, hyperdata }
docViewLayout :: Record LayoutProps -> R.Element
docViewLayout props = R.createElement docViewLayoutCpt props []
docViewLayoutCpt :: R.Component LayoutProps
docViewLayoutCpt = R.hooksComponentWithModule thisModule "docViewLayout" cpt
where
cpt layout _children = do
query <- R.useState' ""
let params = T.initialParams
pure $ docView {query, params, layout}
type Props = (
layout :: Record LayoutProps
, params :: T.Params
, query :: R.State Query
)
docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props []
docViewCpt :: R.Component Props
docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt where
cpt { query, params
, layout: { frontends, session, nodeId, tabType, listId
, corpusId, totalRecords, chart, showSearch } } _ = do
pure $ H.div {className: "container1"}
[ R2.row
[ chart
, if showSearch then searchBar query else H.div {} []
, H.div {className: "col-md-12"}
[ pageLayout { corpusId
, frontends
, listId
, nodeId
, params
, query: fst query
, session
, tabType
, totalRecords
} ] ] ]
-- onClickTrashAll nodeId _ = do
-- launchAff $ deleteAllDocuments p.session nodeId
{-, H.div {className: "col-md-1 col-md-offset-11"}
[ pageLayout p.session params {nodeId, totalRecords, tabType, listId, corpusId, query: fst query} ]
, H.div {className: "col-md-1 col-md-offset-11"}
[ H.button { className: "btn"
, style: {backgroundColor: "peru", color : "white", border : "white"}
, on: { click: onClickTrashAll nodeId } }
[ H.i {className: "glyphitem glyphicon glyphicon-trash"} []
, H.text "Trash all"
]
]
-}
searchBar :: R.State Query -> R.Element
searchBar (query /\ setQuery) = R.createElement el {} []
where
el = R.hooksComponentWithModule thisModule "SearchBar" cpt
cpt {} _children = do
queryText <- R.useState' query
pure $ H.div {className: "row"}
[ H.div {className: "col col-md-3"} []
, H.div {className: "col col-md-1"} [if query /= "" then clearButton else H.div {} []]
, H.div {className: "col col-md-3 form-group"}
[ H.input { type: "text"
, className: "form-control"
, on: {change: onSearchChange queryText, keyUp: onSearchKeyup queryText}
, placeholder: query
, defaultValue: query}
]
, H.div {className: "col col-md-1"} [searchButton queryText]
]
onSearchChange :: forall e. R.State Query -> e -> Effect Unit
onSearchChange (_ /\ setQueryText) = \e ->
setQueryText $ const $ R.unsafeEventValue e
onSearchKeyup :: R.State Query -> DE.KeyboardEvent -> Effect Unit
onSearchKeyup (queryText /\ _) = \e ->
if DE.key e == "Enter" then
setQuery $ const queryText
else
pure $ unit
searchButton (queryText /\ _) =
H.button { type: "submit"
, className: "btn btn-default"
, on: {click: \e -> setQuery $ const queryText}}
[ H.span {className: "glyphicon glyphicon-search"} [] ]
clearButton =
H.button { className: "btn btn-danger"
, on: {click: \e -> setQuery $ const ""}}
[ H.span {className: "glyphicon glyphicon-remove"} [] ]
mock :: Boolean
mock = false
type PageParams =
{ nodeId :: Int
, listId :: Int
, corpusId :: Maybe Int
, tabType :: TabType
, query :: Query
, params :: T.Params}
getPageHash :: Session -> PageParams -> Aff String
getPageHash session { corpusId, listId, nodeId, query, tabType } = do
(get session $ tableHashRoute nodeId tabType) :: Aff String
convOrderBy (Just (T.ASC (T.ColumnName "Date"))) = Just DateAsc
convOrderBy (Just (T.DESC (T.ColumnName "Date"))) = Just DateDesc
convOrderBy (Just (T.ASC (T.ColumnName "Title"))) = Just TitleAsc
convOrderBy (Just (T.DESC (T.ColumnName "Title"))) = Just TitleDesc
convOrderBy (Just (T.ASC (T.ColumnName "Source"))) = Just SourceAsc
convOrderBy (Just (T.DESC (T.ColumnName "Source"))) = Just SourceDesc
convOrderBy _ = Nothing
res2corpus :: Response -> DocumentsView
res2corpus (Response r) =
DocumentsView { _id : r.cid
, url : ""
, date : (\(Hyperdata hr) -> hr.pub_year) r.hyperdata
, title : (\(Hyperdata hr) -> hr.title) r.hyperdata
, source : (\(Hyperdata hr) -> hr.source) r.hyperdata
, category : r.category
, ngramCount : r.ngramCount
}
filterDocs :: Query -> Array Response -> Array Response
filterDocs query docs = A.filter filterFunc docs
where
filterFunc :: Response -> Boolean
filterFunc (Response { hyperdata: Hyperdata { title } }) =
isJust $ Str.indexOf (Str.Pattern $ Str.toLower query) $ Str.toLower title
pageLayout :: Record PageLayoutProps -> R.Element
pageLayout props = R.createElement pageLayoutCpt props []
pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt where
cpt props@{ corpusId, frontends, listId, nodeId, params, query, session, tabType } _ =
useLoaderWithCacheAPI {
cacheEndpoint: getPageHash session
, handleResponse
, mkRequest
, path
, renderer: paint
}
where
path = { corpusId, listId, nodeId, params, query, tabType }
paint (Tuple count docs) = page params (props { totalRecords = count }) docs
mkRequest :: PageParams -> GUC.Request
mkRequest p@{ listId, nodeId, tabType } =
GUC.makeGetRequest session $ tableRoute nodeId tabType listId
handleResponse :: HashedResponse (TableResult Response) -> Tuple Int (Array DocumentsView)
handleResponse (HashedResponse { hash, value: res }) = ret
where
docs = res2corpus <$> filterDocs query res.docs
ret = if mock then
--Tuple 0 (take limit $ drop offset sampleData)
Tuple 0 sampleData
else
Tuple (A.length docs) docs
type PageProps = (
documents :: Array DocumentsView
, layout :: Record PageLayoutProps
, params :: T.Params
)
page :: T.Params -> Record PageLayoutProps -> Array DocumentsView -> R.Element
page params layout documents = R.createElement pageCpt { documents, layout, params } []
pageCpt :: R.Component PageProps
pageCpt = R.hooksComponentWithModule thisModule "pageCpt" cpt where
cpt { documents, layout, params } _ = do
paramsS <- R.useState' params
pure $ pagePaint { documents, layout, params: paramsS }
type PagePaintProps = (
documents :: Array DocumentsView
, layout :: Record PageLayoutProps
, params :: R.State T.Params
)
pagePaint :: Record PagePaintProps -> R.Element
pagePaint props = R.createElement pagePaintCpt props []
pagePaintCpt :: R.Component PagePaintProps
pagePaintCpt = R.hooksComponentWithModule thisModule "pagePaintCpt" cpt where
cpt { layout: { corpusId, frontends, listId, nodeId, session, totalRecords }, documents, params } _ = do
localCategories <- R.useState' (mempty :: LocalCategories)
pure $ T.table
{ colNames
, container: T.defaultContainer { title: "Documents" }
, params
, rows: Seq.fromFoldable $ rows localCategories
, totalRecords
, wrapColElts
}
where
sid = sessionId session
gi Favorite = "glyphicon glyphicon-star"
gi _ = "glyphicon glyphicon-star-empty"
trashStyle Trash = {textDecoration: "line-through"}
trashStyle _ = {textDecoration: "none"}
corpusDocument
| Just cid <- corpusId = Routes.CorpusDocument sid cid listId
| otherwise = Routes.Document sid listId
colNames = T.ColumnName <$> [ "Tag", "Date", "Title", "Source"]
wrapColElts = const identity
getCategory (localCategories /\ _) {_id, category} = fromMaybe category (localCategories ^. at _id)
orderWith =
case convOrderBy (fst params).orderBy of
Just DateAsc -> Seq.sortWith \(DocumentsView { date }) -> date
Just DateDesc -> Seq.sortWith \(DocumentsView { date }) -> Down date
Just SourceAsc -> Seq.sortWith \(DocumentsView { source }) -> Str.toLower source
Just SourceDesc -> Seq.sortWith \(DocumentsView { source }) -> Down $ Str.toLower source
Just TitleAsc -> Seq.sortWith \(DocumentsView { title }) -> Str.toLower title
Just TitleDesc -> Seq.sortWith \(DocumentsView { title }) -> Down $ Str.toLower title
_ -> identity -- the server ordering is enough here
filteredRows = T.filterRows { params: fst params } $ orderWith $ A.toUnfoldable documents
rows localCategories = row <$> filteredRows
where
row (DocumentsView r) =
{ row:
T.makeRow [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
caroussel session nodeId setLocalCategories r cat
--, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
-- TODO show date: Year-Month-Day only
, H.div { style } [ R2.showText r.date ]
, H.div { style }
[ H.a { href: url frontends $ corpusDocument r._id, target: "_blank"} [ H.text r.title ] ]
, H.div { style } [ H.text $ if r.source == "" then "Source" else r.source ]
]
, delete: true }
where
cat = getCategory localCategories r
(_ /\ setLocalCategories) = localCategories
checked = Trash == cat
style = trashStyle cat
className = gi cat
---------------------------------------------------------
sampleData' :: DocumentsView
sampleData' = DocumentsView { _id : 1
, url : ""
, date : 2010
, title : "title"
, source : "source"
, category : UnRead
, ngramCount : 1}
sampleData :: Array DocumentsView
--sampleData = replicate 10 sampleData'
sampleData = map (\(Tuple t s) -> DocumentsView { _id : 1
, url : ""
, date : 2017
, title: t
, source: s
, category : UnRead
, ngramCount : 10}) sampleDocuments
sampleDocuments :: Array (Tuple String String)
sampleDocuments = [Tuple "Macroscopic dynamics of the fusion process" "Journal de Physique Lettres",Tuple "Effects of static and cyclic fatigue at high temperature upon reaction bonded silicon nitride" "Journal de Physique Colloques",Tuple "Reliability of metal/glass-ceramic junctions made by solid state bonding" "Journal de Physique Colloques",Tuple "High temperature mechanical properties and intergranular structure of sialons" "Journal de Physique Colloques",Tuple "SOLUTIONS OF THE LANDAU-VLASOV EQUATION IN NUCLEAR PHYSICS" "Journal de Physique Colloques",Tuple "A STUDY ON THE FUSION REACTION 139La + 12C AT 50 MeV/u WITH THE VUU EQUATION" "Journal de Physique Colloques",Tuple "Atomic structure of \"vitreous\" interfacial films in sialon" "Journal de Physique Colloques",Tuple "MICROSTRUCTURAL AND ANALYTICAL CHARACTERIZATION OF Al2O3/Al-Mg COMPOSITE INTERFACES" "Journal de Physique Colloques",Tuple "Development of oxidation resistant high temperature NbTiAl alloys and intermetallics" "Journal de Physique IV Colloque",Tuple "Determination of brazed joint constitutive law by inverse method" "Journal de Physique IV Colloque",Tuple "Two dimensional estimates from ocean SAR images" "Nonlinear Processes in Geophysics",Tuple "Comparison Between New Carbon Nanostructures Produced by Plasma with Industrial Carbon Black Grades" "Journal de Physique III",Tuple "<i>Letter to the Editor:</i> SCIPION, a new flexible ionospheric sounder in Senegal" "Annales Geophysicae",Tuple "Is reducibility in nuclear multifragmentation related to thermal scaling?" "Physics Letters B",Tuple "Independence of fragment charge distributions of the size of heavy multifragmenting sources" "Physics Letters B",Tuple "Hard photons and neutral pions as probes of hot and dense nuclear matter" "Nuclear Physics A",Tuple "Surveying the nuclear caloric curve" "Physics Letters B",Tuple "A hot expanding source in 50 A MeV Xe+Sn central reactions" "Physics Letters B"]
newtype SearchQuery = SearchQuery
{ query :: Array String
, parent_id :: Int
}
instance encodeJsonSQuery :: EncodeJson SearchQuery where
encodeJson (SearchQuery {query, parent_id})
= "query" := query
~> "parent_id" := parent_id
~> jsonEmptyObject
documentsRoute :: Int -> SessionRoute
documentsRoute nodeId = NodeAPI Node (Just nodeId) "documents"
tableRoute :: Int -> TabType -> Int -> SessionRoute
tableRoute nodeId tabType listId = NodeAPI Node (Just nodeId) $ "table" <> "?tabType=" <> (showTabType' tabType) <> "&list=" <> (show listId)
tableHashRoute :: Int -> TabType -> SessionRoute
tableHashRoute nodeId tabType = NodeAPI Node (Just nodeId) $ "table/hash" <> "?tabType=" <> (showTabType' tabType)
deleteAllDocuments :: Session -> Int -> Aff (Array Int)
deleteAllDocuments session = delete session <<< documentsRoute
-- TODO: not optimal but Data.Set lacks some function (Set.alter)
toggleSet :: forall a. Ord a => a -> Set a -> Set a
toggleSet a s
| Set.member a s = Set.delete a s
| otherwise = Set.insert a s