module Gargantext.Database.Query.Facet
( runViewAuthorsDoc
, runViewDocuments
+ , runCountDocuments
, filterWith
, Pair(..)
, FacetDocRead
, FacetPaired(..)
, FacetPairedRead
+ , FacetPairedReadNull
+ , FacetPairedReadNullAgg
, OrderBy(..)
)
where
import Control.Lens ((^.))
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.TH (deriveJSON)
-import Data.Either(Either(Left))
-import Data.Maybe (Maybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Data.Swagger
-import Data.Text (Text)
+import qualified Data.Text as T
import Data.Time (UTCTime)
import Data.Time.Segment (jour)
-import GHC.Generics (Generic)
+import Opaleye
+import Protolude hiding (null, map, sum, not)
+import Servant.API
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+import qualified Opaleye.Internal.Unpackspec()
+
import Gargantext.Core.Types
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
+import Gargantext.Database.Admin.Config (nodeTypeId)
+import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Query.Filter
import Gargantext.Database.Query.Join (leftJoin5)
import Gargantext.Database.Query.Table.Ngrams
-import Gargantext.Database.Admin.Config (nodeTypeId)
-import Gargantext.Database.Prelude
-import Gargantext.Database.Schema.Node
import Gargantext.Database.Query.Table.NodeNode
import Gargantext.Database.Query.Table.NodeNodeNgrams
-import Opaleye
-import Prelude hiding (null, id, map, sum, not, read)
-import Servant.API
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary
-import qualified Opaleye.Internal.Unpackspec()
+import Gargantext.Database.Prelude
+import Gargantext.Database.Schema.Node
------------------------------------------------------------------------
-- | DocFacet
--instance FromJSON Facet
--instance ToJSON Facet
-type Favorite = Int
+type Category = Int
type Title = Text
-- TODO remove Title
-type FacetDoc = Facet NodeId UTCTime Title HyperdataDocument (Maybe Favorite) (Maybe Double)
+type FacetDoc = Facet NodeId UTCTime Title HyperdataDocument (Maybe Category) (Maybe Double)
-- type FacetSources = FacetDoc
-- type FacetAuthors = FacetDoc
-- type FacetTerms = FacetDoc
-data Facet id created title hyperdata favorite ngramCount =
+data Facet id created title hyperdata category ngramCount =
FacetDoc { facetDoc_id :: id
, facetDoc_created :: created
, facetDoc_title :: title
, facetDoc_hyperdata :: hyperdata
- , facetDoc_favorite :: favorite
- , facetDoc_ngramCount :: ngramCount
+ , facetDoc_category :: category
+ , facetDoc_score :: ngramCount
} deriving (Show, Generic)
{- | TODO after demo
data Facet id date hyperdata score =
$(deriveJSON (unPrefix "_p_") ''Pair)
$(makeAdaptorAndInstance "pPair" ''Pair)
-instance (ToSchema i, ToSchema l) => ToSchema (Pair i l) where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_p_")
+instance (Typeable i, Typeable l, ToSchema i, ToSchema l) => ToSchema (Pair i l) where
+ declareNamedSchema = wellNamedSchema "_p_"
instance (Arbitrary i, Arbitrary l) => Arbitrary (Pair i l) where
arbitrary = Pair <$> arbitrary <*> arbitrary
-data FacetPaired id date hyperdata score pair =
+data FacetPaired id date hyperdata score =
FacetPaired {_fp_id :: id
,_fp_date :: date
,_fp_hyperdata :: hyperdata
,_fp_score :: score
- ,_fp_pair :: pair
} deriving (Show, Generic)
$(deriveJSON (unPrefix "_fp_") ''FacetPaired)
$(makeAdaptorAndInstance "pFacetPaired" ''FacetPaired)
+
+
instance ( ToSchema id
, ToSchema date
, ToSchema hyperdata
, ToSchema score
- , ToSchema pair
- ) => ToSchema (FacetPaired id date hyperdata score pair) where
- declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fp_")
+ , Typeable id
+ , Typeable date
+ , Typeable hyperdata
+ , Typeable score
+ ) => ToSchema (FacetPaired id date hyperdata score) where
+ declareNamedSchema = wellNamedSchema "_fp_"
instance ( Arbitrary id
, Arbitrary date
, Arbitrary hyperdata
, Arbitrary score
- , Arbitrary pair
- ) => Arbitrary (FacetPaired id date hyperdata score pair) where
- arbitrary = FacetPaired <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+ ) => Arbitrary (FacetPaired id date hyperdata score) where
+ arbitrary = FacetPaired <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
type FacetPairedRead = FacetPaired (Column PGInt4 )
(Column PGTimestamptz)
(Column PGJsonb )
(Column PGInt4 )
- ( Column (Nullable PGInt4)
- , Column (Nullable PGText)
- )
+
+type FacetPairedReadNull = FacetPaired (Column (Nullable PGInt4) )
+ (Column (Nullable PGTimestamptz))
+ (Column (Nullable PGJsonb) )
+ (Column (Nullable PGInt4) )
+
+type FacetPairedReadNullAgg = FacetPaired (Aggregator (Column (Nullable PGInt4) )
+ (Column (Nullable PGInt4) )
+ )
+ (Aggregator (Column (Nullable PGTimestamptz))
+ (Column (Nullable PGTimestamptz))
+
+ )
+ (Aggregator (Column (Nullable PGJsonb) )
+ (Column (Nullable PGJsonb) )
+ )
+ (Aggregator (Column (Nullable PGInt4) )
+ (Column (Nullable PGInt4) )
+ )
+
+
+
-- | JSON instance
$(deriveJSON (unPrefix "facetDoc_") ''Facet)
------------------------------------------------------------------------
-- TODO-SECURITY check
-runViewDocuments :: CorpusId -> IsTrash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetDoc]
-runViewDocuments cId t o l order =
- runOpaQuery $ filterWith o l order $ viewDocuments cId t ntId
+runViewDocuments :: CorpusId
+ -> IsTrash
+ -> Maybe Offset
+ -> Maybe Limit
+ -> Maybe OrderBy
+ -> Maybe Text
+ -> Cmd err [FacetDoc]
+runViewDocuments cId t o l order query = do
+ runOpaQuery $ filterWith o l order sqlQuery
where
ntId = nodeTypeId NodeDocument
+ sqlQuery = viewDocuments cId t ntId query
+
+runCountDocuments :: CorpusId -> IsTrash -> Maybe Text -> Cmd err Int
+runCountDocuments cId t mQuery = do
+ runCountOpaQuery sqlQuery
+ where
+ sqlQuery = viewDocuments cId t (nodeTypeId NodeDocument) mQuery
+
-viewDocuments :: CorpusId -> IsTrash -> NodeTypeId -> Query FacetDocRead
-viewDocuments cId t ntId = proc () -> do
+viewDocuments :: CorpusId
+ -> IsTrash
+ -> NodeTypeId
+ -> Maybe Text
+ -> Query FacetDocRead
+viewDocuments cId t ntId mQuery = proc () -> do
n <- queryNodeTable -< ()
nn <- queryNodeNodeTable -< ()
restrict -< n^.node_id .== nn^.nn_node2_id
restrict -< n^.node_typename .== (pgInt4 ntId)
restrict -< if t then nn^.nn_category .== (pgInt4 0)
else nn^.nn_category .>= (pgInt4 1)
+
+ let query = (fromMaybe "" mQuery)
+ iLikeQuery = T.intercalate "" ["%", query, "%"]
+ restrict -< (n^.node_name) `ilike` (pgStrictText iLikeQuery)
+
returnA -< FacetDoc (_node_id n)
(_node_date n)
(_node_name n)
------------------------------------------------------------------------
filterWith :: (PGOrd date, PGOrd title, PGOrd score, hyperdata ~ Column SqlJsonb) =>
- Maybe Gargantext.Core.Types.Offset
+ Maybe Gargantext.Core.Types.Offset
-> Maybe Gargantext.Core.Types.Limit
-> Maybe OrderBy
-> Select (Facet id (Column date) (Column title) hyperdata (Column score) ngramCount)
orderWith (Just TitleAsc) = asc facetDoc_title
orderWith (Just TitleDesc) = desc facetDoc_title
-orderWith (Just ScoreAsc) = asc facetDoc_favorite
-orderWith (Just ScoreDesc) = desc facetDoc_favorite
+orderWith (Just ScoreAsc) = asc facetDoc_category
+orderWith (Just ScoreDesc) = desc facetDoc_category
orderWith (Just SourceAsc) = asc facetDoc_source
orderWith (Just SourceDesc) = desc facetDoc_source