DocsTable.purs 20.7 KB
Newer Older
1
-- TODO: this module should be replaced by FacetsTable
2
module Gargantext.Components.DocsTable where
3

4 5
import Gargantext.Prelude

6
import DOM.Simple.Event as DE
7
import Data.Array as A
8
import Data.Either (Either)
9
import Data.Generic.Rep (class Generic)
10
import Data.Lens ((^.))
11 12
import Data.Lens.At (at)
import Data.Lens.Record (prop)
13
import Data.Map as Map
14
import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
15
import Data.Newtype (class Newtype)
16
import Data.Ord.Down (Down(..))
17
import Data.Set (Set)
18
import Data.Set as Set
19
import Data.String as Str
20
import Data.Symbol (SProxy(..))
21
import Data.Tuple (Tuple(..))
22
import Effect (Effect)
23
import Effect.Aff (Aff)
24
import Effect.Class (liftEffect)
25
import Gargantext.Components.App.Data (Boxes)
26 27
import Gargantext.Components.Category (rating)
import Gargantext.Components.Category.Types (Star(..))
28
import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), Year, sampleData)
29
import Gargantext.Components.Nodes.Lists.Types as NT
30
import Gargantext.Components.Nodes.Texts.Types as TextsT
31 32 33
import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT
import Gargantext.Config.REST (RESTError)
James Laver's avatar
James Laver committed
34
import Gargantext.Ends (Frontends, url)
35
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..))
36
import Gargantext.Routes (SessionRoute(NodeAPI))
37
import Gargantext.Routes as Routes
Nicolas Pouillard's avatar
Nicolas Pouillard committed
38
import Gargantext.Sessions (Session, sessionId, get, delete)
39
import Gargantext.Types (ListId, NodeID, NodeType(..), OrderBy(..), SidePanelState(..), TabSubType, TabType, TableResult, showTabType')
Nicolas Pouillard's avatar
Nicolas Pouillard committed
40
import Gargantext.Utils (sortWith)
41
import Gargantext.Utils.CacheAPI as GUC
42
import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParam, mQueryParamS, queryParam, queryParamS)
43
import Gargantext.Utils.Reactix as R2
44 45
import Reactix as R
import Reactix.DOM.HTML as H
46
import Simple.JSON as JSON
47
import Toestand as T
48

49 50
here :: R2.Here
here = R2.here "Gargantext.Components.DocsTable"
51 52 53

type TotalRecords = Int

James Laver's avatar
James Laver committed
54 55 56
type Path a =
  ( corpusId  :: Int
  , listId    :: Int
57
  , frontends :: Frontends
James Laver's avatar
James Laver committed
58 59
  , session   :: Session
  , tabType   :: TabSubType a
60 61
  )

62
type CommonProps =
63 64
  ( boxes          :: Boxes
  , cacheState     :: T.Box NT.CacheState
65 66 67 68 69 70 71
  , frontends      :: Frontends
  , listId         :: Int
  , mCorpusId      :: Maybe Int
  , nodeId         :: Int
  , session        :: Session
  , sidePanel      :: T.Box (Maybe (Record TextsT.SidePanel))
  , tabType        :: TabType
72
  -- ^ tabType is not ideal here since it is too much entangled with tabs and
73
  -- ngramtable. Let's see how this evolves.  )
74 75
  , totalRecords   :: Int
  , yearFilter     :: T.Box (Maybe Year)
76 77 78
  )

type LayoutProps =
79
  ( chart      :: R.Element
80 81 82
  , showSearch :: Boolean
  | CommonProps
  -- , path      :: Record (Path a)
83 84
  )

James Laver's avatar
James Laver committed
85
type PageLayoutProps =
86
  ( key    :: String  -- NOTE Necessary to clear the component when cache state changes
87 88 89
  , params :: TT.Params
  , query  :: Query
  | CommonProps
90
  )
91

92
_documentIdsDeleted  = prop (SProxy :: SProxy "documentIdsDeleted")
93
_localCategories     = prop (SProxy :: SProxy "localCategories")
94

95 96 97
docViewLayout :: Record LayoutProps -> R.Element
docViewLayout props = R.createElement docViewLayoutCpt props []
docViewLayoutCpt :: R.Component LayoutProps
98
docViewLayoutCpt = here.component "docViewLayout" cpt
99 100
  where
    cpt layout _children = do
101
      query <- T.useBox ""
102
      let params = TT.initialParams
103
      pure $ docView { layout, params, query } []
104

105 106
type Props = (
    layout :: Record LayoutProps
107
  , params :: TT.Params
108
  , query  :: T.Box Query
109
  )
110

111 112
docView :: R2.Component Props
docView = R.createElement docViewCpt
113
docViewCpt :: R.Component Props
114
docViewCpt = here.component "docView" cpt where
115 116
  cpt { layout: { boxes
                , cacheState
117 118 119
                , chart
                , frontends
                , listId
120
                , mCorpusId
121 122 123
                , nodeId
                , session
                , showSearch
124
                , sidePanel
125 126
                , tabType
                , totalRecords
127
                , yearFilter
128 129 130 131
                }
      , params
      , query
      } _ = do
132
    cacheState' <- T.useLive T.unequal cacheState
133
    query' <- T.useLive T.unequal query
134

135
    pure $ H.div { className: "doc-table-doc-view container1" }
136
      [ R2.row
137
        [ chart
138
        , if showSearch then searchBar { query } [] else H.div {} []
139
        , H.div {className: "col-md-12"}
140 141
          [ pageLayout { boxes
                       , cacheState
142
                       , frontends
143
                       , key: "docView-" <> (show cacheState')
144
                       , listId
145
                       , mCorpusId
146 147
                       , nodeId
                       , params
148
                       , query: query'
149
                       , session
150
                       , sidePanel
151 152
                       , tabType
                       , totalRecords
153
                       , yearFilter
154
                       } [] ] ] ]
155

156 157 158 159 160 161 162
type SearchBarProps =
  ( query :: T.Box Query )

searchBar :: R2.Component SearchBarProps
searchBar = R.createElement searchBarCpt
searchBarCpt :: R.Component SearchBarProps
searchBarCpt = here.component "searchBar" cpt
163
  where
164 165 166 167
    cpt { query } _children = do
      query' <- T.useLive T.unequal query
      queryText <- T.useBox query'
      queryText' <- T.useLive T.unequal queryText
168

169 170
      pure $ H.div {className: "col-md-12 row"}
        [ H.div {className: "col-md-3"} []
171
        , H.div {className: "col-md-1"} [if query' /= "" then (clearButton query) else H.div {} []]
172
        , H.div {className: "col-md-3 form-group"}
173 174 175 176 177 178
          [ H.input { className: "form-control"
                    , defaultValue: query'
                    , on: { change: onSearchChange queryText
                          , keyUp: onSearchKeyup query queryText' }
                    , placeholder: query'
                    , type: "text" }
179
          ]
180
        , H.div {className: "col-md-1"} [ searchButton query queryText' ]
181 182
        ]

183 184 185
    onSearchChange :: forall e. T.Box Query -> e -> Effect Unit
    onSearchChange queryText e =
      T.write_ (R.unsafeEventValue e) queryText
186

187 188
    onSearchKeyup :: T.Box Query -> Query -> DE.KeyboardEvent -> Effect Unit
    onSearchKeyup query queryText e =
189
      if DE.key e == "Enter" then
190
        T.write_ queryText query
191
      else
192
        pure unit
193

194 195 196 197 198
    searchButton query queryText' =
      H.button { className: "btn btn-primary"
               , on: { click: \e -> T.write_ queryText' query }
               , type: "submit" }
        [ H.span {className: "fa fa-search"} [] ]
199

200
    clearButton query =
201
      H.button { className: "btn btn-danger"
202 203
               , on: { click: \e -> T.write_ "" query } }
        [ H.span {className: "fa fa-times"} [] ]
204 205 206 207

mock :: Boolean
mock = false

208
type PageParams = {
209 210 211 212 213 214 215
    listId      :: Int
  , mCorpusId   :: Maybe Int
  , nodeId      :: Int
  , tabType     :: TabType
  , query       :: Query
  , params      :: TT.Params
  , yearFilter  :: Maybe Year
216
  }
217

218 219 220
getPageHash :: Session -> PageParams -> Aff (Either RESTError String)
getPageHash session { nodeId, tabType } =
  get session $ tableHashRoute nodeId tabType
221

222 223 224 225 226 227 228
convOrderBy :: Maybe (TT.OrderByDirection TT.ColumnName) -> Maybe OrderBy
convOrderBy (Just (TT.ASC  (TT.ColumnName "Date")))  = Just DateAsc
convOrderBy (Just (TT.DESC (TT.ColumnName "Date")))  = Just DateDesc
convOrderBy (Just (TT.ASC  (TT.ColumnName "Title"))) = Just TitleAsc
convOrderBy (Just (TT.DESC (TT.ColumnName "Title"))) = Just TitleDesc
convOrderBy (Just (TT.ASC  (TT.ColumnName "Source"))) = Just SourceAsc
convOrderBy (Just (TT.DESC (TT.ColumnName "Source"))) = Just SourceDesc
229
convOrderBy _ = Nothing
230

231 232 233
res2corpus :: Response -> DocumentsView
res2corpus (Response r) =
  DocumentsView { _id : r.cid
234 235
  , category   : r.category
  , date       : (\(Hyperdata hr) -> hr.pub_year) r.hyperdata
236
  , ngramCount : r.ngramCount
237 238 239 240
  , score      : r.score
  , source     : (\(Hyperdata hr) -> hr.source) r.hyperdata
  , title      : (\(Hyperdata hr) -> hr.title) r.hyperdata
  , url        : ""
241 242
}

243 244 245 246 247 248 249
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

250 251 252 253 254 255
filterDocsByYear :: Year -> Array Response -> Array Response
filterDocsByYear year docs = A.filter filterFunc docs
  where
    filterFunc :: Response -> Boolean
    filterFunc (Response { hyperdata: Hyperdata { pub_year } }) = eq year $ show pub_year

256 257
pageLayout :: R2.Component PageLayoutProps
pageLayout = R.createElement pageLayoutCpt
258
pageLayoutCpt :: R.Component PageLayoutProps
259
pageLayoutCpt = here.component "pageLayout" cpt where
260 261
  cpt props@{ boxes
            , cacheState
262
            , listId
263
            , mCorpusId
264 265 266 267
            , nodeId
            , params
            , query
            , session
268 269 270
            , tabType
            , yearFilter
            } _ = do
271
    cacheState' <- T.useLive T.unequal cacheState
272
    yearFilter' <- T.useLive T.unequal yearFilter
273

274
    let path = { listId, mCorpusId, nodeId, params, query, tabType, yearFilter: yearFilter' }
275 276 277
        handleResponse :: HashedResponse (TableResult Response) -> Tuple Int (Array DocumentsView)
        handleResponse (HashedResponse { hash, value: res }) = ret
          where
278 279 280 281 282 283 284 285

            filters = filterDocs query
                    >>> \res' -> case yearFilter' of
                      Nothing -> res'
                      Just year -> filterDocsByYear year res'

            docs = res2corpus <$> filters res.docs

286 287 288 289
            ret = if mock then
                      --Tuple 0 (take limit $ drop offset sampleData)
                      Tuple 0 sampleData
                    else
290
                      Tuple res.count docs
291

292 293
    case cacheState' of
      NT.CacheOn -> do
294 295
        let paint (Tuple count docs) = page { boxes
                                            , documents: docs
296 297
                                            , layout: props { totalRecords = count }
                                            , params } []
298
            mkRequest :: PageParams -> GUC.Request
Nicolas Pouillard's avatar
Nicolas Pouillard committed
299
            mkRequest p = GUC.makeGetRequest session $ tableRoute p
300

301 302 303
        useLoaderWithCacheAPI
          { boxes
          , cacheEndpoint: getPageHash session
304 305 306 307 308
          , handleResponse
          , mkRequest
          , path
          , renderer: paint
          }
309
      NT.CacheOff -> do
310
        localCategories <- T.useBox (Map.empty :: LocalUserScore)
311 312
        paramsS <- T.useBox params
        paramsS' <- T.useLive T.unequal paramsS
Nicolas Pouillard's avatar
Nicolas Pouillard committed
313
        let loader p = do
314
              let route = tableRouteWithPage (p { params = paramsS', query = query })
315
              eRes <- get session $ route
316
              liftEffect $ do
317
                here.log2 "table route" route
318 319 320
                here.log2 "table res" eRes
              pure $ handleResponse <$> eRes
        let render (Tuple count documents) = pagePaintRaw { documents
321
                                                          , layout: props { params = paramsS'
322 323
                                                                          , totalRecords = count }
                                                          , localCategories
324
                                                          , params: paramsS } []
325 326 327 328 329
        let errorHandler err = here.log2 "[pageLayout] RESTError" err
        useLoader { errorHandler
                  , path: path { params = paramsS' }
                  , loader
                  , render }
330

331 332 333
type PageProps =
  ( boxes     :: Boxes
  , documents :: Array DocumentsView
334 335
  , layout    :: Record PageLayoutProps
  , params    :: TT.Params
336
  )
337

338 339
page :: R2.Component PageProps
page = R.createElement pageCpt
340
pageCpt :: R.Component PageProps
341
pageCpt = here.component "pageCpt" cpt where
342
  cpt { documents, layout, params } _ = do
343 344
    paramsS <- T.useBox params

345
    pure $ pagePaint { documents, layout, params: paramsS } []
346 347 348 349

type PagePaintProps = (
    documents :: Array DocumentsView
  , layout :: Record PageLayoutProps
350
  , params :: T.Box TT.Params
351 352
)

353 354
pagePaint :: R2.Component PagePaintProps
pagePaint = R.createElement pagePaintCpt
355
pagePaintCpt :: R.Component PagePaintProps
356
pagePaintCpt = here.component "pagePaintCpt" cpt
357 358
  where
    cpt { documents, layout, params } _ = do
359 360
      params' <- T.useLive T.unequal params

361
      localCategories <- T.useBox (Map.empty :: LocalUserScore)
362
      pure $ pagePaintRaw { documents: A.fromFoldable (filteredRows params')
363 364 365 366
                          , layout
                          , localCategories
                          , params } []
        where
367 368
          orderWith { orderBy } =
            case convOrderBy orderBy of
369 370 371 372 373 374 375
              Just DateAsc    -> sortWith \(DocumentsView { date })   -> date
              Just DateDesc   -> sortWith \(DocumentsView { date })   -> Down date
              Just SourceAsc  -> sortWith \(DocumentsView { source }) -> Str.toLower source
              Just SourceDesc -> sortWith \(DocumentsView { source }) -> Down $ Str.toLower source
              Just TitleAsc   -> sortWith \(DocumentsView { title })  -> Str.toLower title
              Just TitleDesc  -> sortWith \(DocumentsView { title })  -> Down $ Str.toLower title
              _               -> identity -- the server ordering is enough here
376
          filteredRows params' = TT.filterRows { params: params' } $ (orderWith params') $ A.toUnfoldable documents
377 378


379 380
type PagePaintRawProps =
  ( documents       :: Array DocumentsView
381 382 383
  , layout          :: Record PageLayoutProps
  , localCategories :: T.Box LocalUserScore
  , params          :: T.Box TT.Params
384 385
  )

386 387
pagePaintRaw :: R2.Component PagePaintRawProps
pagePaintRaw = R.createElement pagePaintRawCpt
388
pagePaintRawCpt :: R.Component PagePaintRawProps
389
pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
390
  cpt { documents
391 392
      , layout: { boxes
                , frontends
393
                , listId
394
                , mCorpusId
395 396
                , nodeId
                , session
397
                , sidePanel
398
                , totalRecords }
399 400
      , localCategories
      , params } _ = do
401 402 403 404
    mCurrentDocId <- T.useFocused
          (maybe Nothing _.mCurrentDocId)
          (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
    mCurrentDocId' <- T.useLive T.unequal mCurrentDocId
405

406 407
    localCategories' <- T.useLive T.unequal localCategories

408
    pure $ TT.table
409
      { colNames
410
      , container: TT.defaultContainer
411
      , params
412
      , rows: rows localCategories' mCurrentDocId'
413
      , syncResetButton : [ H.div {} [] ]
414 415 416
      , totalRecords
      , wrapColElts
      }
417
      where
418
        sid = sessionId session
419
        trashClassName Star_0 _ = "trash"
420 421
        trashClassName _ true = "active"
        trashClassName _ false = ""
422
        corpusDocument
423
          | Just cid <- mCorpusId = Routes.CorpusDocument sid cid listId
424
          | otherwise = Routes.Document sid listId
425
        colNames = TT.ColumnName <$> [ "Show", "Tag", "Date", "Title", "Source", "Score" ]
426
        wrapColElts = const identity
427
        rows localCategories' mCurrentDocId' = row <$> A.toUnfoldable documents
428
          where
429
            row dv@(DocumentsView r@{ _id, category }) =
430
              { row:
431
                TT.makeRow [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
432
                            H.div { className: "" }
433 434
                                  [ docChooser { boxes
                                               , listId
435 436
                                               , mCorpusId
                                               , nodeId: r._id
437
                                               , sidePanel } []
438
                                  ]
439
                          --, H.div { className: "column-tag flex" } [ caroussel { category: cat, nodeId, row: dv, session, setLocalCategories } [] ]
440
                          , H.div { className: "column-tag flex" }
441 442 443 444 445
                                  [ rating { nodeId
                                           , row: dv
                                           , score: cat
                                           , setLocalCategories: \lc -> T.modify_ lc localCategories
                                           , session } [] ]
446
                --, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
447
                -- TODO show date: Year-Month-Day only
448
                , H.div { className: tClassName } [ R2.showText r.date ]
449 450 451 452
                , H.div { className: tClassName }
                        [ H.a { href: url frontends $ corpusDocument r._id, target: "_blank"}
                              [ H.text r.title ]
                        ]
453
                , H.div { className: tClassName } [ H.text $ if r.source == "" then "Source" else r.source ]
454
                , H.div {} [ H.text $ maybe "-" show r.ngramCount ]
455
                ]
456 457
              , delete: true }
              where
458
                cat         = fromMaybe category (localCategories' ^. at _id)
459
                -- checked    = Star_1 == cat
460
                selected   = mCurrentDocId' == Just r._id
461
                tClassName = trashClassName cat selected
462

463
type DocChooser = (
464 465
    boxes :: Boxes
  , listId         :: ListId
466 467 468
  , mCorpusId      :: Maybe NodeID
  , nodeId         :: NodeID
  , sidePanel      :: T.Box (Maybe (Record TextsT.SidePanel))
469 470 471 472 473
  )

docChooser :: R2.Component DocChooser
docChooser = R.createElement docChooserCpt
docChooserCpt :: R.Component DocChooser
474
docChooserCpt = here.component "docChooser" cpt
475 476 477 478
  where
    cpt { mCorpusId: Nothing } _ = do
      pure $ H.div {} []

479 480
    cpt { boxes: { sidePanelState }
        , listId
481 482
        , mCorpusId: Just corpusId
        , nodeId
483
        , sidePanel } _ = do
484 485 486 487
      mCurrentDocId <- T.useFocused
            (maybe Nothing _.mCurrentDocId)
            (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
      mCurrentDocId' <- T.useLive T.unequal mCurrentDocId
488

489 490
      let selected = mCurrentDocId' == Just nodeId
          eyeClass = if selected then "fa-eye" else "fa-eye-slash"
491

492
      pure $ H.div { className: "btn" } [
493
        H.span { className: "fa " <> eyeClass
494
               , on: { click: onClick selected } } []
495 496
      ]
      where
497
        onClick selected _ = do
498 499 500
          -- here.log2 "[docChooser] onClick, listId" listId
          -- here.log2 "[docChooser] onClick, corpusId" corpusId
          -- here.log2 "[docChooser] onClick, nodeId" nodeId
501 502
          -- R2.callTrigger triggerAnnotatedDocIdChange { corpusId, listId, nodeId }
          -- T2.reload tableReload
503 504 505 506 507 508 509 510 511
          if selected then do
            T.write_ Nothing sidePanel
            T.write_ Closed sidePanelState
          else do
            T.write_ (Just { corpusId: corpusId
                          , listId: listId
                          , mCurrentDocId: Just nodeId
                          , nodeId: nodeId }) sidePanel
            T.write_ Opened sidePanelState
512
          here.log2 "[docChooser] sidePanel opened" sidePanelState
513

514

515 516 517
newtype SearchQuery = SearchQuery {
    parent_id :: Int
  , query :: Array String
518
  }
519 520 521
derive instance Generic SearchQuery _
derive instance Newtype SearchQuery _
derive newtype instance JSON.ReadForeign SearchQuery
522 523


524 525
documentsRoute :: Int -> SessionRoute
documentsRoute nodeId = NodeAPI Node (Just nodeId) "documents"
526

527 528
tableRoute :: forall row. { listId :: Int, nodeId :: Int, tabType :: TabType | row} -> SessionRoute
tableRoute { listId, nodeId, tabType } = NodeAPI Node (Just nodeId) $ "table" <> "?tabType=" <> (showTabType' tabType) <> "&list=" <> (show listId)
529 530 531 532

tableHashRoute :: Int -> TabType -> SessionRoute
tableHashRoute nodeId tabType = NodeAPI Node (Just nodeId) $ "table/hash" <> "?tabType=" <> (showTabType' tabType)

Nicolas Pouillard's avatar
Nicolas Pouillard committed
533 534 535
tableRouteWithPage :: forall row.
                      { listId :: Int
                      , nodeId :: Int
536
                      , params :: TT.Params
Nicolas Pouillard's avatar
Nicolas Pouillard committed
537 538
                      , query ::  Query
                      , tabType :: TabType
539
                      , yearFilter :: Maybe Year
Nicolas Pouillard's avatar
Nicolas Pouillard committed
540
                      | row } -> SessionRoute
541 542
tableRouteWithPage { listId, nodeId, params: { limit, offset, orderBy, searchType }, query, tabType, yearFilter } =
  NodeAPI Node (Just nodeId) $ "table" <> joinQueryStrings [tt, lst, lmt, odb, ofs, st, q, y]
543 544 545 546
  where
    lmt = queryParam "limit" limit
    lst = queryParam "list" listId
    ofs = queryParam "offset" offset
547
    odb = mQueryParamS "orderBy" TT.orderByToForm orderBy
548 549 550
    st  = queryParam "searchType" searchType
    tt  = queryParamS "tabType" (showTabType' tabType)
    q   = queryParamS "query" query
551
    y   = mQueryParam "year" yearFilter
552

553
deleteAllDocuments :: Session -> Int -> Aff (Either RESTError (Array Int))
554
deleteAllDocuments session = delete session <<< documentsRoute
555 556 557 558 559 560

-- 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