[FIX] email model
[gargantext.git] / src / Gargantext / Database / Query / Facet.hs
index d47542d2469e7ad608d41863e5d3e8cdcff61b15..5798ad01648847df6732e09acdcbe2f5fe4b4208 100644 (file)
@@ -12,22 +12,16 @@ Portability : POSIX
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
 {-# LANGUAGE Arrows                    #-}
-{-# LANGUAGE DeriveGeneric             #-}
-{-# LANGUAGE FlexibleContexts          #-}
-{-# LANGUAGE FlexibleInstances         #-}
 {-# LANGUAGE FunctionalDependencies    #-}
-{-# LANGUAGE MultiParamTypeClasses     #-}
 {-# LANGUAGE QuasiQuotes               #-}
-{-# LANGUAGE NoImplicitPrelude         #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
-{-# LANGUAGE OverloadedStrings         #-}
-{-# LANGUAGE RankNTypes                #-}
 {-# LANGUAGE TemplateHaskell           #-}
 {-# LANGUAGE TypeFamilies              #-}
 ------------------------------------------------------------------------
 module Gargantext.Database.Query.Facet
   ( runViewAuthorsDoc
   , runViewDocuments
+  , runCountDocuments
   , filterWith
 
   , Pair(..)
@@ -36,6 +30,8 @@ module Gargantext.Database.Query.Facet
   , FacetDocRead
   , FacetPaired(..)
   , FacetPairedRead
+  , FacetPairedReadNull
+  , FacetPairedReadNullAgg
   , OrderBy(..)
   )
   where
@@ -44,32 +40,30 @@ import Control.Arrow (returnA)
 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 Gargantext.Core.Types
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-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.Admin.Utils
-import Gargantext.Database.Schema.Ngrams
-import Gargantext.Database.Schema.Node
-import Gargantext.Database.Query.Table.NodeNode
-import Gargantext.Database.Schema.NodeNodeNgrams
 import Opaleye
-import Prelude hiding (null, id, map, sum, not, read)
+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, 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.Query.Table.NodeNode
+import Gargantext.Database.Query.Table.NodeNodeNgrams
+import Gargantext.Database.Prelude
+import Gargantext.Database.Schema.Node
+
 ------------------------------------------------------------------------
 -- | DocFacet
 
@@ -78,23 +72,23 @@ import qualified Opaleye.Internal.Unpackspec()
 --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 = 
@@ -111,44 +105,66 @@ data Pair i l = Pair {_p_id    :: i
 $(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)
@@ -258,14 +274,32 @@ queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNodeNgramsTable queryNgramsT
 ------------------------------------------------------------------------
 
 -- 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
@@ -273,6 +307,11 @@ viewDocuments cId t ntId = proc () -> do
   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)
@@ -282,7 +321,7 @@ viewDocuments cId t ntId = proc () -> do
 
 ------------------------------------------------------------------------
 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)
@@ -299,8 +338,8 @@ orderWith (Just DateDesc)  = desc facetDoc_created
 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