DocsTable.purs 28.1 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
arturo's avatar
arturo committed
7
import Data.Array (any)
8
import Data.Array as A
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.Tuple (Tuple(..))
arturo's avatar
arturo committed
21
import Data.Tuple.Nested ((/\))
22
import Effect (Effect)
arturo's avatar
arturo committed
23
import Effect.Aff (Aff, launchAff_)
24
import Effect.Class (liftEffect)
arturo's avatar
arturo committed
25
import Effect.Timer (setTimeout)
arturo's avatar
arturo committed
26
import Gargantext.Components.App.Store (Boxes)
arturo's avatar
arturo committed
27
import Gargantext.Components.Bootstrap as B
28
import Gargantext.Components.Bootstrap.Types (ComponentStatus(..), ModalSizing(..), Variant(..))
29
import Gargantext.Components.Category (rating, ratingSimple)
30
import Gargantext.Components.Category.Types (Category(..), Star(..), cat2score, markCategoryChecked)
arturo's avatar
arturo committed
31
import Gargantext.Components.DocsTable.DocumentFormCreation as DFC
32
import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalCategories, Query, Response(..), Year, sampleData, showSource)
33
import Gargantext.Components.GraphQL.Endpoints (updateNodeContextCategory)
34
import Gargantext.Components.Nodes.Lists.Types as NT
35
import Gargantext.Components.Nodes.Texts.Types as TextsT
36
import Gargantext.Components.Reload (textsReloadContext)
37 38
import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT
39
import Gargantext.Config.REST (AffRESTError, logRESTError)
arturo's avatar
arturo committed
40
import Gargantext.Config.Utils (handleRESTError)
James Laver's avatar
James Laver committed
41
import Gargantext.Ends (Frontends, url)
42
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..))
43
import Gargantext.Routes (SessionRoute(NodeAPI))
44
import Gargantext.Routes as Routes
Nicolas Pouillard's avatar
Nicolas Pouillard committed
45
import Gargantext.Sessions (Session, sessionId, get, delete)
46
import Gargantext.Types (ListId, NodeID, NodeType(..), OrderBy(..), SidePanelState(..), TabSubType, TabType, TableResult, showTabType')
arturo's avatar
arturo committed
47
import Gargantext.Types as GT
arturo's avatar
arturo committed
48
import Gargantext.Utils (sortWith, (?))
49
import Gargantext.Utils.CacheAPI as GUC
50
import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParam, mQueryParamS, mQueryParamS', queryParam, queryParamS)
51
import Gargantext.Utils.Reactix as R2
52
import Gargantext.Utils.Toestand as GUT
arturo's avatar
arturo committed
53
import Gargantext.Utils.Toestand as T2
54 55
import Reactix as R
import Reactix.DOM.HTML as H
arturo's avatar
arturo committed
56
import Record.Extra as RX
57
import Simple.JSON as JSON
58
import Toestand as T
59
import Type.Proxy (Proxy(..))
60

61 62
here :: R2.Here
here = R2.here "Gargantext.Components.DocsTable"
63 64 65

type TotalRecords = Int

James Laver's avatar
James Laver committed
66 67 68
type Path a =
  ( corpusId  :: Int
  , listId    :: Int
69
  , frontends :: Frontends
James Laver's avatar
James Laver committed
70 71
  , session   :: Session
  , tabType   :: TabSubType a
72 73
  )

74
type CommonProps =
75 76
  ( boxes          :: Boxes
  , cacheState     :: T.Box NT.CacheState
77
  , chartReload :: T2.ReloadS
78 79 80 81 82 83 84
  , frontends      :: Frontends
  , listId         :: Int
  , mCorpusId      :: Maybe Int
  , nodeId         :: Int
  , session        :: Session
  , sidePanel      :: T.Box (Maybe (Record TextsT.SidePanel))
  , tabType        :: TabType
85
  -- ^ tabType is not ideal here since it is too much entangled with tabs and
86
  -- ngramtable. Let's see how this evolves.  )
87 88
  , totalRecords   :: Int
  , yearFilter     :: T.Box (Maybe Year)
89 90 91
  )

type LayoutProps =
92 93
  ( chart       :: R.Element
  , showSearch  :: Boolean
94 95
  | CommonProps
  -- , path      :: Record (Path a)
96 97
  )

James Laver's avatar
James Laver committed
98
type PageLayoutProps =
arturo's avatar
arturo committed
99
  ( params :: TT.Params
100 101
  , query  :: Query
  | CommonProps
102
  )
103

104 105
_documentIdsDeleted  = prop (Proxy :: Proxy "documentIdsDeleted")
_localCategories     = prop (Proxy :: Proxy "localCategories")
106

107 108 109
docViewLayout :: Record LayoutProps -> R.Element
docViewLayout props = R.createElement docViewLayoutCpt props []
docViewLayoutCpt :: R.Component LayoutProps
110
docViewLayoutCpt = here.component "docViewLayout" cpt
111 112
  where
    cpt layout _children = do
113
      query <- T.useBox ""
114
      let params = TT.initialParams
115
      pure $ docView { layout, params, query } []
116

117 118
type Props = (
    layout :: Record LayoutProps
119
  , params :: TT.Params
120
  , query  :: T.Box Query
121
  )
122

123 124
docView :: R2.Component Props
docView = R.createElement docViewCpt
125
docViewCpt :: R.Component Props
126
docViewCpt = here.component "docView" cpt where
127 128
  cpt { layout: { boxes
                , cacheState
129
                , chart
130
                , chartReload
131 132
                , frontends
                , listId
133
                , mCorpusId
134 135 136
                , nodeId
                , session
                , showSearch
137
                , sidePanel
138 139
                , tabType
                , totalRecords
140
                , yearFilter
141 142 143 144
                }
      , params
      , query
      } _ = do
arturo's avatar
arturo committed
145
    -- State
146
    cacheState' <- T.useLive T.unequal cacheState
147
    query' <- T.useLive T.unequal query
arturo's avatar
arturo committed
148 149 150 151
    isDocumentModalVisibleBox <- T.useBox false
    onDocumentCreationPending /\ onDocumentCreationPendingBox <-
      R2.useBox' false

arturo's avatar
arturo committed
152 153 154
    -- Context
    mReloadContext <- R.useContext textsReloadContext

arturo's avatar
arturo committed
155 156 157 158
    -- @toggleModalCallback
    toggleModal <- pure $ const $
      T.modify_ not isDocumentModalVisibleBox

arturo's avatar
arturo committed
159 160 161 162 163
    -- @onCreateDocumentEnd <AsyncProgress>
    onCreateDocumentEnd <- pure $ \asyncProgress -> do
      here.log2 "[DocsTables] NodeDocument task:" asyncProgress
      T.write_ false onDocumentCreationPendingBox
      toggleModal unit
arturo's avatar
arturo committed
164 165 166 167

      case mReloadContext of
        Nothing -> pure unit
        Just b  -> T2.reload b
arturo's avatar
arturo committed
168

arturo's avatar
arturo committed
169 170 171
    -- @createDocumentCallback
    createDocumentCallback <- pure $ \fdata -> launchAff_ do

arturo's avatar
arturo committed
172 173
      liftEffect $
        T.write_ true onDocumentCreationPendingBox
arturo's avatar
arturo committed
174

arturo's avatar
arturo committed
175
      eTask <- DFC.create session nodeId fdata
arturo's avatar
arturo committed
176

177
      handleRESTError here boxes.errors eTask
arturo's avatar
arturo committed
178 179 180 181 182 183
        \t -> liftEffect $ launchDocumentCreationProgress
                              boxes
                              session
                              nodeId
                              t
                              onCreateDocumentEnd
arturo's avatar
arturo committed
184 185 186 187 188 189

    -- Render
    pure $

      R.fragment
      [
arturo's avatar
arturo committed
190
        H.div { className: "doc-table-doc-view" }
arturo's avatar
arturo committed
191
        [ R2.row
192 193 194 195
          [ chart ]

        , H.div { className: "col d-flex mt-5 mb-2" }
          [ H.div { className: "doc-add-action" }
196
            [ H.button
197 198 199 200 201
              { className: "btn btn-light text-primary border-primary"
              , on: { click: toggleModal } }
              [ H.i { className: "fa fa-plus mr-1" } []
              , H.text "Add a document"
              , H.i { className: "fa fa-newspaper-o ml-1"} []
arturo's avatar
arturo committed
202 203
              ]
            ]
204 205 206 207 208 209
          , H.div { className: "form-group" }
            [ if showSearch then searchBar { query } [] else H.div {} [] ]
          ]

        , R2.row
          [ H.div {className: "col-md-12"}
arturo's avatar
arturo committed
210
            [ pageLayout { boxes
211 212 213 214 215 216 217 218 219 220 221 222 223 224 225
                         , cacheState
                         , chartReload
                         , frontends
                         , key: "docView-" <> (show cacheState')
                         , listId
                         , mCorpusId
                         , nodeId
                         , params
                         , query: query'
                         , session
                         , sidePanel
                         , tabType
                         , totalRecords
                         , yearFilter
                         } []
arturo's avatar
arturo committed
226 227 228 229 230 231 232
            ]
          ]
        ]
      ,
        -- Document Creation Modal
        B.baseModal
        { isVisibleBox: isDocumentModalVisibleBox
233
        , title: Just "Add a new document"
arturo's avatar
arturo committed
234
        , hasCollapsibleBackground: false
235
        , size: LargeModalSize
arturo's avatar
arturo committed
236 237
        }
        [
arturo's avatar
arturo committed
238
          DFC.documentFormCreation
arturo's avatar
arturo committed
239 240 241 242 243
          { callback: createDocumentCallback
          , status: onDocumentCreationPending ? Deferred $ Enabled
          }
        ]
      ]
244

arturo's avatar
arturo committed
245 246 247 248 249
launchDocumentCreationProgress ::
     Boxes
  -> Session
  -> GT.ID
  -> GT.AsyncTaskWithType
arturo's avatar
arturo committed
250
  -> (GT.AsyncProgress -> Effect Unit)
arturo's avatar
arturo committed
251
  -> Effect Unit
arturo's avatar
arturo committed
252 253 254
launchDocumentCreationProgress boxes session nodeId currentTask cbk
  = void $ setTimeout 1000 $ launchAff_ $
      scanDocumentCreationProgress boxes session nodeId currentTask cbk
arturo's avatar
arturo committed
255 256 257 258 259 260

scanDocumentCreationProgress ::
     Boxes
  -> Session
  -> GT.ID
  -> GT.AsyncTaskWithType
arturo's avatar
arturo committed
261
  -> (GT.AsyncProgress -> Effect Unit)
arturo's avatar
arturo committed
262
  -> Aff Unit
arturo's avatar
arturo committed
263
scanDocumentCreationProgress boxes session nodeId currentTask cbk = do
arturo's avatar
arturo committed
264 265 266

  eTask <- DFC.createProgress session nodeId currentTask

267
  handleRESTError here boxes.errors eTask
arturo's avatar
arturo committed
268 269 270 271 272 273 274 275
    \asyncProgress -> liftEffect do
      let
        GT.AsyncProgress { status } = asyncProgress
        endingStatusList =
          [ GT.IsFinished
          , GT.IsKilled
          , GT.IsFailure
          ]
276
        hasEndingStatus s = any (eq s) endingStatusList
arturo's avatar
arturo committed
277 278 279

      if (hasEndingStatus status)
      then
arturo's avatar
arturo committed
280
        cbk asyncProgress
arturo's avatar
arturo committed
281
      else
arturo's avatar
arturo committed
282
        launchDocumentCreationProgress boxes session nodeId currentTask cbk
arturo's avatar
arturo committed
283 284 285

---------------------------------------------------

286 287 288 289 290 291 292
type SearchBarProps =
  ( query :: T.Box Query )

searchBar :: R2.Component SearchBarProps
searchBar = R.createElement searchBarCpt
searchBarCpt :: R.Component SearchBarProps
searchBarCpt = here.component "searchBar" cpt
293
  where
294 295 296 297
    cpt { query } _children = do
      query' <- T.useLive T.unequal query
      queryText <- T.useBox query'
      queryText' <- T.useLive T.unequal queryText
298

299 300 301
      pure $ H.div {className: "input-group px-5"}
        [ H.input { className: "form-control"
                    , id: "docs-input-search"
302 303 304
                    , defaultValue: query'
                    , on: { change: onSearchChange queryText
                          , keyUp: onSearchKeyup query queryText' }
305
                    , placeholder: "Search in documents"
306
                    , type: "text" }
307
        , H.div {className: "input-group-append"}
308 309 310
          [
            if query' /= ""
            then
311 312 313 314 315 316
              R.fragment
                [ clearButton query
                , searchButton query queryText'
                ]
            else
              searchButton query queryText'
317
          ]
318
        -- , H.div {className: "col-md-1"} [ searchButton query queryText' ]
319 320
        ]

321 322 323
    onSearchChange :: forall e. T.Box Query -> e -> Effect Unit
    onSearchChange queryText e =
      T.write_ (R.unsafeEventValue e) queryText
324

325 326
    onSearchKeyup :: T.Box Query -> Query -> DE.KeyboardEvent -> Effect Unit
    onSearchKeyup query queryText e =
327
      if DE.key e == "Enter" then
328
        T.write_ queryText query
329
      else
330
        pure unit
331

332
    searchButton query queryText' =
333
      H.button { className: "input-group-text btn btn-light text-secondary"
334
               , on: { click: \_ -> T.write_ queryText' query }
335 336
               , type: "submit" }
        [ H.span {className: "fa fa-search"} [] ]
337

338
    clearButton query =
339
      H.button { className: "input-group-text btn btn-light"
340
               , on: { click: \_ -> T.write_ "" query } }
341
        [ H.span {className: "text-danger fa fa-times"} [] ]
342 343 344 345

mock :: Boolean
mock = false

346
type PageParams = {
347 348 349 350 351 352 353
    listId      :: Int
  , mCorpusId   :: Maybe Int
  , nodeId      :: Int
  , tabType     :: TabType
  , query       :: Query
  , params      :: TT.Params
  , yearFilter  :: Maybe Year
354
  }
355

356
getPageHash :: Session -> PageParams -> AffRESTError String
357 358
getPageHash session { nodeId, tabType } =
  get session $ tableHashRoute nodeId tabType
359

360 361 362 363 364 365 366
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
367
convOrderBy _ = Nothing
368

369 370 371
res2corpus :: Response -> DocumentsView
res2corpus (Response r) =
  DocumentsView { _id : r.cid
372 373
  , category   : r.category
  , date       : (\(Hyperdata hr) -> hr.pub_year) r.hyperdata
374
  , ngramCount : r.ngramCount
375 376 377 378
  , score      : r.score
  , source     : (\(Hyperdata hr) -> hr.source) r.hyperdata
  , title      : (\(Hyperdata hr) -> hr.title) r.hyperdata
  , url        : ""
379 380
}

381 382 383 384 385 386 387
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

388 389 390 391 392 393
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

arturo's avatar
arturo committed
394 395
-- NOTE "key": Necessary to clear the component when cache state changes
pageLayout :: R2.Component ( key :: String | PageLayoutProps )
396
pageLayout = R.createElement pageLayoutCpt
arturo's avatar
arturo committed
397
pageLayoutCpt :: R.Component ( key :: String | PageLayoutProps )
398
pageLayoutCpt = here.component "pageLayout" cpt where
399 400
  cpt props@{ boxes
            , cacheState
401
            , listId
402
            , mCorpusId
403 404 405 406
            , nodeId
            , params
            , query
            , session
407 408 409
            , tabType
            , yearFilter
            } _ = do
410
    cacheState' <- T.useLive T.unequal cacheState
411
    yearFilter' <- T.useLive T.unequal yearFilter
412

arturo's avatar
arturo committed
413 414
    let props' = (RX.pick props :: Record PageLayoutProps)

415
    let path = { listId, mCorpusId, nodeId, params, query, tabType, yearFilter: yearFilter' }
416
        handleResponse :: HashedResponse (TableResult Response) -> Tuple Int (Array DocumentsView)
417
        handleResponse (HashedResponse { value: res }) = ret
418
          where
419 420 421 422
            filterDocs' q ds = case cacheState' of
              NT.CacheOff -> ds
              NT.CacheOn -> filterDocs q ds
            filters = filterDocs' query
423 424 425 426 427 428
                    >>> \res' -> case yearFilter' of
                      Nothing -> res'
                      Just year -> filterDocsByYear year res'

            docs = res2corpus <$> filters res.docs

429 430 431 432
            ret = if mock then
                      --Tuple 0 (take limit $ drop offset sampleData)
                      Tuple 0 sampleData
                    else
433
                      Tuple res.count docs
434

435 436
    case cacheState' of
      NT.CacheOn -> do
437 438
        let paint (Tuple count docs) = page { boxes
                                            , documents: docs
arturo's avatar
arturo committed
439
                                            , layout: props' { totalRecords = count }
440
                                            , params } []
441
            mkRequest :: PageParams -> GUC.Request
Nicolas Pouillard's avatar
Nicolas Pouillard committed
442
            mkRequest p = GUC.makeGetRequest session $ tableRoute p
443

444 445 446
        useLoaderWithCacheAPI
          { boxes
          , cacheEndpoint: getPageHash session
447 448 449 450
          , handleResponse
          , mkRequest
          , path
          , renderer: paint
451
          , spinnerClass: Nothing
452
          }
453
      NT.CacheOff -> do
454
        localCategories <- T.useBox (Map.empty :: LocalCategories)
455 456
        paramsS <- T.useBox params
        paramsS' <- T.useLive T.unequal paramsS
Nicolas Pouillard's avatar
Nicolas Pouillard committed
457
        let loader p = do
458
              let route = tableRouteWithPage (p { params = paramsS', query = query })
459
              eRes <- get session $ route
460 461 462
              --liftEffect $ do
              --  here.log2 "table route" route
              --  here.log2 "table res" eRes
463 464
              pure $ handleResponse <$> eRes
        let render (Tuple count documents) = pagePaintRaw { documents
arturo's avatar
arturo committed
465
                                                          , layout: props' { params = paramsS'
466
                                                                           , totalRecords = count }
467
                                                          , localCategories
468
                                                          , params: paramsS } []
469
        let errorHandler = logRESTError here "[pageLayout]"
470 471 472 473
        useLoader { errorHandler
                  , path: path { params = paramsS' }
                  , loader
                  , render }
474

475 476 477
type PageProps =
  ( boxes     :: Boxes
  , documents :: Array DocumentsView
478 479
  , layout    :: Record PageLayoutProps
  , params    :: TT.Params
480
  )
481

482 483
page :: R2.Component PageProps
page = R.createElement pageCpt
484
pageCpt :: R.Component PageProps
485
pageCpt = here.component "pageCpt" cpt where
486
  cpt { documents, layout, params } _ = do
487 488
    paramsS <- T.useBox params

489
    pure $ pagePaint { documents, layout, params: paramsS } []
490 491 492 493

type PagePaintProps = (
    documents :: Array DocumentsView
  , layout :: Record PageLayoutProps
494
  , params :: T.Box TT.Params
495 496
)

497 498
pagePaint :: R2.Component PagePaintProps
pagePaint = R.createElement pagePaintCpt
499
pagePaintCpt :: R.Component PagePaintProps
500
pagePaintCpt = here.component "pagePaintCpt" cpt
501 502
  where
    cpt { documents, layout, params } _ = do
503 504
      params' <- T.useLive T.unequal params

505
      localCategories <- T.useBox (Map.empty :: LocalCategories)
506
      pure $ pagePaintRaw { documents: A.fromFoldable (filteredRows params')
507 508 509 510
                          , layout
                          , localCategories
                          , params } []
        where
511 512
          orderWith { orderBy } =
            case convOrderBy orderBy of
513 514
              Just DateAsc    -> sortWith \(DocumentsView { date })   -> date
              Just DateDesc   -> sortWith \(DocumentsView { date })   -> Down date
515 516
              Just SourceAsc  -> sortWith \(DocumentsView { source }) -> Str.toLower $ fromMaybe "" source
              Just SourceDesc -> sortWith \(DocumentsView { source }) -> Down $ Str.toLower $ fromMaybe "" source
517 518 519
              Just TitleAsc   -> sortWith \(DocumentsView { title })  -> Str.toLower title
              Just TitleDesc  -> sortWith \(DocumentsView { title })  -> Down $ Str.toLower title
              _               -> identity -- the server ordering is enough here
520
          filteredRows params' = TT.filterRows { params: params' } $ (orderWith params') $ A.toUnfoldable documents
521 522


523 524
type PagePaintRawProps =
  ( documents       :: Array DocumentsView
525
  , layout          :: Record PageLayoutProps
526
  , localCategories :: T.Box LocalCategories
527
  , params          :: T.Box TT.Params
528 529
  )

530 531
pagePaintRaw :: R2.Component PagePaintRawProps
pagePaintRaw = R.createElement pagePaintRawCpt
532
pagePaintRawCpt :: R.Component PagePaintRawProps
533
pagePaintRawCpt = here.component "pagePaintRaw" cpt where
534
  cpt { documents
535
      , layout: { boxes
536
                , chartReload
537
                , frontends
538
                , listId
539
                , mCorpusId
540 541
                , nodeId
                , session
542
                , sidePanel
543
                , totalRecords }
544 545
      , localCategories
      , params } _ = do
546 547 548 549
    mCurrentDocId <- T.useFocused
          (maybe Nothing _.mCurrentDocId)
          (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
    mCurrentDocId' <- T.useLive T.unequal mCurrentDocId
550

551
    reload <- T.useBox GUT.newReload
552 553
    localCategories' <- T.useLive T.unequal localCategories

554 555 556
    let
      selected = mCurrentDocId' == Just nodeId

557
    pure $ TT.table
558
      { colNames
559
      , container: TT.defaultContainer
560
      , params
561 562 563 564 565 566 567 568 569 570 571
      , rows: rows { boxes
                   , reload
                   , chartReload
                   , frontends
                   , listId
                   , localCategories: localCategories'
                   , mCorpusId
                   , mCurrentDocId
                   , nodeId
                   , session
                   , sidePanel }
572
      , syncResetButton : [ H.div {} [] ]
573 574 575
      , totalRecords
      , wrapColElts
      }
576
      where
577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640
        colNames = TT.ColumnName <$> [ "Show", "Tag", "Date", "Title", "Source", "Score" ]
        wrapColElts = const identity
        rows { boxes
             , chartReload
             , frontends
             , listId
             , localCategories
             , mCorpusId
             , mCurrentDocId
             , nodeId
             , reload
             , session
             , sidePanel } =
          (\documentsView -> { row: tableRow { boxes
                                             , chartReload
                                             , documentsView
                                             , frontends
                                             , listId
                                             , localCategories
                                             , mCorpusId
                                             , mCurrentDocId
                                             , nodeId
                                             , session
                                             , sidePanel } []
                              , delete: true } ) <$> A.toUnfoldable documents

trashClassName :: Category -> Boolean -> String
trashClassName Trash _ = "page-paint-row page-paint-row--trash"
trashClassName _ true  = "page-paint-row page-paint-row--active"
trashClassName _ false = ""

type TableRowProps =
  ( boxes           :: Boxes
  , chartReload     :: T2.ReloadS
  , documentsView   :: DocumentsView
  , frontends       :: Frontends
  , listId          :: Int
  , localCategories :: LocalCategories
  , mCorpusId       :: Maybe Int
  , mCurrentDocId   :: T.Box (Maybe Int)
  , nodeId          :: Int
  , session         :: Session
  , sidePanel       :: T.Box (Maybe (Record TextsT.SidePanel)) )

tableRow :: R2.Component TableRowProps
tableRow = R.createElement tableRowCpt
tableRowCpt :: R.Component TableRowProps
tableRowCpt = here.component "tableRow" cpt where
  cpt { boxes
      , chartReload
      , documentsView: dv@(DocumentsView r@{ _id, category })
      , frontends
      , listId
      , localCategories
      , mCorpusId
      , mCurrentDocId
      , nodeId
      , session
      , sidePanel } _ = do
    mCurrentDocId' <- T.useLive T.unequal mCurrentDocId

    let cat :: Category
        cat         = fromMaybe category (localCategories ^. at _id)
        selected   = mCurrentDocId' == Just r._id
641
        sid = sessionId session
642
        corpusDocument
643
          | Just cid <- mCorpusId = Routes.CorpusDocument sid cid listId
644
          | otherwise = Routes.Document sid listId
645 646 647 648 649 650 651 652 653 654 655 656 657 658 659

    categoryS <- T.useBox cat
    categoryS' <- T.useLive T.unequal categoryS

    let tClassName = trashClassName categoryS' selected

    pure $ TT.makeRow' { className: "page-paint-raw " <>
                         (selected ?
                          "page-paint-raw--selected" $
                          ""
                         )
                       }
      [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
        H.div { className: "" }
        [ docChooser { boxes
660 661
                     , category: categoryS
                     , docId: r._id
662 663 664
                     , listId
                     , mCorpusId
                     , nodeId: r._id
665
                     , session
666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697
                     , sidePanel } []
        ]
        --, H.div { className: "column-tag flex" } [ caroussel { category: cat, nodeId, row: dv, session, setLocalCategories } [] ]
      , H.div { className: "column-tag flex" }
        [ ratingSimple { -- chartReload
                         docId: _id
                       , category: categoryS
                       , corpusId: nodeId
                       -- , row: dv
                       , session
                       -- , setLocalCategories: \lc -> T.modify_ lc localCategories
                       } [] ]
        --, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
        -- TODO show date: Year-Month-Day only
      , H.div { className: tClassName } [ R2.showText r.date ]
      ,
        H.div
        { className: tClassName }
        [
          H.a
          { href: url frontends $ corpusDocument r._id
          , target: "_blank"
          , className: "text-primary"
          }
          [ H.text r.title
          , H.i { className: "fa fa-external-link mx-1 small" } []
          ]
        ]
      , H.div { className: tClassName } [ H.text $ showSource r.source ]
      , H.div {} [ H.text $ maybe "-" show r.ngramCount ]
      ]

698

699
type DocChooser = (
700 701 702 703 704 705 706 707
    boxes     :: Boxes
  , category  :: T.Box Category
  , docId     :: Int
  , listId    :: ListId
  , mCorpusId :: Maybe NodeID
  , nodeId    :: NodeID
  , session   :: Session
  , sidePanel :: T.Box (Maybe (Record TextsT.SidePanel))
708 709 710 711 712
  )

docChooser :: R2.Component DocChooser
docChooser = R.createElement docChooserCpt
docChooserCpt :: R.Component DocChooser
713
docChooserCpt = here.component "docChooser" cpt
714 715 716 717
  where
    cpt { mCorpusId: Nothing } _ = do
      pure $ H.div {} []

718
    cpt { boxes: { sidePanelState }
719 720
        , category
        , docId
721
        , listId
722 723
        , mCorpusId: Just corpusId
        , nodeId
724
        , session
725
        , sidePanel } _ = do
726 727 728 729
      mCurrentDocId <- T.useFocused
            (maybe Nothing _.mCurrentDocId)
            (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
      mCurrentDocId' <- T.useLive T.unequal mCurrentDocId
730
      category' <- T.useLive T.unequal category
731

732
      let selected = mCurrentDocId' == Just nodeId
733 734
          eyeClass = selected ? "eye" $ "eye-slash"
          variant = selected ? Info $ Dark
735

736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757
          onClick selected _ = do
            -- here.log2 "[docChooser] onClick, listId" listId
            -- here.log2 "[docChooser] onClick, corpusId" corpusId
            -- here.log2 "[docChooser] onClick, nodeId" nodeId
            -- R2.callTrigger triggerAnnotatedDocIdChange { corpusId, listId, nodeId }
            -- T2.reload tableReload
            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
              let categoryMarked = markCategoryChecked category'
              launchAff_ $ do
                _ <- updateNodeContextCategory session docId corpusId $ cat2score categoryMarked
                pure unit
              T.write_ categoryMarked category
              -- here.log2 "[docChooser] sidePanel opened" sidePanelState

758 759
      pure $
        H.div
760
        { className: "doc-chooser text-center" }
761 762 763 764 765 766 767
        [
          B.iconButton
          { name: eyeClass
          , overlay: false
          , variant
          , callback: onClick selected
          }
768 769
      ]

770

771 772 773
newtype SearchQuery = SearchQuery {
    parent_id :: Int
  , query :: Array String
774
  }
775 776 777
derive instance Generic SearchQuery _
derive instance Newtype SearchQuery _
derive newtype instance JSON.ReadForeign SearchQuery
778 779


780 781
documentsRoute :: Int -> SessionRoute
documentsRoute nodeId = NodeAPI Node (Just nodeId) "documents"
782

783 784
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)
785 786 787 788

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

Nicolas Pouillard's avatar
Nicolas Pouillard committed
789 790 791
tableRouteWithPage :: forall row.
                      { listId :: Int
                      , nodeId :: Int
792
                      , params :: TT.Params
Nicolas Pouillard's avatar
Nicolas Pouillard committed
793 794
                      , query ::  Query
                      , tabType :: TabType
795
                      , yearFilter :: Maybe Year
Nicolas Pouillard's avatar
Nicolas Pouillard committed
796
                      | row } -> SessionRoute
797 798
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]
799 800 801 802
  where
    lmt = queryParam "limit" limit
    lst = queryParam "list" listId
    ofs = queryParam "offset" offset
803
    odb = mQueryParamS "orderBy" TT.orderByToForm orderBy
804 805 806
    st  = queryParam "searchType" searchType
    tt  = queryParamS "tabType" (showTabType' tabType)
    q   = queryParamS "query" query
807
    y   = mQueryParamS' "year" yearFilter
808

809
deleteAllDocuments :: Session -> Int -> AffRESTError (Array Int)
810
deleteAllDocuments session = delete session <<< documentsRoute
811 812 813 814 815 816

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