Merge branch 'dev-doc-table-optimization' of...

Merge branch 'dev-doc-table-optimization' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge

src/Gargantext/Components/DocsTable.purs

 -- TODO: this module should be replaced by FacetsTable
 module Gargantext.Components.DocsTable where
 
-import Prelude
 import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>), encodeJson)
-import Data.Array (drop, take)
+import Data.Array as A
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Eq (genericEq)
 import Data.Generic.Rep.Show (genericShow)
@@ -14,8 +13,10 @@ import Data.List as L
 import Data.Map (Map)
 import Data.Map as Map
 import Data.Maybe (Maybe(..), maybe, fromMaybe)
+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(..), fst)
 import Data.Tuple.Nested ((/\))
@@ -27,14 +28,17 @@ import Effect.Class (liftEffect)
 import Reactix as R
 import Reactix.DOM.HTML as H
 ------------------------------------------------------------------------
+import Gargantext.Prelude
+
 import Gargantext.Components.Table as T
-import Gargantext.Components.Loader (loader)
 import Gargantext.Ends (Frontends, url)
+import Gargantext.Hooks.Loader (useLoader, useLoaderWithCache, HashedResponse(..))
+import Gargantext.Utils.List (sortWith) as L
 import Gargantext.Utils.Reactix as R2
 import Gargantext.Routes as Routes
 import Gargantext.Routes (SessionRoute(NodeAPI))
-import Gargantext.Sessions (Session, sessionId, post, delete, put)
-import Gargantext.Types (NodeType(..), OrderBy(..), TabType, TabPostQuery(..), AffTableResult)
+import Gargantext.Sessions (Session, sessionId, get, post, delete, put)
+import Gargantext.Types (NodeType(..), OrderBy(..), TableResult, TabType, TabPostQuery(..), AffTableResult, showTabType')
 ------------------------------------------------------------------------
 
 data Category = Trash | UnRead | Checked | Topic | Favorite
@@ -47,6 +51,10 @@ instance showCategory :: Show Category where
   show = genericShow
 instance eqCategory :: Eq Category where
   eq = genericEq
+instance decodeJsonCategory :: DecodeJson Category where
+  decodeJson json = do
+    obj <- decodeJson json
+    pure $ decodeCategory obj
 instance encodeJsonCategory :: EncodeJson Category where
   encodeJson cat    = encodeJson (cat2score cat)
 
@@ -88,8 +96,8 @@ caroussel session nodeId setLocalCategories r cat = H.div {className:"flex"} div
                     ) (caroussel' cat)
 
     caroussel' :: Category -> Array Category
-    caroussel' Trash = take 2 categories
-    caroussel' c   = take 3 $ drop (cat2score c - 1 ) categories
+    caroussel' Trash = A.take 2 categories
+    caroussel' c   = A.take 3 $ A.drop (cat2score c - 1 ) categories
 
     onClick c = \_-> do
       setLocalCategories $ Map.insert r._id c
@@ -168,7 +176,7 @@ type PageLayoutProps =
   , query        :: Query
   , session      :: Session
   , frontends    :: Frontends
-  , params       :: R.State T.Params )
+  , params       :: T.Params )
 
 type LocalCategories = Map Int Category
 type Query = String
@@ -182,19 +190,39 @@ data Action
 newtype DocumentsView
   = DocumentsView
     { _id    :: Int
-    , url    :: String
-    , date   :: Int
-    , title  :: String
-    , source :: String
     , category :: Category
+    , date   :: Int
     , ngramCount :: Int
+    , source :: String
+    , title  :: String
+    , url    :: String
     }
 
 
 derive instance genericDocumentsView :: Generic DocumentsView _
-
 instance showDocumentsView :: Show DocumentsView where
   show = genericShow
+instance decodeDocumentsView :: DecodeJson DocumentsView where
+  decodeJson json = do
+    obj <- decodeJson json
+    _id <- obj .: "id"
+    category <- obj .: "category"
+    date <- obj .: "date"
+    ngramCount <- obj .: "ngramCount"
+    source <- obj .: "source"
+    title <- obj .: "title"
+    url <- obj .: "url"
+    pure $ DocumentsView { _id, category, date, ngramCount, source, title, url }
+instance encodeDocumentsView :: EncodeJson DocumentsView where
+  encodeJson (DocumentsView dv) = 
+       "id" := dv._id
+    ~> "category" := dv.category
+    ~> "date" := dv.date
+    ~> "ngramCount" := dv.ngramCount
+    ~> "source" := dv.source
+    ~> "title" := dv.title
+    ~> "url" := dv.url
+    ~> jsonEmptyObject
 
 
 newtype Response = Response
@@ -238,13 +266,14 @@ docViewLayoutCpt = R.hooksComponent "G.C.DocsTable.docViewLayout" cpt
   where
     cpt layout _children = do
       query <- R.useState' ""
-      params <- R.useState' T.initialParams
+      let params = T.initialParams
       pure $ docView {query, params, layout}
 
-type Props =
-  ( query :: R.State Query
-  , params :: R.State T.Params
-  , layout :: Record LayoutProps )
+type Props = (
+    layout :: Record LayoutProps
+  , params :: T.Params
+  , query :: R.State Query
+   )
 
 docView :: Record Props -> R.Element
 docView props = R.createElement docViewCpt props []
@@ -328,24 +357,19 @@ type PageParams =
   , query   :: Query
   , params :: T.Params}
 
-loadPage :: Session -> PageParams -> Aff (Tuple Int (Array DocumentsView))
-loadPage session {nodeId, tabType, query, listId, corpusId, params: {limit, offset, orderBy}} = do
-  liftEffect $ log3 "loading documents page: loadPage with Offset and limit" offset limit
+loadPage :: Session -> PageParams -> Aff (HashedResponse (Tuple Int (Array DocumentsView)))
+loadPage session { corpusId, listId, nodeId, query, tabType } = do
+  --liftEffect $ log3 "loading documents page: loadPage with Offset and limit" offset limit
   -- res <- get $ toUrl endConfigStateful Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId)
-  let p = NodeAPI Node (Just nodeId) "table"
-  res <- (post session p $ TabPostQuery {
-      offset
-    , limit
-    , orderBy: convOrderBy orderBy
-    , tabType
-    , query
-    }) :: AffTableResult Response
+  let p = NodeAPI Node (Just nodeId) $ "table" <> "?tabType=" <> (showTabType' tabType)
+  HashedResponse { md5, value: res } <- (get session p) :: Aff (HashedResponse (TableResult Response))
   let docs = res2corpus <$> res.docs
-  pure $
-    if mock then
-      Tuple 0 (take limit $ drop offset sampleData)
+  let ret = if mock then
+              --Tuple 0 (take limit $ drop offset sampleData)
+              Tuple 0 sampleData
             else
               Tuple res.count docs
+  pure $ HashedResponse { md5, value: ret }
   where
     res2corpus :: Response -> DocumentsView
     res2corpus (Response r) =
@@ -357,37 +381,63 @@ loadPage session {nodeId, tabType, query, listId, corpusId, params: {limit, offs
       , category : r.category
       , ngramCount : r.ngramCount
      }
-    convOrderBy (Just (T.ASC  (T.ColumnName "Date")))  = DateAsc
-    convOrderBy (Just (T.DESC (T.ColumnName "Date")))  = DateDesc
-    convOrderBy (Just (T.ASC  (T.ColumnName "Title"))) = TitleAsc
-    convOrderBy (Just (T.DESC (T.ColumnName "Title"))) = TitleDesc
-    convOrderBy (Just (T.ASC  (T.ColumnName "Source"))) = SourceAsc
-    convOrderBy (Just (T.DESC (T.ColumnName "Source"))) = SourceDesc
 
-    convOrderBy _ = DateAsc -- TODO
+getPageMD5 :: Session -> PageParams -> Aff String
+getPageMD5 session { corpusId, listId, nodeId, query, tabType } = do
+  let p = NodeAPI Node (Just nodeId) $ "table/md5" <> "?tabType=" <> (showTabType' tabType)
+  (get session p) :: Aff String
+
+
+convOrderBy (Just (T.ASC  (T.ColumnName "Date")))  = Just DateAsc
+convOrderBy (Just (T.DESC (T.ColumnName "Date")))  = Just DateDesc
+convOrderBy (Just (T.ASC  (T.ColumnName "Title"))) = Just TitleAsc
+convOrderBy (Just (T.DESC (T.ColumnName "Title"))) = Just TitleDesc
+convOrderBy (Just (T.ASC  (T.ColumnName "Source"))) = Just SourceAsc
+convOrderBy (Just (T.DESC (T.ColumnName "Source"))) = Just SourceDesc
+convOrderBy _ = Nothing
 
 pageLayout :: Record PageLayoutProps -> R.Element
 pageLayout props = R.createElement pageLayoutCpt props []
 
-pageLayoutCpt :: R.Memo PageLayoutProps
-pageLayoutCpt = R.memo' $ R.staticComponent "G.C.DocsTable.pageLayout" cpt where
+pageLayoutCpt :: R.Component PageLayoutProps
+pageLayoutCpt = R.hooksComponent "G.C.DocsTable.pageLayout" cpt where
   cpt props@{frontends, session, nodeId, listId, corpusId, tabType, query, params} _ =
-    loader path (loadPage session) paint
+    -- useLoader path (loadPage session) paint
+    useLoaderWithCache path keyFunc (getPageMD5 session) (loadPage session) paint
     where
-      path = {nodeId, listId, corpusId, tabType, query, params: fst params}
+      path = { nodeId, listId, corpusId, tabType, query, params }
       paint (Tuple count docs) = page params (newProps count) docs
       newProps count = props { totalRecords = count }
 
-type PageProps =
-  ( params :: R.State T.Params
+      keyFunc { corpusId, listId, nodeId, tabType } =
+       "page-" <> (show tabType) <> "-" <> (show corpusId) <> "-" <> (show nodeId) <> "-" <> (show listId)
+
+type PageProps = (
+    documents :: Array DocumentsView
   , layout :: Record PageLayoutProps
-  , documents :: Array DocumentsView )
+  , params :: T.Params
+  )
 
-page ::  R.State T.Params -> Record PageLayoutProps -> Array DocumentsView -> R.Element
+page :: T.Params -> Record PageLayoutProps -> Array DocumentsView -> R.Element
 page params layout documents = R.createElement pageCpt {params, layout, documents} []
 
-pageCpt :: R.Memo PageProps
-pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where
+pageCpt :: R.Component PageProps
+pageCpt = R.hooksComponent "G.C.DocsTable.pageCpt" cpt where
+  cpt { documents, layout, params } _ = do
+    paramsS <- R.useState' params
+    pure $ pagePaint { documents, layout, params: paramsS }
+
+type PagePaintProps = (
+    documents :: Array DocumentsView
+  , layout :: Record PageLayoutProps
+  , params :: R.State T.Params
+)
+
+pagePaint :: Record PagePaintProps -> R.Element
+pagePaint props = R.createElement pagePaintCpt props []
+
+pagePaintCpt :: R.Component PagePaintProps
+pagePaintCpt = R.hooksComponent "G.C.DocsTable.pagePaintCpt" cpt where
   cpt { layout: {frontends, session, nodeId, corpusId, listId, totalRecords}, documents, params } _ = do
     localCategories <- R.useState' (mempty :: LocalCategories)
     pure $ T.table
@@ -410,7 +460,17 @@ pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where
         colNames = T.ColumnName <$> [ "Tag", "Date", "Title", "Source"]
         wrapColElts = const identity
         getCategory (localCategories /\ _) {_id, category} = fromMaybe category (localCategories ^. at _id)
-        rows localCategories = row <$> documents
+        orderWith =
+          case convOrderBy (fst params).orderBy of
+            Just DateAsc    -> L.sortWith \(DocumentsView { date })   -> date
+            Just DateDesc   -> L.sortWith \(DocumentsView { date })   -> Down date
+            Just SourceAsc  -> L.sortWith \(DocumentsView { source }) -> Str.toLower source
+            Just SourceDesc -> L.sortWith \(DocumentsView { source }) -> Down $ Str.toLower source
+            Just TitleAsc   -> L.sortWith \(DocumentsView { title })  -> Str.toLower title
+            Just TitleDesc  -> L.sortWith \(DocumentsView { title })  -> Down $ Str.toLower title
+            _               -> identity -- the server ordering is enough here
+        filteredRows = T.filterRows { params: fst params } $ orderWith $ A.toUnfoldable documents
+        rows localCategories = row <$> filteredRows
           where
             row (DocumentsView r) =
               { row:

src/Gargantext/Components/Loader.purs

@@ -6,6 +6,7 @@ import Data.Tuple.Nested ((/\))
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
 import Reactix as R
+
 import Gargantext.Utils.Reactix as R2
 import Gargantext.Components.LoadingSpinner (loadingSpinner)
 

src/Gargantext/Components/NgramsTable.purs

@@ -34,7 +34,7 @@ import Gargantext.Components.NgramsTable.Components as NTC
 import Gargantext.Components.NgramsTable.Core
 import Gargantext.Components.NgramsTable.Loader (useLoaderWithVersionCache)
 import Gargantext.Components.Table as T
-import Gargantext.Hooks.Loader (useLoader)
+import Gargantext.Hooks.Loader (useLoaderWithCache)
 import Gargantext.Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (/=), (<$>), (<<<), (<>), (=<<), (==), (||), read)
 import Gargantext.Routes as R
 import Gargantext.Sessions (Session, get)
@@ -499,15 +499,6 @@ mainNgramsTableCpt = R.hooksComponent "G.C.NT.mainNgramsTable" cpt
 
       useLoaderWithVersionCache (pathNoLimit path) (keyFunc props) (versionEndpoint props) loadNgramsTable \versioned -> do
           mainNgramsTablePaint { path, tabNgramType, versioned, withAutoUpdate }
-      -- useLoaderWithVersionCache path (keyFunc props) (versionEndpoint props) loadNgramsTableAll \loaded -> do
-      -- useLoader path loadNgramsTableAll \loaded -> do
-      --   case Map.lookup tabType loaded of
-      --     Just (versioned :: VersionedNgramsTable) ->
-      --       mainNgramsTablePaint {path, tabNgramType, versioned, withAutoUpdate}
-      --     Nothing -> loadingSpinner {}
-
-      -- useLoader (pathNoLimit path) loadNgramsTable \versioned -> do
-      --   mainNgramsTablePaint { path, tabNgramType, versioned, withAutoUpdate }
 
     keyFunc { defaultListId, nodeId, tabType } _ =
       "ngrams-table-" <> (show tabType) <> "-" <> (show nodeId) <> "-" <> (show defaultListId)

src/Gargantext/Components/Nodes/Texts.purs

@@ -16,6 +16,7 @@ import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
 import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..), getCorpusInfo, CorpusInfo(..))
 import Gargantext.Components.Tab as Tab
 import Gargantext.Components.Table as Table
+import Gargantext.Hooks.Loader (useLoaderWithCache)
 import Gargantext.Ends (Frontends)
 import Gargantext.Sessions (Session)
 import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))

src/Gargantext/Types.purs

@@ -442,6 +442,39 @@ data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMo
 
 derive instance eqTabSubType :: Eq a => Eq (TabSubType a)
 derive instance ordTabSubType :: Ord a => Ord (TabSubType a)
+{- instance encodeTabSubType a :: EncodeJson a => EncodeJson (TabSubType a) where
+  encodeJson TabDocs =
+       "type" := "TabDocs"
+    ~> "data" := Nothing
+    ~> jsonEmptyObject
+  encodeJson (TabNgramType a) =
+       "type" := "TabNgramType"
+    ~> "data" := encodeJson a
+    ~> jsonEmptyObject
+  encodeJson TabTrash =
+       "type" := "TabTrash"
+    ~> "data" := Nothing
+    ~> jsonEmptyObject
+  encodeJson TabMoreLikeFav =
+       "type" := "TabMoreLikeFav"
+    ~> "data" := Nothing
+    ~> jsonEmptyObject
+  encodeJson TabMoreLikeTrash =
+       "type" := "TabMoreLikeTrash"
+    ~> "data" := Nothing
+    ~> jsonEmptyObject
+instance decodeTabSubType a :: DecodeJson a => DecodeJson (TabSubType a) where
+  decodeJson j = do
+    obj <- decodeJson j
+    typ <- obj .: "type"
+    dat <- obj .: "data"
+    case typ of
+      "TabDocs" -> TabDocs
+      "TabNgramType" -> TabNgramType dat
+      "TabTrash" -> TabTrash
+      "TabMoreLikeFav" -> TabMoreLikeFav
+      "TabMoreLikeTrash" -> TabMoreLikeTrash
+      _ -> Left ("Unknown type '" <> typ <> "'") -}
 
 instance showTabSubType :: Show a => Show (TabSubType a) where
   show TabDocs          = "Docs"
@@ -455,13 +488,34 @@ data TabType
   | TabPairing  (TabSubType PTabNgramType)
   | TabDocument (TabSubType CTabNgramType)    
 
+derive instance genericTabType :: Generic TabType _
 derive instance eqTabType :: Eq TabType
 derive instance ordTabType :: Ord TabType
-
-derive instance genericTabType :: Generic TabType _
-
 instance showTabType :: Show TabType where
   show = genericShow
+{- instance encodeTabType :: EncodeJson TabType where
+  encodeJson (TabCorpus d) = 
+       "type"  := "TabCorpus"
+    ~> "data"  := encodeJson d
+    ~> jsonEmptyObject
+  encodeJson (TabDocument d) = 
+       "type"  := "TabDocument"
+    ~> "data"  := encodeJson d
+    ~> jsonEmptyObject
+  encodeJson (TabPairing d) = 
+       "type"  := "TabPairing"
+    ~> "data"  := encodeJson d
+    ~> jsonEmptyObject
+instance decodeTabType :: DecodeJson TabType where
+  decodeJson j = do
+    obj <- decodeJson j
+    typ <- obj .: "type"
+    dat <- obj .: "data"
+    case typ of
+      "TabCorpus" -> TabCorpus dat
+      "TabDocument" -> TabDocument dat
+      "TabPairing" -> TabPairing dat
+      _ -> Left ("Unknown type '" <> typ <> "'") -}
 
 type TableResult a = {count :: Int, docs :: Array a}
 type AffTableResult a = Aff (TableResult a)