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

4 5 6 7
import Gargantext.Prelude
  ( class Ord, Unit, bind, const, discard, identity, mempty
  , otherwise, pure, show, unit, ($), (/=), (<$>), (<<<), (<>), (==) )
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
8
import Data.Array as A
9
import Data.Lens ((^.))
10 11
import Data.Lens.At (at)
import Data.Lens.Record (prop)
12
import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
13
import Data.Ord.Down (Down(..))
14 15
import Data.Set (Set)
import Data.Set as Set
16
import Data.String as Str
17
import Data.Symbol (SProxy(..))
18 19
import Data.Tuple (Tuple(..))
import DOM.Simple.Console (log2)
20
import DOM.Simple.Event as DE
21
import Effect (Effect)
22
import Effect.Aff (Aff, launchAff_)
23
import Effect.Class (liftEffect)
24 25
import Reactix as R
import Reactix.DOM.HTML as H
26
import Toestand as T
James Laver's avatar
James Laver committed
27

28 29
import Gargantext.Components.Category (rating)
import Gargantext.Components.Category.Types (Star(..))
30
import Gargantext.Components.DocsTable.Types
31
  ( DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), sampleData )
32
import Gargantext.Components.Table.Types as TT
33
import Gargantext.Components.Nodes.Lists.Types as NT
34
import Gargantext.Components.Nodes.Texts.Types as TextsT
35
import Gargantext.Components.Table as TT
James Laver's avatar
James Laver committed
36
import Gargantext.Ends (Frontends, url)
37
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..))
38
import Gargantext.Routes as Routes
39
import Gargantext.Routes (SessionRoute(NodeAPI))
Nicolas Pouillard's avatar
Nicolas Pouillard committed
40
import Gargantext.Sessions (Session, sessionId, get, delete)
41
import Gargantext.Types (ListId, NodeID, NodeType(..), OrderBy(..), SidePanelState(..), TableResult, TabSubType, TabType, showTabType')
Nicolas Pouillard's avatar
Nicolas Pouillard committed
42
import Gargantext.Utils (sortWith)
43
import Gargantext.Utils.CacheAPI as GUC
Nicolas Pouillard's avatar
Nicolas Pouillard committed
44
import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParamS, queryParam, queryParamS)
45
import Gargantext.Utils.Reactix as R2
46
import Gargantext.Utils.Toestand as T2
47

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

type TotalRecords = Int

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

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

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

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

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

95 96 97 98
docViewLayout :: Record LayoutProps -> R.Element
docViewLayout props = R.createElement docViewLayoutCpt props []

docViewLayoutCpt :: R.Component LayoutProps
99
docViewLayoutCpt = here.component "docViewLayout" cpt
100 101
  where
    cpt layout _children = do
102
      query <- T.useBox ""
103
      let params = TT.initialParams
104
      pure $ docView { layout, params, query } []
105

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

112 113
docView :: R2.Component Props
docView = R.createElement docViewCpt
114 115

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

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

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

searchBar :: R2.Component SearchBarProps
searchBar = R.createElement searchBarCpt

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

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

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

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

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

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

mock :: Boolean
mock = false

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

218
getPageHash :: Session -> PageParams -> Aff String
219
getPageHash session { nodeId, tabType } = do
220
  (get session $ tableHashRoute nodeId tabType) :: Aff String
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
pageLayout :: Record PageLayoutProps -> R.Element
pageLayout props = R.createElement pageLayoutCpt props []

253
pageLayoutCpt :: R.Component PageLayoutProps
254
pageLayoutCpt = here.component "pageLayout" cpt where
255 256 257
  cpt props@{ cacheState
            , frontends
            , listId
258
            , mCorpusId
259 260 261 262
            , nodeId
            , params
            , query
            , session
263
            , sidePanel
264
            , tabType } _ = do
265 266
    cacheState' <- T.useLive T.unequal cacheState

267
    let path = { listId, mCorpusId, nodeId, params, query, tabType }
268 269 270 271 272 273 274 275
        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
276
                      Tuple res.count docs
277 278
    case cacheState' of
      NT.CacheOn -> do
279 280 281
        let paint (Tuple count docs) = page { documents: docs
                                            , layout: props { totalRecords = count }
                                            , params } []
282
            mkRequest :: PageParams -> GUC.Request
Nicolas Pouillard's avatar
Nicolas Pouillard committed
283
            mkRequest p = GUC.makeGetRequest session $ tableRoute p
284 285 286 287 288 289 290 291

        useLoaderWithCacheAPI {
            cacheEndpoint: getPageHash session
          , handleResponse
          , mkRequest
          , path
          , renderer: paint
          }
292
      NT.CacheOff -> do
293
        localCategories <- T.useBox (mempty :: LocalUserScore)
294 295
        paramsS <- T.useBox params
        paramsS' <- T.useLive T.unequal paramsS
Nicolas Pouillard's avatar
Nicolas Pouillard committed
296
        let loader p = do
297
              let route = tableRouteWithPage (p { params = paramsS', query = query })
298 299
              res <- get session $ route
              liftEffect $ do
300 301
                here.log2 "table route" route
                here.log2 "table res" res
302
              pure $ handleResponse res
303
            render (Tuple count documents) = pagePaintRaw { documents
304
                                                          , layout: props { params = paramsS'
305 306
                                                                          , totalRecords = count }
                                                          , localCategories
307
                                                          , params: paramsS } []
308
        useLoader (path { params = paramsS' }) loader render
309

310 311
type PageProps = (
    documents :: Array DocumentsView
312
  , layout :: Record PageLayoutProps
313
  , params :: TT.Params
314
  )
315

316 317
page :: R2.Component PageProps
page = R.createElement pageCpt
318

319
pageCpt :: R.Component PageProps
320
pageCpt = here.component "pageCpt" cpt where
321
  cpt { documents, layout, params } _ = do
322 323
    paramsS <- T.useBox params

324
    pure $ pagePaint { documents, layout, params: paramsS } []
325 326 327 328

type PagePaintProps = (
    documents :: Array DocumentsView
  , layout :: Record PageLayoutProps
329
  , params :: T.Box TT.Params
330 331
)

332 333
pagePaint :: R2.Component PagePaintProps
pagePaint = R.createElement pagePaintCpt
334 335

pagePaintCpt :: R.Component PagePaintProps
336
pagePaintCpt = here.component "pagePaintCpt" cpt
337 338
  where
    cpt { documents, layout, params } _ = do
339 340
      params' <- T.useLive T.unequal params

341
      localCategories <- T.useBox (mempty :: LocalUserScore)
342
      pure $ pagePaintRaw { documents: A.fromFoldable (filteredRows params')
343 344 345 346
                          , layout
                          , localCategories
                          , params } []
        where
347 348
          orderWith { orderBy } =
            case convOrderBy orderBy of
349 350 351 352 353 354 355
              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
356
          filteredRows params' = TT.filterRows { params: params' } $ (orderWith params') $ A.toUnfoldable documents
357 358 359


type PagePaintRawProps = (
360 361 362 363
    documents       :: Array DocumentsView
  , layout          :: Record PageLayoutProps
  , localCategories :: T.Box LocalUserScore
  , params          :: T.Box TT.Params
364 365
  )

366 367
pagePaintRaw :: R2.Component PagePaintRawProps
pagePaintRaw = R.createElement pagePaintRawCpt
368 369

pagePaintRawCpt :: R.Component PagePaintRawProps
370
pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
371
  cpt { documents
372
      , layout: { frontends
373
                , listId
374
                , mCorpusId
375 376
                , nodeId
                , session
377 378
                , sidePanel
                , sidePanelState
379
                , totalRecords }
380 381
      , localCategories
      , params } _ = do
382
    reload <- T.useBox T2.newReload
383

384
    localCategories' <- T.useLive T.unequal localCategories
385 386 387 388
    mCurrentDocId <- T.useFocused
          (maybe Nothing _.mCurrentDocId)
          (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
    mCurrentDocId' <- T.useLive T.unequal mCurrentDocId
389

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

450
type DocChooser = (
451 452 453 454 455 456 457
    listId         :: ListId
  , mCorpusId      :: Maybe NodeID
  , nodeId         :: NodeID
  , selected       :: Boolean
  , sidePanel      :: T.Box (Maybe (Record TextsT.SidePanel))
  , sidePanelState :: T.Box SidePanelState
  , tableReload    :: T2.ReloadS
458 459 460 461 462 463
  )

docChooser :: R2.Component DocChooser
docChooser = R.createElement docChooserCpt

docChooserCpt :: R.Component DocChooser
464
docChooserCpt = here.component "docChooser" cpt
465 466 467 468 469 470 471
  where
    cpt { mCorpusId: Nothing } _ = do
      pure $ H.div {} []

    cpt { listId
        , mCorpusId: Just corpusId
        , nodeId
472
        , selected
473 474
        , sidePanel
        , sidePanelState
475
        , tableReload } _ = do
476

477
      let eyeClass = if selected then "fa-eye" else "fa-eye-slash"
478

479
      pure $ H.div { className: "btn" } [
480
        H.span { className: "fa " <> eyeClass
481 482 483 484 485 486 487
               , on: { click: onClick } } []
      ]
      where
        onClick _ = do
          -- log2 "[docChooser] onClick, listId" listId
          -- log2 "[docChooser] onClick, corpusId" corpusId
          -- log2 "[docChooser] onClick, nodeId" nodeId
488 489 490 491 492 493 494 495
          -- R2.callTrigger triggerAnnotatedDocIdChange { corpusId, listId, nodeId }
          -- T2.reload tableReload
          T.write_ (Just { corpusId: corpusId
                         , listId: listId
                         , mCurrentDocId: Nothing
                         , nodeId: nodeId }) sidePanel
          T.write_ Opened sidePanelState
          log2 "[docChooser] sidePanel opened" sidePanelState
496

497

498 499 500
newtype SearchQuery = SearchQuery {
    parent_id :: Int
  , query :: Array String
501 502 503 504
  }


instance encodeJsonSQuery :: EncodeJson SearchQuery where
505
  encodeJson (SearchQuery {query, parent_id})
506
    = "query" := query
507
    ~> "parent_id" := parent_id
508 509 510
    ~> jsonEmptyObject


511 512
documentsRoute :: Int -> SessionRoute
documentsRoute nodeId = NodeAPI Node (Just nodeId) "documents"
513

514 515
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)
516 517 518 519

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

Nicolas Pouillard's avatar
Nicolas Pouillard committed
520 521 522
tableRouteWithPage :: forall row.
                      { listId :: Int
                      , nodeId :: Int
523
                      , params :: TT.Params
Nicolas Pouillard's avatar
Nicolas Pouillard committed
524 525 526
                      , query ::  Query
                      , tabType :: TabType
                      | row } -> SessionRoute
527 528 529 530 531 532
tableRouteWithPage { listId, nodeId, params: { limit, offset, orderBy, searchType }, query, tabType } =
  NodeAPI Node (Just nodeId) $ "table" <> joinQueryStrings [tt, lst, lmt, odb, ofs, st, q]
  where
    lmt = queryParam "limit" limit
    lst = queryParam "list" listId
    ofs = queryParam "offset" offset
533
    odb = mQueryParamS "orderBy" TT.orderByToForm orderBy
534 535 536
    st  = queryParam "searchType" searchType
    tt  = queryParamS "tabType" (showTabType' tabType)
    q   = queryParamS "query" query
537

538
deleteAllDocuments :: Session -> Int -> Aff (Array Int)
539
deleteAllDocuments session = delete session <<< documentsRoute
540 541 542 543 544 545

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