DocsTable.purs 25.3 KB
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 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 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 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 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720
-- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.DocsTable where

import Gargantext.Prelude

import DOM.Simple.Event as DE
import Data.Array (any)
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Lens ((^.))
import Data.Lens.At (at)
import Data.Lens.Record (prop)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
import Data.Newtype (class Newtype)
import Data.Ord.Down (Down(..))
import Data.Set (Set)
import Data.Set as Set
import Data.String as Str
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Effect.Timer (setTimeout)
import Gargantext.Components.App.Store (Boxes)
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (ComponentStatus(..), Variant(..))
import Gargantext.Components.Category (rating)
import Gargantext.Components.Category.Types (Star(..))
import Gargantext.Components.DocsTable.DocumentFormCreation as DFC
import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), Year, sampleData, showSource)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Components.Reload (textsReloadContext)
import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT
import Gargantext.Config.REST (AffRESTError, logRESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..))
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, get, delete)
import Gargantext.Types (ListId, NodeID, NodeType(..), OrderBy(..), SidePanelState(..), TabSubType, TabType, TableResult, showTabType')
import Gargantext.Types as GT
import Gargantext.Utils (sortWith, (?))
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParam, mQueryParamS, queryParam, queryParamS)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as GUT
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record.Extra as RX
import Simple.JSON as JSON
import Toestand as T

here :: R2.Here
here = R2.here "Gargantext.Components.DocsTable"

type TotalRecords = Int

type Path a =
  ( corpusId  :: Int
  , listId    :: Int
  , frontends :: Frontends
  , session   :: Session
  , tabType   :: TabSubType a
  )

type CommonProps =
  ( boxes          :: Boxes
  , cacheState     :: T.Box NT.CacheState
  , chartReload :: T2.ReloadS
  , frontends      :: Frontends
  , listId         :: Int
  , mCorpusId      :: Maybe Int
  , nodeId         :: Int
  , session        :: Session
  , sidePanel      :: T.Box (Maybe (Record TextsT.SidePanel))
  , tabType        :: TabType
  -- ^ tabType is not ideal here since it is too much entangled with tabs and
  -- ngramtable. Let's see how this evolves.  )
  , totalRecords   :: Int
  , yearFilter     :: T.Box (Maybe Year)
  )

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

type PageLayoutProps =
  ( params :: TT.Params
  , query  :: Query
  | CommonProps
  )

_documentIdsDeleted  = prop (SProxy :: SProxy "documentIdsDeleted")
_localCategories     = prop (SProxy :: SProxy "localCategories")

docViewLayout :: Record LayoutProps -> R.Element
docViewLayout props = R.createElement docViewLayoutCpt props []
docViewLayoutCpt :: R.Component LayoutProps
docViewLayoutCpt = here.component "docViewLayout" cpt
  where
    cpt layout _children = do
      query <- T.useBox ""
      let params = TT.initialParams
      pure $ docView { layout, params, query } []

type Props = (
    layout :: Record LayoutProps
  , params :: TT.Params
  , query  :: T.Box Query
  )

docView :: R2.Component Props
docView = R.createElement docViewCpt
docViewCpt :: R.Component Props
docViewCpt = here.component "docView" cpt where
  cpt { layout: { boxes
                , cacheState
                , chart
                , chartReload
                , frontends
                , listId
                , mCorpusId
                , nodeId
                , session
                , showSearch
                , sidePanel
                , tabType
                , totalRecords
                , yearFilter
                }
      , params
      , query
      } _ = do
    -- State
    cacheState' <- T.useLive T.unequal cacheState
    query' <- T.useLive T.unequal query
    isDocumentModalVisibleBox <- T.useBox false
    onDocumentCreationPending /\ onDocumentCreationPendingBox <-
      R2.useBox' false

    -- Context
    mReloadContext <- R.useContext textsReloadContext

    -- @toggleModalCallback
    toggleModal <- pure $ const $
      T.modify_ not isDocumentModalVisibleBox

    -- @onCreateDocumentEnd <AsyncProgress>
    onCreateDocumentEnd <- pure $ \asyncProgress -> do
      here.log2 "[DocsTables] NodeDocument task:" asyncProgress
      T.write_ false onDocumentCreationPendingBox
      toggleModal unit

      case mReloadContext of
        Nothing -> pure unit
        Just b  -> T2.reload b

    -- @createDocumentCallback
    createDocumentCallback <- pure $ \fdata -> launchAff_ do

      liftEffect $
        T.write_ true onDocumentCreationPendingBox

      eTask <- DFC.create session nodeId fdata

      handleRESTError boxes.errors eTask
        \t -> liftEffect $ launchDocumentCreationProgress
                              boxes
                              session
                              nodeId
                              t
                              onCreateDocumentEnd

    -- Render
    pure $

      R.fragment
      [
        H.div { className: "doc-table-doc-view" }
        [ R2.row
          [ chart
          , if showSearch then searchBar { query } [] else H.div {} []
          , H.div
            { className: "col-md-12 row mb-3" }
            [
              H.div { className: "col-md-4" } []
            ,
              H.button
              { className: "btn btn-light col-md-3"
              , on: { click: toggleModal }
              }
              [
                H.text "Add a document"
              ]
            ]
          , H.div {className: "col-md-12"}
            [ pageLayout { boxes
                         , cacheState
                         , chartReload
                         , frontends
                         , key: "docView-" <> (show cacheState')
                         , listId
                         , mCorpusId
                         , nodeId
                         , params
                         , query: query'
                         , session
                         , sidePanel
                         , tabType
                         , totalRecords
                         , yearFilter
                         } []
            ]
          ]
        ]
      ,
        -- Document Creation Modal
        B.baseModal
        { isVisibleBox: isDocumentModalVisibleBox
        , title: "Add a new document"
        , hasCollapsibleBackground: false
        }
        [
          DFC.documentFormCreation
          { callback: createDocumentCallback
          , status: onDocumentCreationPending ? Deferred $ Enabled
          }
        ]
      ]

launchDocumentCreationProgress ::
     Boxes
  -> Session
  -> GT.ID
  -> GT.AsyncTaskWithType
  -> (GT.AsyncProgress -> Effect Unit)
  -> Effect Unit
launchDocumentCreationProgress boxes session nodeId currentTask cbk
  = void $ setTimeout 1000 $ launchAff_ $
      scanDocumentCreationProgress boxes session nodeId currentTask cbk

scanDocumentCreationProgress ::
     Boxes
  -> Session
  -> GT.ID
  -> GT.AsyncTaskWithType
  -> (GT.AsyncProgress -> Effect Unit)
  -> Aff Unit
scanDocumentCreationProgress boxes session nodeId currentTask cbk = do

  eTask <- DFC.createProgress session nodeId currentTask

  handleRESTError boxes.errors eTask
    \asyncProgress -> liftEffect do
      let
        GT.AsyncProgress { status } = asyncProgress
        endingStatusList =
          [ GT.IsFinished
          , GT.IsKilled
          , GT.IsFailure
          ]
        hasEndingStatus s = any (_ # s # eq) endingStatusList

      if (hasEndingStatus status)
      then
        cbk asyncProgress
      else
        launchDocumentCreationProgress boxes session nodeId currentTask cbk

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

type SearchBarProps =
  ( query :: T.Box Query )

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

      pure $ H.div {className: "col-md-12 row"}
        [ H.div {className: "col-md-3"} []
        , H.div {className: "col-md-1"} [if query' /= "" then (clearButton query) else H.div {} []]
        , H.div {className: "col-md-3 form-group"}
          [ H.input { className: "form-control"
                    , defaultValue: query'
                    , on: { change: onSearchChange queryText
                          , keyUp: onSearchKeyup query queryText' }
                    , placeholder: query'
                    , type: "text" }
          ]
        , H.div {className: "col-md-1"} [ searchButton query queryText' ]
        ]

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

    onSearchKeyup :: T.Box Query -> Query -> DE.KeyboardEvent -> Effect Unit
    onSearchKeyup query queryText e =
      if DE.key e == "Enter" then
        T.write_ queryText query
      else
        pure unit

    searchButton query queryText' =
      H.button { className: "btn btn-primary"
               , on: { click: \_ -> T.write_ queryText' query }
               , type: "submit" }
        [ H.span {className: "fa fa-search"} [] ]

    clearButton query =
      H.button { className: "btn btn-danger"
               , on: { click: \_ -> T.write_ "" query } }
        [ H.span {className: "fa fa-times"} [] ]

mock :: Boolean
mock = false

type PageParams = {
    listId      :: Int
  , mCorpusId   :: Maybe Int
  , nodeId      :: Int
  , tabType     :: TabType
  , query       :: Query
  , params      :: TT.Params
  , yearFilter  :: Maybe Year
  }

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

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
convOrderBy _ = Nothing

res2corpus :: Response -> DocumentsView
res2corpus (Response r) =
  DocumentsView { _id : r.cid
  , category   : r.category
  , date       : (\(Hyperdata hr) -> hr.pub_year) r.hyperdata
  , ngramCount : r.ngramCount
  , score      : r.score
  , source     : (\(Hyperdata hr) -> hr.source) r.hyperdata
  , title      : (\(Hyperdata hr) -> hr.title) r.hyperdata
  , url        : ""
}

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

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

-- NOTE "key": Necessary to clear the component when cache state changes
pageLayout :: R2.Component ( key :: String | PageLayoutProps )
pageLayout = R.createElement pageLayoutCpt
pageLayoutCpt :: R.Component ( key :: String | PageLayoutProps )
pageLayoutCpt = here.component "pageLayout" cpt where
  cpt props@{ boxes
            , cacheState
            , listId
            , mCorpusId
            , nodeId
            , params
            , query
            , session
            , tabType
            , yearFilter
            } _ = do
    cacheState' <- T.useLive T.unequal cacheState
    yearFilter' <- T.useLive T.unequal yearFilter

    let props' = (RX.pick props :: Record PageLayoutProps)

    let path = { listId, mCorpusId, nodeId, params, query, tabType, yearFilter: yearFilter' }
        handleResponse :: HashedResponse (TableResult Response) -> Tuple Int (Array DocumentsView)
        handleResponse (HashedResponse { value: res }) = ret
          where
            filterDocs' q ds = case cacheState' of
              NT.CacheOff -> ds
              NT.CacheOn -> filterDocs q ds
            filters = filterDocs' query
                    >>> \res' -> case yearFilter' of
                      Nothing -> res'
                      Just year -> filterDocsByYear year res'

            docs = res2corpus <$> filters res.docs

            ret = if mock then
                      --Tuple 0 (take limit $ drop offset sampleData)
                      Tuple 0 sampleData
                    else
                      Tuple res.count docs

    case cacheState' of
      NT.CacheOn -> do
        let paint (Tuple count docs) = page { boxes
                                            , documents: docs
                                            , layout: props' { totalRecords = count }
                                            , params } []
            mkRequest :: PageParams -> GUC.Request
            mkRequest p = GUC.makeGetRequest session $ tableRoute p

        useLoaderWithCacheAPI
          { boxes
          , cacheEndpoint: getPageHash session
          , handleResponse
          , mkRequest
          , path
          , renderer: paint
          , spinnerClass: Nothing
          }
      NT.CacheOff -> do
        localCategories <- T.useBox (Map.empty :: LocalUserScore)
        paramsS <- T.useBox params
        paramsS' <- T.useLive T.unequal paramsS
        let loader p = do
              let route = tableRouteWithPage (p { params = paramsS', query = query })
              eRes <- get session $ route
              --liftEffect $ do
              --  here.log2 "table route" route
              --  here.log2 "table res" eRes
              pure $ handleResponse <$> eRes
        let render (Tuple count documents) = pagePaintRaw { documents
                                                          , layout: props' { params = paramsS'
                                                                           , totalRecords = count }
                                                          , localCategories
                                                          , params: paramsS } []
        let errorHandler = logRESTError here "[pageLayout]"
        useLoader { errorHandler
                  , path: path { params = paramsS' }
                  , loader
                  , render }

type PageProps =
  ( boxes     :: Boxes
  , documents :: Array DocumentsView
  , layout    :: Record PageLayoutProps
  , params    :: TT.Params
  )

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

    pure $ pagePaint { documents, layout, params: paramsS } []

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

pagePaint :: R2.Component PagePaintProps
pagePaint = R.createElement pagePaintCpt
pagePaintCpt :: R.Component PagePaintProps
pagePaintCpt = here.component "pagePaintCpt" cpt
  where
    cpt { documents, layout, params } _ = do
      params' <- T.useLive T.unequal params

      localCategories <- T.useBox (Map.empty :: LocalUserScore)
      pure $ pagePaintRaw { documents: A.fromFoldable (filteredRows params')
                          , layout
                          , localCategories
                          , params } []
        where
          orderWith { orderBy } =
            case convOrderBy orderBy of
              Just DateAsc    -> sortWith \(DocumentsView { date })   -> date
              Just DateDesc   -> sortWith \(DocumentsView { date })   -> Down date
              Just SourceAsc  -> sortWith \(DocumentsView { source }) -> Str.toLower $ fromMaybe "" source
              Just SourceDesc -> sortWith \(DocumentsView { source }) -> Down $ Str.toLower $ fromMaybe "" 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
          filteredRows params' = TT.filterRows { params: params' } $ (orderWith params') $ A.toUnfoldable documents


type PagePaintRawProps =
  ( documents       :: Array DocumentsView
  , layout          :: Record PageLayoutProps
  , localCategories :: T.Box LocalUserScore
  , params          :: T.Box TT.Params
  )

pagePaintRaw :: R2.Component PagePaintRawProps
pagePaintRaw = R.createElement pagePaintRawCpt
pagePaintRawCpt :: R.Component PagePaintRawProps
pagePaintRawCpt = here.component "pagePaintRaw" cpt where
  cpt { documents
      , layout: { boxes
                , chartReload
                , frontends
                , listId
                , mCorpusId
                , nodeId
                , session
                , sidePanel
                , totalRecords }
      , localCategories
      , params } _ = do
    mCurrentDocId <- T.useFocused
          (maybe Nothing _.mCurrentDocId)
          (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
    mCurrentDocId' <- T.useLive T.unequal mCurrentDocId

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

    let
      selected = mCurrentDocId' == Just nodeId

    pure $ TT.table
      { colNames
      , container: TT.defaultContainer
      , params
      , rows: rows reload chartReload localCategories' mCurrentDocId'
      , syncResetButton : [ H.div {} [] ]
      , totalRecords
      , wrapColElts
      }
      where
        sid = sessionId session
        trashClassName Star_0 _ = "page-paint-row page-paint-row--trash"
        trashClassName _ true   = "page-paint-row page-paint-row--active"
        trashClassName _ false  = ""
        corpusDocument
          | Just cid <- mCorpusId = Routes.CorpusDocument sid cid listId
          | otherwise = Routes.Document sid listId
        colNames = TT.ColumnName <$> [ "Show", "Tag", "Date", "Title", "Source", "Score" ]
        wrapColElts = const identity
        rows reload chartReload localCategories' mCurrentDocId' = row <$> A.toUnfoldable documents
          where
            row dv@(DocumentsView r@{ _id, category }) =
              { row:
                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
                                               , listId
                                               , mCorpusId
                                               , nodeId: r._id
                                               , sidePanel } []
                                  ]
                          --, H.div { className: "column-tag flex" } [ caroussel { category: cat, nodeId, row: dv, session, setLocalCategories } [] ]
                          , H.div { className: "column-tag flex" }
                                  [ rating { chartReload
                                           , nodeId
                                           , row: dv
                                           , score: cat
                                           , setLocalCategories: \lc -> T.modify_ lc localCategories
                                           , session } [] ]
                --, 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.div { className: tClassName } [ H.text $ showSource r.source ]
                , H.div {} [ H.text $ maybe "-" show r.ngramCount ]
                ]
              , delete: true }
              where
                cat         = fromMaybe category (localCategories' ^. at _id)
                -- checked    = Star_1 == cat
                selected   = mCurrentDocId' == Just r._id
                tClassName = trashClassName cat selected

type DocChooser = (
    boxes :: Boxes
  , listId         :: ListId
  , mCorpusId      :: Maybe NodeID
  , nodeId         :: NodeID
  , sidePanel      :: T.Box (Maybe (Record TextsT.SidePanel))
  )

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

    cpt { boxes: { sidePanelState }
        , listId
        , mCorpusId: Just corpusId
        , nodeId
        , sidePanel } _ = do
      mCurrentDocId <- T.useFocused
            (maybe Nothing _.mCurrentDocId)
            (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
      mCurrentDocId' <- T.useLive T.unequal mCurrentDocId

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

      pure $
        H.div
        { className: "doc-chooser" }
        [
          B.iconButton
          { name: eyeClass
          , overlay: false
          , variant
          , callback: onClick selected
          }
      ]
      where
        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
          here.log2 "[docChooser] sidePanel opened" sidePanelState


newtype SearchQuery = SearchQuery {
    parent_id :: Int
  , query :: Array String
  }
derive instance Generic SearchQuery _
derive instance Newtype SearchQuery _
derive newtype instance JSON.ReadForeign SearchQuery


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

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)

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

tableRouteWithPage :: forall row.
                      { listId :: Int
                      , nodeId :: Int
                      , params :: TT.Params
                      , query ::  Query
                      , tabType :: TabType
                      , yearFilter :: Maybe Year
                      | row } -> SessionRoute
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]
  where
    lmt = queryParam "limit" limit
    lst = queryParam "list" listId
    ofs = queryParam "offset" offset
    odb = mQueryParamS "orderBy" TT.orderByToForm orderBy
    st  = queryParam "searchType" searchType
    tt  = queryParamS "tabType" (showTabType' tabType)
    q   = queryParamS "query" query
    y   = mQueryParam "year" yearFilter

deleteAllDocuments :: Session -> Int -> AffRESTError (Array Int)
deleteAllDocuments session = delete session <<< documentsRoute

-- TODO: not optimal but Data.Set lacks some function (Set.alter)
toggleSet :: forall a. Ord a => a -> Set a -> Set a
toggleSet a s
  | Set.member a s = Set.delete a s
  | otherwise      = Set.insert a s