-- 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.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 as Store import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap.Types (ComponentStatus(..), ModalSizing(..), Variant(..)) import Gargantext.Components.Category (ratingSimple) import Gargantext.Components.Category.Types (Category(..), cat2score, markCategoryChecked) import Gargantext.Components.DocsTable.DocumentFormCreation as DFC import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalCategories, Query, Response(..), Year, sampleData, showSource) import Gargantext.Components.GraphQL.Endpoints (updateNodeContextCategory) import Gargantext.Components.Nodes.Lists.Types as NT import Gargantext.Components.Reload (textsReloadContext) import Gargantext.Components.Table as TT import Gargantext.Components.Table.Types as TT import Gargantext.Config.REST (AffRESTError) 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, mQueryParamS, 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 import Type.Proxy (Proxy(..)) 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 = ( cacheState :: T.Box NT.CacheState , chartReload :: T2.ReloadS , frontends :: Frontends , listId :: Int , mCorpusId :: Maybe Int , nodeId :: Int , session :: Session , 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 (Proxy :: Proxy "documentIdsDeleted") _localCategories = prop (Proxy :: Proxy "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 = R2.hereComponent here "docView" hCpt where hCpt hp { layout: { cacheState , chart , chartReload , frontends , listId , mCorpusId , nodeId , session , showSearch , tabType , totalRecords , yearFilter } , params , query } _ = do -- State { errors } <- Store.use 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 R2.hpLog2 hp "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 hp errors eTask \t -> liftEffect $ launchDocumentCreationProgress errors session nodeId t onCreateDocumentEnd -- Render pure $ R.fragment [ H.div { className: "doc-table-doc-view" } [ R2.row [ chart ] , H.div { className: "col d-flex mt-5 mb-2" } [ H.div { className: "doc-add-action" } [ H.button { 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"} [] ] ] , H.div { className: "form-group" } [ if showSearch then searchBar { query } [] else H.div {} [] ] ] , R2.row [ H.div {className: "col-md-12"} [ pageLayout { cacheState , chartReload , frontends , key: "docView-" <> (show cacheState') , listId , mCorpusId , nodeId , params , query: query' , session , tabType , totalRecords , yearFilter } [] ] ] ] , -- Document Creation Modal B.baseModal { isVisibleBox: isDocumentModalVisibleBox , title: Just "Add a new document" , hasCollapsibleBackground: false , size: LargeModalSize } [ DFC.documentFormCreation { callback: createDocumentCallback , status: onDocumentCreationPending ? Deferred $ Enabled } ] ] launchDocumentCreationProgress :: T.Box (Array GT.FrontendError) -> Session -> GT.ID -> GT.AsyncTaskWithType -> (GT.AsyncProgress -> Effect Unit) -> Effect Unit launchDocumentCreationProgress errors session nodeId currentTask cbk = void $ setTimeout 1000 $ launchAff_ $ scanDocumentCreationProgress errors session nodeId currentTask cbk scanDocumentCreationProgress :: T.Box (Array GT.FrontendError) -> Session -> GT.ID -> GT.AsyncTaskWithType -> (GT.AsyncProgress -> Effect Unit) -> Aff Unit scanDocumentCreationProgress errors session nodeId currentTask cbk = do eTask <- DFC.createProgress session nodeId currentTask handleRESTError (R2.herePrefix here "[scanDocumentCreationProgress]") errors eTask \asyncProgress -> liftEffect do let GT.AsyncProgress { status } = asyncProgress endingStatusList = [ GT.IsFinished , GT.IsKilled , GT.IsFailure ] hasEndingStatus s = any (eq s) endingStatusList if (hasEndingStatus status) then cbk asyncProgress else launchDocumentCreationProgress errors 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: "input-group px-5"} [ H.input { className: "form-control" , id: "docs-input-search" , defaultValue: query' , on: { change: onSearchChange queryText , keyUp: onSearchKeyup query queryText' } , placeholder: "Search in documents" , type: "text" } , H.div {className: "input-group-append"} [ if query' /= "" then R.fragment [ clearButton query , searchButton query queryText' ] else searchButton query queryText' ] -- , 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: "input-group-text btn btn-light text-secondary" , on: { click: \_ -> T.write_ queryText' query } , type: "submit" } [ H.span {className: "fa fa-search"} [] ] clearButton query = H.button { className: "input-group-text btn btn-light" , on: { click: \_ -> T.write_ "" query } } [ H.span {className: "text-danger 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 = R2.hereComponent here "pageLayout" hCpt where hCpt hp props@{ 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 { documents: docs , layout: props' { totalRecords = count } , params } [] mkRequest :: PageParams -> GUC.Request mkRequest p = GUC.makeGetRequest session $ tableRoute p useLoaderWithCacheAPI { cacheEndpoint: getPageHash session , handleResponse , mkRequest , path , renderer: paint , spinnerClass: Nothing } NT.CacheOff -> do localCategories <- T.useBox (Map.empty :: LocalCategories) 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 } [] useLoader { errorHandler: Nothing , herePrefix: hp , path: path { params = paramsS' } , loader , render } type PageProps = ( 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 :: LocalCategories) 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 LocalCategories , 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: { frontends , listId , mCorpusId , nodeId , session , totalRecords } , localCategories , params } _ = do { sidePanelTexts } <- Store.use mCurrentDocId <- T.useFocused (maybe Nothing _.mCurrentDocId) (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanelTexts reload <- T.useBox GUT.newReload localCategories' <- T.useLive T.unequal localCategories pure $ TT.table { colNames , container: TT.defaultContainer , params , rows: rows { reload , frontends , listId , localCategories: localCategories' , mCorpusId , mCurrentDocId , nodeId , session } , syncResetButton : [ H.div {} [] ] , totalRecords , wrapColElts } where colNames = TT.ColumnName <$> [ "Show", "Tag", "Date", "Title", "Source", "Score" ] wrapColElts = const identity rows { frontends , listId , localCategories , mCorpusId , mCurrentDocId , nodeId , session } = (\documentsView -> { row: tableRow { documentsView , frontends , listId , localCategories , mCorpusId , mCurrentDocId , nodeId , session } [] , 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 = ( documentsView :: DocumentsView , frontends :: Frontends , listId :: Int , localCategories :: LocalCategories , mCorpusId :: Maybe Int , mCurrentDocId :: T.Box (Maybe Int) , nodeId :: Int , session :: Session ) tableRow :: R2.Component TableRowProps tableRow = R.createElement tableRowCpt tableRowCpt :: R.Component TableRowProps tableRowCpt = here.component "tableRow" cpt where cpt { documentsView: DocumentsView r@{ _id, category } , frontends , listId , localCategories , mCorpusId , mCurrentDocId , nodeId , session } _ = do mCurrentDocId' <- T.useLive T.unequal mCurrentDocId let cat :: Category cat = fromMaybe category (localCategories ^. at _id) selected = mCurrentDocId' == Just r._id sid = sessionId session corpusDocument | Just cid <- mCorpusId = Routes.CorpusDocument sid cid listId | otherwise = Routes.Document sid listId 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 { category: categoryS , docId: r._id , listId , mCorpusId , nodeId: r._id , session } [] ] --, 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.score ] ] type DocChooser = ( category :: T.Box Category , docId :: Int , listId :: ListId , mCorpusId :: Maybe NodeID , nodeId :: NodeID , session :: Session ) 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 { category , docId , listId , mCorpusId: Just corpusId , nodeId , session } _ = do { sidePanelState, sidePanelTexts } <- Store.use mCurrentDocId <- T.useFocused (maybe Nothing _.mCurrentDocId) (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanelTexts mCurrentDocId' <- T.useLive T.unequal mCurrentDocId category' <- T.useLive T.unequal category let selected = mCurrentDocId' == Just nodeId eyeClass = selected ? "eye" $ "eye-slash" variant = selected ? Info $ Dark onClick sel _ = 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 sel then do T.write_ Nothing sidePanelTexts T.write_ Closed sidePanelState else do T.write_ (Just { corpusId: corpusId , listId: listId , mCurrentDocId: Just nodeId , nodeId: nodeId }) sidePanelTexts 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 pure $ H.div { className: "doc-chooser text-center" } [ B.iconButton { name: eyeClass , overlay: false , variant , callback: onClick selected } ] 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 = mQueryParamS' "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