[ngrams] ngram count aggregates now

src/Gargantext/API/Table.hs

@@ -48,8 +48,9 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
 import Gargantext.Database.Action.Search
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude -- (Cmd, CmdM)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
+import Gargantext.Database.Prelude -- (Cmd, CmdM)
 import Gargantext.Prelude
 
 ------------------------------------------------------------------------
@@ -100,7 +101,8 @@ tableApi id' = getTableApi id'
           :<|> getTableHashApi id'
 
 
-getTableApi :: NodeId
+getTableApi :: HasNodeError err
+            => NodeId
             -> Maybe TabType
             -> Maybe ListId
             -> Maybe Int
@@ -115,14 +117,16 @@ getTableApi cId tabType _mListId mLimit mOffset mOrderBy mQuery mYear = do
   t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear
   pure $ constructHashedResponse t
 
-postTableApi :: NodeId -> TableQuery -> Cmd err FacetTableResult
+postTableApi :: HasNodeError err
+             => NodeId -> TableQuery -> Cmd err FacetTableResult
 postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing Nothing
 postTableApi cId (TableQuery o l order ft q) = case ft of
       Docs  -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
       Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
       x     -> panic $ "not implemented in tableApi " <> (cs $ show x)
 
-getTableHashApi :: NodeId -> Maybe TabType -> Cmd err Text
+getTableHashApi :: HasNodeError err
+                => NodeId -> Maybe TabType -> Cmd err Text
 getTableHashApi cId tabType = do
   HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing Nothing
   pure h
@@ -140,7 +144,8 @@ searchInCorpus' cId t q o l order = do
   pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
 
 
-getTable :: NodeId
+getTable :: HasNodeError err
+         => NodeId
          -> Maybe TabType
          -> Maybe Offset
          -> Maybe Limit
@@ -153,7 +158,8 @@ getTable cId ft o l order query year = do
   docsCount <- runCountDocuments cId (ft == Just Trash) query year
   pure $ TableResult { tr_docs = docs, tr_count = docsCount }
 
-getTable' :: NodeId
+getTable' :: HasNodeError err
+          => NodeId
           -> Maybe TabType
           -> Maybe Offset
           -> Maybe Limit

src/Gargantext/Database/Action/Learn.hs

@@ -19,9 +19,10 @@ import Data.Maybe
 import Data.Text (Text)
 import Gargantext.Core
 import Gargantext.Core.Types (Offset, Limit)
-import Gargantext.Database.Query.Facet
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Query.Facet
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Prelude
 import Gargantext.Core.Text.Learn
@@ -32,7 +33,7 @@ data FavOrTrash = IsFav | IsTrash
   deriving (Eq)
 
 
-moreLike :: HasDBid NodeType
+moreLike :: (HasDBid NodeType, HasNodeError err)
          => CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
          -> FavOrTrash -> Cmd err [FacetDoc]
 moreLike cId o _l order ft = do
@@ -40,7 +41,8 @@ moreLike cId o _l order ft = do
   moreLikeWith cId o (Just 3) order ft priors
 
 ---------------------------------------------------------------------------
-getPriors :: HasDBid NodeType => FavOrTrash -> CorpusId -> Cmd err (Events Bool)
+getPriors :: (HasDBid NodeType, HasNodeError err)
+          => FavOrTrash -> CorpusId -> Cmd err (Events Bool)
 getPriors ft cId = do
 
   docs_fav   <- filter (\(FacetDoc _ _ _ _ f _ _) -> f == Just 2)
@@ -56,7 +58,7 @@ getPriors ft cId = do
   pure priors
 
 
-moreLikeWith :: HasDBid NodeType
+moreLikeWith :: (HasDBid NodeType, HasNodeError err)
              => CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
              -> FavOrTrash -> Events Bool  -> Cmd err [FacetDoc]
 moreLikeWith cId o l order ft priors = do

src/Gargantext/Database/Query/Facet.hs

@@ -10,6 +10,7 @@ Portability : POSIX
 
 {-# LANGUAGE Arrows                    #-}
 {-# LANGUAGE FunctionalDependencies    #-}
+{-# LANGUAGE LambdaCase                #-}
 {-# LANGUAGE QuasiQuotes               #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
 {-# LANGUAGE TemplateHaskell           #-}
@@ -19,7 +20,6 @@ module Gargantext.Database.Query.Facet
   ( runViewAuthorsDoc
   , runViewDocuments
   , viewDocuments
-  , viewDocuments'
   , runCountDocuments
   , filterWith
 
@@ -48,16 +48,17 @@ import qualified Opaleye.Internal.Unpackspec()
 import Gargantext.Core
 import Gargantext.Core.Types
 import Gargantext.Database.Query.Filter
-import Gargantext.Database.Query.Table.Ngrams
 import Gargantext.Database.Query.Table.Context
-import Gargantext.Database.Query.Facet.Types
 import Gargantext.Database.Query.Table.ContextNodeNgrams
+import Gargantext.Database.Query.Table.Ngrams
+import Gargantext.Database.Query.Table.Node (defaultList)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.NodeContext (queryNodeContextTable)
+import Gargantext.Database.Query.Facet.Types
 import Gargantext.Database.Prelude
 import Gargantext.Database.Schema.Context
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.NodeContext
-import Gargantext.Prelude (printDebug)
 
 ------------------------------------------------------------------------
 
@@ -116,7 +117,7 @@ queryAuthorsDoc = proc () -> do
 
 ------------------------------------------------------------------------
 -- TODO-SECURITY check
-runViewDocuments :: HasDBid NodeType
+runViewDocuments :: (HasDBid NodeType, HasNodeError err)
                  => CorpusId
                  -> IsTrash
                  -> Maybe Offset
@@ -126,61 +127,33 @@ runViewDocuments :: HasDBid NodeType
                  -> Maybe Text
                  -> Cmd err [FacetDoc]
 runViewDocuments cId t o l order query year = do
-    _ <- printDebug "[runViewDocuments] sqlQuery" $ showSql sqlQuery
-    res <- runOpaQuery $ filterWith' o l order sqlQuery :: Cmd err [FacetDocAgg']
+    listId <- defaultList cId
+
+    res <- runOpaQuery $ filterWith' o l order (sqlQuery listId) :: Cmd err [FacetDocAgg']
     pure $ remapNgramsCount <$> res
   where
-    sqlQuery = viewDocuments' cId t (toDBid NodeDocument) query year
+    sqlQuery lId = viewDocuments cId lId t (toDBid NodeDocument) query year
 
     remapNgramsCount (FacetDoc { .. }) =
       FacetDoc { facetDoc_ngramCount = Just $ fromIntegral facetDoc_ngramCount
                , .. }
 
-runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> Cmd err Int
+runCountDocuments :: (HasDBid NodeType, HasNodeError err)
+                  => CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> Cmd err Int
 runCountDocuments cId t mQuery mYear = do
-  runCountOpaQuery sqlQuery
+  listId <- defaultList cId
+  runCountOpaQuery (sqlQuery listId)
   where
-    sqlQuery = viewDocuments' cId t (toDBid NodeDocument) mQuery mYear
-
+    sqlQuery lId = viewDocuments cId lId t (toDBid NodeDocument) mQuery mYear
 
 viewDocuments :: CorpusId
-              -> IsTrash
-              -> NodeTypeId
-              -> Maybe Text
-              -> Maybe Text
-              -> Select FacetDocRead
-viewDocuments cId t ntId mQuery mYear = proc () -> do
-  (c, nc) <- viewDocumentsQuery cId t ntId mQuery mYear -< ()
-  --ngramCountAgg <- laterally . aggregate sumInt4 -< cnng
-
-  -- TODO PGInt8 -> PGFloat conversion
-  --      https://github.com/tomjaguarpaw/haskell-opaleye/issues/401
-  --      unsafeCast "float8"
-  -- cnng <- optionalRestrict queryContextNodeNgramsTable -<
-  --   \cnng' -> (cnng' ^. cnng_node_id)    .== pgNodeId cId .&&
-  --             (cnng' ^. cnng_context_id) .== (c ^. cs_id)
-
-  -- cnt <- aggregate sum -< maybeFields (sqlInt4 0) _cnng_doc_count cnng
-  -- (proc cnng' -> do
-  --                          returnA -< maybeFields (sqlInt4 0) _cnng_doc_count cnng') -< cnng
-
-  returnA  -< FacetDoc { facetDoc_id         = _cs_id        c
-                       , facetDoc_created    = _cs_date      c
-                       , facetDoc_title      = _cs_name      c
-                       , facetDoc_hyperdata  = _cs_hyperdata c
-                       , facetDoc_category   = toNullable $ nc^.nc_category
-                       , facetDoc_ngramCount = toNullable $ nc^.nc_score
-                       -- , facetDoc_ngramCount = toNullable $ toFields cnt
-                       , facetDoc_score      = toNullable $ nc^.nc_score
-                       }
-
-viewDocuments' :: CorpusId
+               -> ListId
                -> IsTrash
                -> NodeTypeId
                -> Maybe Text
                -> Maybe Text
                -> Select FacetDocAgg
-viewDocuments' cId t ntId mQuery mYear =
+viewDocuments cId lId t ntId mQuery mYear =
   aggregate (pFacetDoc FacetDoc { facetDoc_id         = OAgg.groupBy
                                 , facetDoc_created    = OAgg.groupBy
                                 , facetDoc_title      = OAgg.groupBy
@@ -188,18 +161,19 @@ viewDocuments' cId t ntId mQuery mYear =
                                 , facetDoc_category   = OAgg.groupBy
                                 , facetDoc_ngramCount = OAgg.sumInt4
                                 , facetDoc_score      = OAgg.sum })
-        (viewDocumentsAgg cId t ntId mQuery mYear)
+        (viewDocumentsAgg cId lId t ntId mQuery mYear)
 
 viewDocumentsAgg :: CorpusId
+                 -> ListId
                  -> IsTrash
                  -> NodeTypeId
                  -> Maybe Text
                  -> Maybe Text
                  -> Select FacetDocAggPart
-viewDocumentsAgg cId t ntId mQuery mYear = proc () -> do
+viewDocumentsAgg cId lId t ntId mQuery mYear = proc () -> do
   (c, nc) <- viewDocumentsQuery cId t ntId mQuery mYear -< ()
   cnng <- optionalRestrict queryContextNodeNgramsTable -<
-    \cnng' -> (cnng' ^. cnng_node_id)    .== (nc ^. nc_node_id) .&&
+    \cnng' -> (cnng' ^. cnng_node_id)    .== pgNodeId lId .&&  -- (nc ^. nc_node_id) .&&
               (cnng' ^. cnng_context_id) .== (c ^. cs_id)
   returnA  -< FacetDoc { facetDoc_id         = _cs_id        c
                        , facetDoc_created    = _cs_date      c
@@ -219,19 +193,12 @@ viewDocumentsQuery :: CorpusId
                    -> Maybe Text
                    -> Maybe Text
                    -> Select (ContextSearchRead, NodeContextRead)
-                   -- -> Select (ContextSearchRead, NodeContextRead, MaybeFields ContextNodeNgramsRead)
 viewDocumentsQuery cId t ntId mQuery mYear = proc () -> do
   c  <- queryContextSearchTable -< ()
-  -- let joinCond (nc, cnn) = do
-  --       restrict -< (nc ^. context_id) .== (cnn ^. context_id)
-  --       restrict -< (nc ^. node_id)    .== (cnn ^. node_id)  -- :: (NodeContextRead, ContextNodeNgramsRead) -> Field SqlBool
   nc <- queryNodeContextTable -< ()
   restrict -< (c^.cs_id)       .== (nc^.nc_context_id)
   restrict -< nc^.nc_node_id   .== pgNodeId cId
   restrict -< c^.cs_typename   .== sqlInt4 ntId
-  -- cnng <- optionalRestrict queryContextNodeNgramsTable -<
-  --   (\cnng' -> (nc ^. nc_context_id) .== (cnng' ^. cnng_context_id) .&&
-  --              (nc ^. nc_node_id)    .== (cnng' ^. cnng_node_id))
   restrict -< if t then nc^.nc_category .== sqlInt4 0
                    else nc^.nc_category .>= sqlInt4 1
 
@@ -288,24 +255,27 @@ orderWith _                = asc facetDoc_created
 
 
 
-filterWith' :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ SqlJsonb) =>
+filterWith' :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ SqlJsonb, SqlOrd ngramCount) =>
         Maybe Gargantext.Core.Types.Offset
      -> Maybe Gargantext.Core.Types.Limit
      -> Maybe OrderBy
-     -> Select (Facet id (Field date) (Field title) (Field hyperdata) (Field category) ngramCount (Field score))
-     -> Select (Facet id (Field date) (Field title) (Field hyperdata) (Field category) ngramCount (Field score))
+     -> Select (Facet id (Field date) (Field title) (Field hyperdata) (Field category) (Field ngramCount) (Field score))
+     -> Select (Facet id (Field date) (Field title) (Field hyperdata) (Field category) (Field ngramCount) (Field score))
 filterWith' o l order q = limit' l $ offset' o $ orderBy (orderWith' order) q
 
 
-orderWith' :: (SqlOrd b1, SqlOrd b2, SqlOrd b3, SqlOrd b4)
+orderWith' :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd ngramCount, SqlOrd score)
            => Maybe OrderBy
-           -> Order (Facet id (Field b1) (Field b2) (Field SqlJsonb) (Field b3) ngramCount (Field b4))
+           -> Order (Facet id (Field date) (Field title) (Field SqlJsonb) (Field category) (Field ngramCount) (Field score))
 orderWith' (Just DateAsc)   = asc  facetDoc_created
 orderWith' (Just DateDesc)  = desc facetDoc_created
 
 orderWith' (Just TitleAsc)  = asc  facetDoc_title
 orderWith' (Just TitleDesc) = desc facetDoc_title
 
+orderWith' (Just NgramCountAsc)  = asc  facetDoc_ngramCount
+orderWith' (Just NgramCountDesc) = desc facetDoc_ngramCount
+
 orderWith' (Just ScoreAsc)  = asc  facetDoc_score
 orderWith' (Just ScoreDesc) = desc facetDoc_score
 

src/Gargantext/Database/Query/Facet/Types.hs

@@ -158,6 +158,7 @@ type FacetDocAggPart = Facet (Field SqlInt4       )
 -----------------------------------------------------------------------
 data OrderBy =  DateAsc   | DateDesc
              | TitleAsc   | TitleDesc
+             | NgramCountDesc | NgramCountAsc
              | ScoreDesc  | ScoreAsc
              | SourceAsc  | SourceDesc
              | TagAsc     | TagDesc
@@ -169,6 +170,8 @@ instance FromHttpApiData OrderBy
     parseUrlPiece "DateDesc"       = pure DateDesc
     parseUrlPiece "TitleAsc"       = pure TitleAsc
     parseUrlPiece "TitleDesc"      = pure TitleDesc
+    parseUrlPiece "NgramCountAsc"  = pure NgramCountAsc
+    parseUrlPiece "NgramCountDesc" = pure NgramCountDesc
     parseUrlPiece "ScoreAsc"       = pure ScoreAsc
     parseUrlPiece "ScoreDesc"      = pure ScoreDesc
     parseUrlPiece "SourceAsc"      = pure SourceAsc

src/Gargantext/Database/Query/Filter.hs

@@ -27,5 +27,3 @@ limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
 
 offset' :: Maybe Offset -> Select a  -> Select a
 offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
-
-