Skip to content

haskell-gargantext
haskell-gargantext
Verified Commit f61a1958 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[ngrams] ngram count aggregates now

parent 306e7cf2
Pipeline #3820 failed with stage
    in 29 minutes and 45 seconds
    Hide whitespace changes
    Inline Side-by-side
    Showing with 61 additions and 82 deletions
    src/Gargantext/API/Table.hs
    View file @ f61a1958
    ......@@ -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
    View file @ f61a1958
    ......@@ -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
    View file @ f61a1958
    ......@@ -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
    View file @ f61a1958
    ......@@ -158,6 +158,7 @@ type FacetDocAggPart = Facet (Field SqlInt4 )
    -----------------------------------------------------------------------
    data OrderBy = DateAsc | DateDesc
    | TitleAsc | TitleDesc
    | NgramCountDesc | NgramCountAsc
    | ScoreDesc | ScoreAsc
    | SourceAsc | SourceDesc
    | TagAsc | TagDesc
    ......@@ -165,17 +166,19 @@ data OrderBy = DateAsc | DateDesc
    instance FromHttpApiData OrderBy
    where
    parseUrlPiece "DateAsc" = pure DateAsc
    parseUrlPiece "DateDesc" = pure DateDesc
    parseUrlPiece "TitleAsc" = pure TitleAsc
    parseUrlPiece "TitleDesc" = pure TitleDesc
    parseUrlPiece "ScoreAsc" = pure ScoreAsc
    parseUrlPiece "ScoreDesc" = pure ScoreDesc
    parseUrlPiece "SourceAsc" = pure SourceAsc
    parseUrlPiece "SourceDesc" = pure SourceDesc
    parseUrlPiece "TagAsc" = pure TagAsc
    parseUrlPiece "TagDesc" = pure TagDesc
    parseUrlPiece _ = Left "Unexpected value of OrderBy"
    parseUrlPiece "DateAsc" = pure DateAsc
    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
    parseUrlPiece "SourceDesc" = pure SourceDesc
    parseUrlPiece "TagAsc" = pure TagAsc
    parseUrlPiece "TagDesc" = pure TagDesc
    parseUrlPiece _ = Left "Unexpected value of OrderBy"
    instance ToHttpApiData OrderBy where
    toUrlPiece = T.pack . show
    ......
    src/Gargantext/Database/Query/Filter.hs
    View file @ f61a1958
    ......@@ -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
    Markdown is supported
    0% or
    You are about to add 0 people to the discussion. Proceed with caution.
    Finish editing this message first!
    Please register or to comment