DocsTable.purs 20.1 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
                       , tabType
                       , totalRecords
154
                       } [] ] ] ]
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
pageLayout :: R2.Component PageLayoutProps
pageLayout = R.createElement pageLayoutCpt
252

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 385 386
    mCurrentDocId <- T.useFocused
          (maybe Nothing _.mCurrentDocId)
          (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
    mCurrentDocId' <- T.useLive T.unequal mCurrentDocId
387

388 389
    localCategories' <- T.useLive T.unequal localCategories

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
                                  [ docChooser { listId
                                               , mCorpusId
                                               , nodeId: r._id
                                               , sidePanel
                                               , sidePanelState
                                               , tableReload: reload } []
                                  ]
424
                          --, H.div { className: "column-tag flex" } [ caroussel { category: cat, nodeId, row: dv, session, setLocalCategories } [] ]
425
                          , H.div { className: "column-tag flex" }
426 427 428 429 430
                                  [ rating { nodeId
                                           , row: dv
                                           , score: cat
                                           , setLocalCategories: \lc -> T.modify_ lc localCategories
                                           , session } [] ]
431
                --, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
432
                -- TODO show date: Year-Month-Day only
433
                , H.div { className: tClassName } [ R2.showText r.date ]
434 435 436 437
                , H.div { className: tClassName }
                        [ H.a { href: url frontends $ corpusDocument r._id, target: "_blank"}
                              [ H.text r.title ]
                        ]
438
                , H.div { className: tClassName } [ H.text $ if r.source == "" then "Source" else r.source ]
439
                , H.div {} [ H.text $ maybe "-" show r.ngramCount ]
440
                ]
441 442
              , delete: true }
              where
443
                cat         = fromMaybe category (localCategories' ^. at _id)
444
                -- checked    = Star_1 == cat
445
                selected   = mCurrentDocId' == Just r._id
446
                tClassName = trashClassName cat selected
447
                className  = gi cat
448

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

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

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

    cpt { listId
        , mCorpusId: Just corpusId
        , nodeId
470 471
        , sidePanel
        , sidePanelState
472
        , tableReload } _ = do
473 474 475 476
      mCurrentDocId <- T.useFocused
            (maybe Nothing _.mCurrentDocId)
            (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
      mCurrentDocId' <- T.useLive T.unequal mCurrentDocId
477

478 479
      let selected = mCurrentDocId' == Just nodeId
          eyeClass = if selected then "fa-eye" else "fa-eye-slash"
480

481
      pure $ H.div { className: "btn" } [
482
        H.span { className: "fa " <> eyeClass
483
               , on: { click: onClick selected } } []
484 485
      ]
      where
486
        onClick selected _ = do
487 488 489
          -- log2 "[docChooser] onClick, listId" listId
          -- log2 "[docChooser] onClick, corpusId" corpusId
          -- log2 "[docChooser] onClick, nodeId" nodeId
490 491
          -- R2.callTrigger triggerAnnotatedDocIdChange { corpusId, listId, nodeId }
          -- T2.reload tableReload
492 493 494 495 496 497 498 499 500
          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
501
          log2 "[docChooser] sidePanel opened" sidePanelState
502

503

504 505 506
newtype SearchQuery = SearchQuery {
    parent_id :: Int
  , query :: Array String
507 508 509 510
  }


instance encodeJsonSQuery :: EncodeJson SearchQuery where
511
  encodeJson (SearchQuery {query, parent_id})
512
    = "query" := query
513
    ~> "parent_id" := parent_id
514 515 516
    ~> jsonEmptyObject


517 518
documentsRoute :: Int -> SessionRoute
documentsRoute nodeId = NodeAPI Node (Just nodeId) "documents"
519

520 521
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)
522 523 524 525

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

Nicolas Pouillard's avatar
Nicolas Pouillard committed
526 527 528
tableRouteWithPage :: forall row.
                      { listId :: Int
                      , nodeId :: Int
529
                      , params :: TT.Params
Nicolas Pouillard's avatar
Nicolas Pouillard committed
530 531 532
                      , query ::  Query
                      , tabType :: TabType
                      | row } -> SessionRoute
533 534 535 536 537 538
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
539
    odb = mQueryParamS "orderBy" TT.orderByToForm orderBy
540 541 542
    st  = queryParam "searchType" searchType
    tt  = queryParamS "tabType" (showTabType' tabType)
    q   = queryParamS "query" query
543

544
deleteAllDocuments :: Session -> Int -> Aff (Array Int)
545
deleteAllDocuments session = delete session <<< documentsRoute
546 547 548 549 550 551

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