[FIX] Clean Text before sending it to NLP micro services + tests + clean code for...
[gargantext.git] / src / Gargantext / Database / Query / Facet.hs
index 1928c4c0cd40b6d01d7b3d8c409c0cdcecfa2fa8..a478975eef84a6c5bce13d1d3e0fa1945b508720 100644 (file)
@@ -8,10 +8,9 @@ Stability   : experimental
 Portability : POSIX
 -}
 
-{-# OPTIONS_GHC -fno-warn-orphans      #-}
-
 {-# LANGUAGE Arrows                    #-}
 {-# LANGUAGE FunctionalDependencies    #-}
+{-# LANGUAGE LambdaCase                #-}
 {-# LANGUAGE QuasiQuotes               #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
 {-# LANGUAGE TemplateHaskell           #-}
@@ -20,7 +19,7 @@ Portability : POSIX
 module Gargantext.Database.Query.Facet
   ( runViewAuthorsDoc
   , runViewDocuments
-  , viewDocuments'
+  , viewDocuments
   , runCountDocuments
   , filterWith
 
@@ -34,212 +33,34 @@ module Gargantext.Database.Query.Facet
   , FacetDocRead
   , FacetPaired(..)
   , FacetPairedRead
-  , FacetPairedReadNull
-  , FacetPairedReadNullAgg
   , OrderBy(..)
   )
   where
 
-import Control.Arrow (returnA, (>>>))
+import Control.Arrow (returnA)
 import Control.Lens ((^.))
-import Data.Aeson (FromJSON, ToJSON)
-import Data.Aeson.TH (deriveJSON)
---import qualified Database.PostgreSQL.Simple as DPS
---import Database.PostgreSQL.Simple.SqlQQ (sql)
-import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
-import Data.Swagger
 import qualified Data.Text as T
-import Data.Time (UTCTime)
-import Data.Time.Segment (jour)
 import Opaleye
+import qualified Opaleye.Aggregate as OAgg
 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, wellNamedSchema)
--- import Gargantext.Database.Action.TSQuery (toTSQuery)
-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.Context
-import Gargantext.Database.Schema.Context
-import Gargantext.Database.Query.Table.NodeContext
 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.Prelude (printDebug)
+import Gargantext.Database.Schema.NodeContext
 
 ------------------------------------------------------------------------
--- | DocFacet
-
--- data Facet = FacetDoc | FacetSources | FacetAuthors | FacetTerms
---    deriving (Show, Generic)
---instance FromJSON Facet
---instance ToJSON   Facet
-
-type Category = Int
-type Score    = Double
-type Title    = Text
-
--- TODO remove Title
-type FacetDoc = Facet NodeId UTCTime Title HyperdataDocument (Maybe Category) (Maybe Double) (Maybe Score)
--- type FacetSources = FacetDoc
--- type FacetAuthors = FacetDoc
--- type FacetTerms   = FacetDoc
-
-
-data Facet id created title hyperdata category ngramCount score =
-     FacetDoc { facetDoc_id         :: id
-              , facetDoc_created    :: created
-              , facetDoc_title      :: title
-              , facetDoc_hyperdata  :: hyperdata
-              , facetDoc_category   :: category
-              , facetDoc_ngramCount :: ngramCount
-              , facetDoc_score      :: score
-              } deriving (Show, Generic)
-{- | TODO after demo
-data Facet id date hyperdata score = 
-     FacetDoc { facetDoc_id        :: id
-              , facetDoc_date      :: date
-              , facetDoc_hyperdata :: hyperdata
-              , facetDoc_score     :: score
-              } deriving (Show, Generic)
--}
-
-data Pair i l = Pair {
-    _p_id    :: i
-  , _p_label :: l
-  } deriving (Show, Generic)
-$(deriveJSON (unPrefix "_p_") ''Pair)
-$(makeAdaptorAndInstance "pPair" ''Pair)
-
-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 =
-  FacetPaired { _fp_id        :: id
-              , _fp_date      :: date
-              , _fp_hyperdata :: hyperdata
-              , _fp_score     :: score }
-  deriving (Show, Generic)
-$(deriveJSON (unPrefix "_fp_") ''FacetPaired)
-$(makeAdaptorAndInstance "pFacetPaired" ''FacetPaired)
-
-
-
-instance ( ToSchema id
-         , ToSchema date
-         , ToSchema hyperdata
-         , ToSchema score
-         , 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 (FacetPaired id date hyperdata score) where
-  arbitrary = FacetPaired <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
-
-type FacetPairedRead = FacetPaired (Column SqlInt4       )
-                                   (Column SqlTimestamptz)
-                                   (Column SqlJsonb      )
-                                   (Column SqlInt4       )
-
-type FacetPairedReadNull = FacetPaired (Column (Nullable SqlInt4)       )
-                                       (Column (Nullable SqlTimestamptz))
-                                       (Column (Nullable SqlJsonb)      )
-                                       (Column (Nullable SqlInt4)       )
-
-type FacetPairedReadNullAgg = FacetPaired (Aggregator (Column (Nullable SqlInt4)       )
-                                                      (Column (Nullable SqlInt4)       ) 
-                                          )
-                                          (Aggregator (Column (Nullable SqlTimestamptz))
-                                                      (Column (Nullable SqlTimestamptz))
-
-                                          )
-                                          (Aggregator (Column (Nullable SqlJsonb)      )
-                                                      (Column (Nullable SqlJsonb)      )
-                                          )
-                                          (Aggregator (Column (Nullable SqlInt4)       )
-                                                      (Column (Nullable SqlInt4)       )
-                                          )
-
-
-
-
--- | JSON instance
-$(deriveJSON (unPrefix "facetDoc_") ''Facet)
-
--- | Documentation instance
-instance ToSchema FacetDoc where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "facetDoc_")
-
--- | Mock and Quickcheck instances
-instance Arbitrary FacetDoc where
-    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
--- | Database instances
-$(makeAdaptorAndInstance "pFacetDoc" ''Facet)
--- $(makeLensesWith abbreviatedFields   ''Facet)
-
-type FacetDocRead = Facet (Column SqlInt4       )
-                          (Column SqlTimestamptz)
-                          (Column SqlText       )
-                          (Column SqlJsonb      )
-                          (Column (Nullable SqlInt4)) -- Category
-                          (Column (Nullable SqlFloat8)) -- Ngrams Count
-                          (Column (Nullable SqlFloat8)) -- Score
-
------------------------------------------------------------------------
------------------------------------------------------------------------
-data OrderBy =  DateAsc   | DateDesc
-             | TitleAsc   | TitleDesc
-             | ScoreDesc  | ScoreAsc
-             | SourceAsc  | SourceDesc
-             deriving (Generic, Enum, Bounded, Read, Show)
-
-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 _            = Left "Unexpected value of OrderBy"
-instance ToHttpApiData OrderBy where
-  toUrlPiece = T.pack . show
-
-instance ToParamSchema OrderBy
-instance FromJSON  OrderBy
-instance ToJSON    OrderBy
-instance ToSchema  OrderBy
-instance Arbitrary OrderBy
-  where
-    arbitrary = elements [minBound..maxBound]
 
 
 -- TODO-SECURITY check
@@ -261,148 +82,217 @@ viewAuthorsDoc :: HasDBid NodeType
                -> NodeType
                -> Select FacetDocRead
 viewAuthorsDoc cId _ nt = proc () -> do
-  (doc,(_,(_,(_,contact')))) <- queryAuthorsDoc      -< ()
+  --(doc,(_,(_,(_,contact')))) <- queryAuthorsDoc      -< ()
+  (doc, _, _, _, contact') <- queryAuthorsDoc -< ()
 
-  restrict -< _node_id   contact'  .== (toNullable $ pgNodeId cId)
-  restrict -< _node_typename doc   .== (sqlInt4 $ toDBid nt)
+  restrict -< fromMaybeFields (sqlInt4 $ -1) (_node_id <$> contact') .=== pgNodeId cId
+  restrict -< _node_typename doc   .== sqlInt4 (toDBid nt)
 
   returnA  -< FacetDoc { facetDoc_id         = _node_id        doc
                        , facetDoc_created    = _node_date      doc
                        , facetDoc_title      = _node_name      doc
                        , facetDoc_hyperdata  = _node_hyperdata doc
                        , facetDoc_category   = toNullable $ sqlInt4 1
-                       , facetDoc_ngramCount = toNullable $ sqlDouble 1
+                       , facetDoc_ngramCount = toNullable $ sqlDouble 1.0
                        , facetDoc_score      = toNullable $ sqlDouble 1 }
 
-queryAuthorsDoc :: Select (NodeRead, (ContextNodeNgramsReadNull, (NgramsReadNull, (ContextNodeNgramsReadNull, NodeReadNull))))
-queryAuthorsDoc = leftJoin5 queryNodeTable queryContextNodeNgramsTable queryNgramsTable queryContextNodeNgramsTable queryNodeTable cond12 cond23 cond34 cond45
-    where
-         cond12 :: (ContextNodeNgramsRead, NodeRead) -> Column SqlBool
-         cond12 (nodeNgram, doc) =  _node_id doc
-                                .== _cnng_context_id nodeNgram
-
-         cond23 :: (NgramsRead, (ContextNodeNgramsRead, NodeReadNull)) -> Column SqlBool
-         cond23 (ngrams', (nodeNgram, _)) =  ngrams'^.ngrams_id
-                                        .== _cnng_ngrams_id nodeNgram
-
-         cond34 :: (ContextNodeNgramsRead, (NgramsRead, (ContextNodeNgramsReadNull, NodeReadNull))) -> Column SqlBool
-         cond34 (nodeNgram2, (ngrams', (_,_)))= ngrams'^.ngrams_id .== _cnng_ngrams_id       nodeNgram2
-
-         cond45 :: (NodeRead, (ContextNodeNgramsRead, (NgramsReadNull, (ContextNodeNgramsReadNull, NodeReadNull)))) -> Column SqlBool
-         cond45 (contact', (nodeNgram2', (_, (_,_)))) = _node_id  contact'  .== _cnng_context_id         nodeNgram2'
+queryAuthorsDoc :: Select ( NodeRead
+                          , MaybeFields ContextNodeNgramsRead
+                          , MaybeFields NgramsRead
+                          , MaybeFields ContextNodeNgramsRead
+                          , MaybeFields NodeRead)
+queryAuthorsDoc = proc () -> do
+  n <- queryNodeTable -< ()
+  cnn <- optionalRestrict queryContextNodeNgramsTable -<
+    \cnn' -> _node_id n .== _cnng_context_id cnn'
+  ng <- optionalRestrict queryNgramsTable -<
+    \ng' -> justFields (ng' ^. ngrams_id) .=== (_cnng_ngrams_id <$> cnn)
+  cnn2 <- optionalRestrict queryContextNodeNgramsTable -<
+    \cnn2' -> (_ngrams_id <$> ng) .=== justFields (_cnng_ngrams_id cnn2')
+  contact <- optionalRestrict queryNodeTable -<
+    \contact' -> justFields (_node_id contact') .=== (_cnng_context_id <$> cnn2)
+
+  returnA -< (n, cnn, ng, cnn2, contact)
 
 
 ------------------------------------------------------------------------
 -- TODO-SECURITY check
-runViewDocuments :: HasDBid NodeType
+runViewDocuments :: (HasDBid NodeType, HasNodeError err)
                  => CorpusId
                  -> IsTrash
                  -> Maybe Offset
                  -> Maybe Limit
                  -> Maybe OrderBy
                  -> Maybe Text
+                 -> Maybe Text
                  -> Cmd err [FacetDoc]
-runViewDocuments cId t o l order query = do
-    printDebug "[runViewDocuments] sqlQuery" $ showSql sqlQuery
-    runOpaQuery $ filterWith o l order sqlQuery
-  where
-    ntId = toDBid NodeDocument
-    sqlQuery = viewDocuments cId t ntId query
+runViewDocuments cId t o l order query year = do
+    listId <- defaultList cId
 
-runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Cmd err Int
-runCountDocuments cId t mQuery = do
-  runCountOpaQuery sqlQuery
+    res <- runOpaQuery $ filterWith' o l order (sqlQuery listId) :: Cmd err [FacetDocAgg']
+    pure $ remapNgramsCount <$> res
   where
-    sqlQuery = viewDocuments cId t (toDBid NodeDocument) mQuery
-
+    sqlQuery lId = viewDocuments cId lId t (toDBid NodeDocument) query year
+
+    remapNgramsCount (FacetDoc { .. }) =
+      FacetDoc { facetDoc_ngramCount = Just $ fromIntegral facetDoc_ngramCount
+               , facetDoc_score      = Just $ fromIntegral facetDoc_score
+               , .. }
+
+runCountDocuments :: (HasDBid NodeType, HasNodeError err)
+                  => CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> Cmd err Int
+runCountDocuments cId t mQuery mYear = do
+  listId <- defaultList cId
+  runCountOpaQuery (sqlQuery listId)
+  where
+    sqlQuery lId = viewDocuments cId lId t (toDBid NodeDocument) mQuery mYear
 
 viewDocuments :: CorpusId
-              -> IsTrash
-              -> NodeTypeId
-              -> Maybe Text
-              -> Select FacetDocRead
-viewDocuments cId t ntId mQuery = viewDocumentsQuery cId t ntId mQuery >>> proc (c, nc) -> do
+               -> ListId
+               -> IsTrash
+               -> NodeTypeId
+               -> Maybe Text
+               -> Maybe Text
+               -> Select FacetDocAgg
+viewDocuments cId lId t ntId mQuery mYear =
+  aggregate (pFacetDoc FacetDoc { facetDoc_id         = OAgg.groupBy
+                                , facetDoc_created    = OAgg.groupBy
+                                , facetDoc_title      = OAgg.groupBy
+                                , facetDoc_hyperdata  = OAgg.groupBy
+                                , facetDoc_category   = OAgg.groupBy
+                                , facetDoc_ngramCount = OAgg.sumInt4
+                                , facetDoc_score      = OAgg.sumInt4 })
+        (viewDocumentsAgg cId lId t ntId mQuery mYear)
+
+viewDocumentsAgg :: CorpusId
+                 -> ListId
+                 -> IsTrash
+                 -> NodeTypeId
+                 -> Maybe Text
+                 -> Maybe Text
+                 -> Select FacetDocAggPart
+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)    .== pgNodeId lId .&&  -- (nc ^. nc_node_id) .&&
+              (cnng' ^. cnng_context_id) .== (c ^. cs_id)
+  let ngramCount = fromMaybeFields 0 $ _cnng_doc_count <$> 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_score      = toNullable $ nc^.nc_score
+                       , facetDoc_category   = nc ^. nc_category
+                       , facetDoc_ngramCount = ngramCount
+                       -- NOTE This is a slight abuse of "score" but
+                       -- currently it is all 0's in the DB and the
+                       -- search functionality on the frontend orders
+                       -- by Score.
+                       , facetDoc_score      = ngramCount
                        }
 
-viewDocuments' :: CorpusId
-               -> IsTrash
-               -> NodeTypeId
-               -> Maybe Text
-               -> Select NodeRead
-viewDocuments' cId t ntId mQuery = viewDocumentsQuery cId t ntId mQuery >>> proc (c, _nc) -> do
-  returnA  -< Node { _node_id        = _cs_id        c
-                   , _node_hash_id   = ""
-                   , _node_typename  = _cs_typename  c
-                   , _node_user_id   = _cs_user_id   c
-                   , _node_parent_id = -1
-                   , _node_name      = _cs_name      c
-                   , _node_date      = _cs_date      c
-                   , _node_hyperdata = _cs_hyperdata c
-                   }
-
+-- TODO Join with context_node_ngrams at context_id/node_id and sum by
+-- doc_count.
 viewDocumentsQuery :: CorpusId
                    -> IsTrash
                    -> NodeTypeId
                    -> Maybe Text
+                   -> Maybe Text
                    -> Select (ContextSearchRead, NodeContextRead)
-viewDocumentsQuery cId t ntId mQuery = proc () -> do
+viewDocumentsQuery cId t ntId mQuery mYear = proc () -> do
   c  <- queryContextSearchTable -< ()
-  nc <- queryNodeContextTable   -< ()
-  restrict -< c^.cs_id         .== nc^.nc_context_id
-  restrict -< nc^.nc_node_id   .== (pgNodeId cId)
-  restrict -< c^.cs_typename   .== (sqlInt4 ntId)
-  restrict -< if t then nc^.nc_category .== (sqlInt4 0)
-                   else nc^.nc_category .>= (sqlInt4 1)
+  nc <- queryNodeContextTable -< ()
+  restrict -< (c^.cs_id)       .== (nc^.nc_context_id)
+  restrict -< nc^.nc_node_id   .== pgNodeId cId
+  restrict -< c^.cs_typename   .== sqlInt4 ntId
+  restrict -< if t then nc^.nc_category .== sqlInt4 0
+                   else nc^.nc_category .>= sqlInt4 1
 
   let
     query         = (fromMaybe "" mQuery)
+    year          = (fromMaybe "" mYear)
     iLikeQuery    = T.intercalate "" ["%", query, "%"]
     abstractLHS h = fromNullable (sqlStrictText "")
-                  $ toNullable h .->> (sqlStrictText "abstract")
+                  $ toNullable h .->> sqlStrictText "abstract"
+    yearLHS h     = fromNullable (sqlStrictText "")
+                  $ toNullable h .->> sqlStrictText "publication_year"
 
   restrict -<
     if query == "" then sqlBool True
       else  ((c^.cs_name) `ilike` (sqlStrictText iLikeQuery))
         .|| ((abstractLHS (c^.cs_hyperdata)) `ilike` (sqlStrictText iLikeQuery))
+  restrict -<
+    if year == "" then sqlBool True
+      else yearLHS (c ^. cs_hyperdata) .== sqlStrictText year
 
   returnA -< (c, nc)
+  -- returnA -< (c, nc, cnng)
 
 
 ------------------------------------------------------------------------
-filterWith :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ Column SqlJsonb) =>
+filterWith :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ SqlJsonb) =>
         Maybe Gargantext.Core.Types.Offset
      -> Maybe Gargantext.Core.Types.Limit
      -> Maybe OrderBy
-     -> 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))
+     -> Select (Facet id (Field date) (Field title) (Field hyperdata) (FieldNullable category) ngramCount (FieldNullable score))
+     -> Select (Facet id (Field date) (Field title) (Field hyperdata)(FieldNullable category) ngramCount (FieldNullable score))
 filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q
 
 
 orderWith :: (SqlOrd b1, SqlOrd b2, SqlOrd b3, SqlOrd b4)
           => Maybe OrderBy
-          -> Order (Facet id (Column b1) (Column b2) (Column SqlJsonb) (Column b3) ngramCount (Column b4))
+          -> Order (Facet id (Field b1) (Field b2) (Field SqlJsonb) (FieldNullable b3) ngramCount (FieldNullable b4))
 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_score
+orderWith (Just ScoreAsc)  = ascNullsLast  facetDoc_score
 orderWith (Just ScoreDesc) = descNullsLast facetDoc_score
 
-orderWith (Just SourceAsc)  = asc  facetDoc_source
-orderWith (Just SourceDesc) = desc facetDoc_source
+orderWith (Just SourceAsc)  = ascNullsLast  facetDoc_source
+orderWith (Just SourceDesc) = descNullsLast facetDoc_source
+
+orderWith (Just TagAsc)     = ascNullsLast  facetDoc_category
+orderWith (Just TagDesc)    = descNullsLast facetDoc_category
 
 orderWith _                = asc facetDoc_created
 
+
+
+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) (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 date, SqlOrd title, SqlOrd category, SqlOrd ngramCount, SqlOrd score)
+           => Maybe OrderBy
+           -> 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
+
+orderWith' (Just SourceAsc)  = ascNullsLast  facetDoc_source
+orderWith' (Just SourceDesc) = descNullsLast facetDoc_source
+
+orderWith' (Just TagAsc)     = asc  facetDoc_category
+orderWith' (Just TagDesc)    = desc facetDoc_category
+
+orderWith' _                = asc facetDoc_created
+
 facetDoc_source :: SqlIsJson a
-                => Facet id created title (Column a) favorite ngramCount score
-                -> Column (Nullable SqlText)
-facetDoc_source x = toNullable (facetDoc_hyperdata x) .->> sqlString "source"
+                => Facet id created title (Field a) favorite ngramCount score
+                -> FieldNullable SqlText
+facetDoc_source x = (toNullable $ facetDoc_hyperdata x) .->> sqlString "source"