[REFACT/CLEAN] TextFlow
[gargantext.git] / src / Gargantext / Database / Query / Facet.hs
index 13c950fe14fa31eaf8b7809f5884c5b1646a3076..9a2691a3cd8dc4a1d9b1f41e81b70d316f106b6c 100644 (file)
@@ -9,7 +9,7 @@ Portability : POSIX
 -}
 
 {-# OPTIONS_GHC -fno-warn-orphans        #-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
 
 {-# LANGUAGE Arrows                    #-}
 {-# LANGUAGE FunctionalDependencies    #-}
@@ -21,6 +21,7 @@ Portability : POSIX
 module Gargantext.Database.Query.Facet
   ( runViewAuthorsDoc
   , runViewDocuments
+  , runCountDocuments
   , filterWith
 
   , Pair(..)
@@ -29,6 +30,8 @@ module Gargantext.Database.Query.Facet
   , FacetDocRead
   , FacetPaired(..)
   , FacetPairedRead
+  , FacetPairedReadNull
+  , FacetPairedReadNullAgg
   , OrderBy(..)
   )
   where
@@ -37,30 +40,29 @@ 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 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
 import Gargantext.Core.Types
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
+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
@@ -70,23 +72,24 @@ 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) (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 score =
      FacetDoc { facetDoc_id         :: id
               , facetDoc_created    :: created
               , facetDoc_title      :: title
               , facetDoc_hyperdata  :: hyperdata
-              , facetDoc_favorite   :: favorite
+              , facetDoc_category   :: category
               , facetDoc_ngramCount :: ngramCount
+              , facetDoc_score      :: score
               } deriving (Show, Generic)
 {- | TODO after demo
 data Facet id date hyperdata score = 
@@ -97,50 +100,73 @@ data Facet id date hyperdata score =
               } deriving (Show, Generic)
 -}
 
-data Pair i l = Pair {_p_id    :: i
-                     ,_p_label :: l
+data Pair i l = Pair {
+    _p_id    :: i
+  , _p_label :: l
   } deriving (Show, Generic)
 $(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)
@@ -151,13 +177,14 @@ instance ToSchema FacetDoc where
 
 -- | Mock and Quickcheck instances
 instance Arbitrary FacetDoc where
-    arbitrary = elements [ FacetDoc id' (jour year 01 01) t hp (Just cat) (Just ngramCount)
+    arbitrary = elements [ FacetDoc id' (jour year 01 01) t hp (Just cat) (Just ngramCount) (Just score)
                          | id'  <- [1..10]
                          , year <- [1990..2000]
                          , t    <- ["title", "another title"]
                          , hp   <- arbitraryHyperdataDocuments
                          , cat  <- [0..2]
                          , ngramCount <- [3..100]
+                         , score <- [3..100]
                          ]
 
 -- Facets / Views for the Front End
@@ -170,6 +197,7 @@ type FacetDocRead = Facet (Column PGInt4       )
                           (Column PGText       )
                           (Column PGJsonb      )
                           (Column (Nullable PGInt4)) -- Category
+                          (Column (Nullable PGFloat8)) -- Ngrams Count
                           (Column (Nullable PGFloat8)) -- Score
 
 -----------------------------------------------------------------------
@@ -204,23 +232,23 @@ instance Arbitrary OrderBy
 -- TODO-SECURITY check
 
 --{-
-runViewAuthorsDoc :: ContactId -> IsTrash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetDoc]
+runViewAuthorsDoc :: HasDBid NodeType => ContactId -> IsTrash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetDoc]
 runViewAuthorsDoc cId t o l order = runOpaQuery $ filterWith o l order $ viewAuthorsDoc cId t ntId
   where
     ntId = NodeDocument
 
 -- TODO add delete ?
-viewAuthorsDoc :: ContactId -> IsTrash -> NodeType -> Query FacetDocRead
+viewAuthorsDoc :: HasDBid NodeType => ContactId -> IsTrash -> NodeType -> Query FacetDocRead
 viewAuthorsDoc cId _ nt = proc () -> do
-  (doc,(_,(_,(_,contact)))) <- queryAuthorsDoc      -< ()
+  (doc,(_,(_,(_,contact')))) <- queryAuthorsDoc      -< ()
 
   {-nn         <- queryNodeNodeTable -< ()
   restrict -< nn_node1_id nn .== _node_id doc
   -- restrict -< nn_delete   nn .== (pgBool t)
   -}
 
-  restrict -< _node_id   contact   .== (toNullable $ pgNodeId cId)
-  restrict -< _node_typename doc   .== (pgInt4 $ nodeTypeId nt)
+  restrict -< _node_id   contact'  .== (toNullable $ pgNodeId cId)
+  restrict -< _node_typename doc   .== (pgInt4 $ toDBid nt)
 
   returnA  -< FacetDoc (_node_id        doc)
                        (_node_date      doc)
@@ -228,6 +256,7 @@ viewAuthorsDoc cId _ nt = proc () -> do
                        (_node_hyperdata doc)
                        (toNullable $ pgInt4 1)
                        (toNullable $ pgDouble 1)
+                       (toNullable $ pgDouble 1)
 
 queryAuthorsDoc :: Query (NodeRead, (NodeNodeNgramsReadNull, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull))))
 queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNodeNgramsTable queryNgramsTable queryNodeNodeNgramsTable queryNodeTable cond12 cond23 cond34 cond45
@@ -237,27 +266,46 @@ queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNodeNgramsTable queryNgramsT
                                 .== _nnng_node1_id nodeNgram
 
          cond23 :: (NgramsRead, (NodeNodeNgramsRead, NodeReadNull)) -> Column PGBool
-         cond23 (ngrams, (nodeNgram, _)) =  ngrams^.ngrams_id
+         cond23 (ngrams', (nodeNgram, _)) =  ngrams'^.ngrams_id
                                         .== _nnng_ngrams_id nodeNgram
 
          cond34 :: (NodeNodeNgramsRead, (NgramsRead, (NodeNodeNgramsReadNull, NodeReadNull))) -> Column PGBool
-         cond34 (nodeNgram2, (ngrams, (_,_)))= ngrams^.ngrams_id .== _nnng_ngrams_id       nodeNgram2
+         cond34 (nodeNgram2, (ngrams', (_,_)))= ngrams'^.ngrams_id .== _nnng_ngrams_id       nodeNgram2
 
          cond45 :: (NodeRead, (NodeNodeNgramsRead, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull)))) -> Column PGBool
-         cond45 (contact, (nodeNgram2, (_, (_,_)))) = _node_id  contact    .== _nnng_node1_id         nodeNgram2
+         cond45 (contact', (nodeNgram2', (_, (_,_)))) = _node_id  contact'  .== _nnng_node1_id         nodeNgram2'
 
 --}
 ------------------------------------------------------------------------
 
 -- 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 :: HasDBid NodeType
+                 => 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
+    ntId = toDBid NodeDocument
+    sqlQuery = viewDocuments cId t ntId query
 
-viewDocuments :: CorpusId -> IsTrash -> NodeTypeId -> Query FacetDocRead
-viewDocuments cId t ntId = proc () -> do
+runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Cmd err Int
+runCountDocuments cId t mQuery = do
+  runCountOpaQuery sqlQuery
+  where
+    sqlQuery = viewDocuments cId t (toDBid NodeDocument) mQuery
+
+
+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
@@ -265,34 +313,40 @@ 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)
                        (_node_hyperdata n)
                        (toNullable $ nn^.nn_category)
                        (toNullable $ nn^.nn_score)
+                       (toNullable $ nn^.nn_score)
 
 ------------------------------------------------------------------------
-filterWith :: (PGOrd date, PGOrd title, PGOrd score, hyperdata ~ Column SqlJsonb) =>
-     Maybe Gargantext.Core.Types.Offset
+filterWith :: (PGOrd date, PGOrd title, PGOrd category, PGOrd score, hyperdata ~ Column SqlJsonb) =>
+        Maybe Gargantext.Core.Types.Offset
      -> Maybe Gargantext.Core.Types.Limit
      -> Maybe OrderBy
-     -> Select (Facet id (Column date) (Column title) hyperdata (Column score) ngramCount)
-     -> Select (Facet id (Column date) (Column title) hyperdata (Column score) ngramCount)
+     -> Select (Facet id (Column date) (Column title) hyperdata (Column category) ngramCount (Column score))
+     -> Select (Facet id (Column date) (Column title) hyperdata (Column category) ngramCount (Column score))
 filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q
 
 
 orderWith :: (PGOrd b1, PGOrd b2, PGOrd b3)
           => Maybe OrderBy
-          -> Order (Facet id (Column b1) (Column b2) (Column SqlJsonb) (Column b3) score)
+          -> Order (Facet id (Column b1) (Column b2) (Column SqlJsonb) (Column b3) ngramCount 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 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
@@ -300,6 +354,6 @@ orderWith (Just SourceDesc) = desc facetDoc_source
 orderWith _                = asc facetDoc_created
 
 facetDoc_source :: PGIsJson a
-                => Facet id created title (Column a) favorite ngramCount
+                => Facet id created title (Column a) favorite ngramCount score
                 -> Column (Nullable PGText)
 facetDoc_source x = toNullable (facetDoc_hyperdata x) .->> pgString "source"