opaleye 0.9.6.2 → 0.9.7.0

raw patch · 12 files changed

+102/−45 lines, 12 filesdep ~aesonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• README.md +1/−1
• opaleye.cabal +1/−1
• src/Opaleye/Aggregate.hs +17/−1
• src/Opaleye/Internal/Aggregate.hs +42/−11
• src/Opaleye/Internal/HaskellDB/PrimQuery.hs +11/−1
• src/Opaleye/Internal/HaskellDB/Sql.hs +1/−1
• src/Opaleye/Internal/HaskellDB/Sql/Default.hs +9/−6
• src/Opaleye/Internal/HaskellDB/Sql/Print.hs +3/−1
• src/Opaleye/Internal/PrimQuery.hs +2/−7
• src/Opaleye/Internal/Sql.hs +9/−13
• src/Opaleye/Internal/Window.hs +2/−2

@@ -1,3 +1,7 @@+## 0.9.7.0++* Added `filterWhere` (thanks to Shane O'Brien)+ ## 0.9.6.2  * No externally visible changes

@@ -123,7 +123,7 @@ for six months, and this policy has not been changed to the contrary, then full ownership of the project, including the GitHub repository, Hackage upload rights, and the right to amend this backup maintainers-policy passes to Joe Hermaszewski (@expipiplus1).+policy passes to Ellie Hermaszewska (@expipiplus1).  # Contributors 

@@ -1,6 +1,6 @@ name:            opaleye copyright:       Copyright (c) 2014-2018 Purely Agile Limited; 2019-2023 Tom Ellis-version:         0.9.6.2+version:         0.9.7.0 synopsis:        An SQL-generating DSL targeting PostgreSQL description:     An SQL-generating DSL targeting PostgreSQL.  Allows                  Postgres queries to be written within Haskell in a

@@ -13,6 +13,7 @@          aggregate        , aggregateOrdered        , distinctAggregator+       , filterWhere        , Aggregator        -- * Basic 'Aggregator's        , groupBy@@ -41,8 +42,10 @@ import qualified Opaleye.Internal.Aggregate as A import           Opaleye.Internal.Aggregate (Aggregator, orderAggregate) import qualified Opaleye.Internal.Column as IC+import           Opaleye.Internal.MaybeFields (MaybeFields (MaybeFields)) import qualified Opaleye.Internal.QueryArr as Q import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ+import qualified Opaleye.Internal.Operators as O import qualified Opaleye.Internal.PackMap as PM import qualified Opaleye.Internal.Tag as Tag @@ -103,7 +106,20 @@ -- | Aggregate only distinct values distinctAggregator :: Aggregator a b -> Aggregator a b distinctAggregator (A.Aggregator (PM.PackMap pm)) =-  A.Aggregator (PM.PackMap (\f c -> pm (f . P.first' (fmap (\(a,b,_) -> (a,b,HPQ.AggrDistinct)))) c))+  A.Aggregator (PM.PackMap (\f c -> pm (f . P.first' setDistinct) c))+  where+    setDistinct HPQ.GroupBy = HPQ.GroupBy+    setDistinct aggr =+      aggr+        { HPQ.aggrDistinct = HPQ.AggrDistinct+        }++-- | Aggregate only rows matching the given predicate+filterWhere+  :: (a -> F.Field T.SqlBool)+  -> Aggregator a b+  -> Aggregator a (MaybeFields b)+filterWhere = A.filterWhereInternal (MaybeFields . O.not . F.isNull)  -- | Group the aggregation by equality on the input to 'groupBy'. groupBy :: Aggregator (F.Field_ n a) (F.Field_ n a)

@@ -1,16 +1,18 @@ {-# LANGUAGE TupleSections #-} module Opaleye.Internal.Aggregate where -import           Control.Applicative (Applicative, pure, (<*>))+import           Control.Applicative (Applicative, liftA2, pure, (<*>))  import qualified Data.Profunctor as P import qualified Data.Profunctor.Product as PP +import qualified Opaleye.Field as F+import qualified Opaleye.Internal.Column as C+import qualified Opaleye.Internal.Order as O import qualified Opaleye.Internal.PackMap as PM import qualified Opaleye.Internal.PrimQuery as PQ import qualified Opaleye.Internal.Tag as T-import qualified Opaleye.Internal.Column as C-import qualified Opaleye.Internal.Order as O+import qualified Opaleye.SqlTypes as T  import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ @@ -28,14 +30,15 @@ takes a list of @a@ and returns a single value of type @b@. -} newtype Aggregator a b =-  Aggregator (PM.PackMap (Maybe (HPQ.AggrOp, [HPQ.OrderExpr], HPQ.AggrDistinct),-                          HPQ.PrimExpr)-                         HPQ.PrimExpr-                         a b)+  Aggregator (PM.PackMap (HPQ.Aggr, HPQ.PrimExpr) HPQ.PrimExpr a b)  makeAggr' :: Maybe HPQ.AggrOp -> Aggregator (C.Field_ n a) (C.Field_ n' b) makeAggr' mAggrOp = P.dimap C.unColumn C.Column $ Aggregator (PM.PackMap-  (\f e -> f (fmap (, [], HPQ.AggrAll) mAggrOp, e)))+  (\f e -> f (aggr, e)))+  where+    aggr = case mAggrOp of+      Nothing -> HPQ.GroupBy+      Just op -> HPQ.Aggr op [] HPQ.AggrAll Nothing  makeAggr :: HPQ.AggrOp -> Aggregator (C.Field_ n a) (C.Field_ n' b) makeAggr = makeAggr' . Just@@ -78,13 +81,18 @@  orderAggregate :: O.Order a -> Aggregator a b -> Aggregator a b orderAggregate o (Aggregator (PM.PackMap pm)) = Aggregator (PM.PackMap-  (\f c -> pm (f . P.first' (fmap ((\f' (a,b,c') -> (a,f' b,c')) (const $ O.orderExprs c o)))) c))+  (\f c -> pm (f . P.first' (setOrder (O.orderExprs c o))) c))+  where+    setOrder _ HPQ.GroupBy = HPQ.GroupBy+    setOrder order aggr =+      aggr+        { HPQ.aggrOrder = order+        }  runAggregator   :: Applicative f   => Aggregator a b-  -> ((Maybe (HPQ.AggrOp, [HPQ.OrderExpr], HPQ.AggrDistinct), HPQ.PrimExpr)-     -> f HPQ.PrimExpr)+  -> ((HPQ.Aggr, HPQ.PrimExpr) -> f HPQ.PrimExpr)   -> a -> f b runAggregator (Aggregator a) = PM.traversePM a @@ -151,6 +159,29 @@  unsafeSum :: Aggregator (C.Field a) (C.Field a) unsafeSum = makeAggr HPQ.AggrSum++-- | Aggregate only rows matching the given predicate+filterWhereInternal+  :: (F.FieldNullable T.SqlBool -> b -> mb)+  -> (a -> F.Field T.SqlBool)+  -> Aggregator a b+  -> Aggregator a mb+filterWhereInternal maybeField predicate aggregator =+  case liftA2 maybeField true aggregator of+    Aggregator (PM.PackMap pm) ->+      Aggregator (PM.PackMap (\f c -> pm (f . P.first' (setFilter c)) c))+  where+    true = P.lmap (const (T.sqlBool True)) (makeAggr HPQ.AggrBoolAnd)+    setFilter _ HPQ.GroupBy = HPQ.GroupBy+    setFilter row aggr =+      aggr+        { HPQ.aggrFilter = aggrFilter'+        }+      where+        C.Column cond' = predicate row+        aggrFilter' = Just $ case HPQ.aggrFilter aggr of+          Nothing -> cond'+          Just cond -> HPQ.BinExpr HPQ.OpAnd cond cond'  -- { Boilerplate instances 

@@ -22,7 +22,7 @@                 | CompositeExpr     PrimExpr Attribute -- ^ Composite Type Query                 | BinExpr   BinOp PrimExpr PrimExpr                 | UnExpr    UnOp PrimExpr-                | AggrExpr  AggrDistinct AggrOp PrimExpr [OrderExpr]+                | AggrExpr  AggrDistinct AggrOp PrimExpr [OrderExpr] (Maybe PrimExpr)                 | WndwExpr  WndwOp Partition                 | ConstExpr Literal                 | CaseExpr [(PrimExpr,PrimExpr)] PrimExpr@@ -86,6 +86,16 @@  data AggrDistinct = AggrDistinct | AggrAll                   deriving (Eq,Show,Read)++data Aggr+  = GroupBy+  | Aggr+      { aggrOp :: !AggrOp+      , aggrOrder :: ![OrderExpr]+      , aggrDistinct :: !AggrDistinct+      , aggrFilter :: !(Maybe PrimExpr)+      }+  deriving (Show, Read)  data OrderExpr = OrderExpr OrderOp PrimExpr                deriving (Show,Read)

@@ -52,7 +52,7 @@              | PrefixSqlExpr  String SqlExpr              | PostfixSqlExpr String SqlExpr              | FunSqlExpr     String [SqlExpr]-             | AggrFunSqlExpr String [SqlExpr] [(SqlExpr, SqlOrder)] SqlDistinct -- ^ Aggregate functions separate from normal functions.+             | AggrFunSqlExpr String [SqlExpr] [(SqlExpr, SqlOrder)] SqlDistinct (Maybe SqlExpr) -- ^ Aggregate functions separate from normal functions.              | WndwFunSqlExpr String [SqlExpr] SqlPartition              | ConstSqlExpr   String              | CaseSqlExpr    (NEL.NonEmpty (SqlExpr,SqlExpr)) SqlExpr

@@ -136,12 +136,15 @@       -- because it leads to a non-uniformity of treatment, as seen       -- below.  Perhaps we should have just `AggrExpr AggrOp` and       -- always put the `PrimExpr` in the `AggrOp`.-      AggrExpr distinct op e ord -> let (op', e') = showAggrOp gen op e-                                        ord' = toSqlOrder gen <$> ord-                                        distinct' = case distinct of-                                                      AggrDistinct -> SqlDistinct-                                                      AggrAll      -> SqlNotDistinct-                                     in AggrFunSqlExpr op' e' ord' distinct'+      AggrExpr distinct op e ord mfilter ->+        let+          (op', e') = showAggrOp gen op e+          ord' = toSqlOrder gen <$> ord+          distinct' = case distinct of+            AggrDistinct -> SqlDistinct+            AggrAll      -> SqlNotDistinct+          mfilter' = sqlExpr gen <$> mfilter+         in AggrFunSqlExpr op' e' ord' distinct' mfilter'       WndwExpr op window  -> let (op', e') = showWndwOp gen op                                  window' = toSqlPartition gen window                               in WndwFunSqlExpr op' e' window'

@@ -192,7 +192,9 @@       DefaultSqlExpr         -> text "DEFAULT"       ArraySqlExpr es        -> text "ARRAY" <> brackets (commaH ppSqlExpr es)       RangeSqlExpr t s e     -> ppRange t s e-      AggrFunSqlExpr f es ord distinct -> text f <> parens (ppSqlDistinct distinct <+> commaH ppSqlExpr es <+> ppOrderBy ord)+      AggrFunSqlExpr f es ord distinct mfilter -> text f <> parens (ppSqlDistinct distinct <+> commaH ppSqlExpr es <+> ppOrderBy ord) <+> case mfilter of+        Nothing -> mempty+        Just e -> text "FILTER" <+> parens (text "WHERE" <+> ppSqlExpr e)       WndwFunSqlExpr f es window -> ppWindowExpr f es window       CaseSqlExpr cs el   -> text "CASE" <+> vcat (toList (fmap ppWhen cs))                              <+> text "ELSE" <+> ppSqlExpr el <+> text "END"

@@ -128,10 +128,7 @@                   | Product   (NEL.NonEmpty (Lateral, PrimQuery' a)) [HPQ.PrimExpr]                   -- | The subqueries to take the product of and the                   --   restrictions to apply-                  | Aggregate (Bindings (Maybe (HPQ.AggrOp,-                                                [HPQ.OrderExpr],-                                                HPQ.AggrDistinct),-                                          HPQ.Symbol))+                  | Aggregate (Bindings (HPQ.Aggr, HPQ.Symbol))                               (PrimQuery' a)                   | Window (Bindings (HPQ.WndwOp, HPQ.Partition)) (PrimQuery' a)                   -- | Represents both @DISTINCT ON@ and @ORDER BY@@@ -176,9 +173,7 @@   , empty             :: a -> p'   , baseTable         :: TableIdentifier -> Bindings HPQ.PrimExpr -> p'   , product           :: NEL.NonEmpty (Lateral, p) -> [HPQ.PrimExpr] -> p'-  , aggregate         :: Bindings (Maybe-                             (HPQ.AggrOp, [HPQ.OrderExpr], HPQ.AggrDistinct),-                                   HPQ.Symbol)+  , aggregate         :: Bindings (HPQ.Aggr, HPQ.Symbol)                       -> p                       -> p'   , window            :: Bindings (HPQ.WndwOp, HPQ.Partition) -> p -> p'

@@ -158,9 +158,7 @@           PQ.Lateral    -> Lateral           PQ.NonLateral -> NonLateral -aggregate :: [(Symbol,-               (Maybe (HPQ.AggrOp, [HPQ.OrderExpr], HPQ.AggrDistinct),-                HPQ.Symbol))]+aggregate :: PQ.Bindings (HPQ.Aggr, HPQ.Symbol)           -> Select           -> Select aggregate aggrs' s =@@ -192,19 +190,17 @@          aggrs = (map . Arr.second . Arr.second) HPQ.AttrExpr aggrs' -        groupBy' :: [(symbol, (Maybe aggrOp, HPQ.PrimExpr))]+        groupBy' :: [(symbol, (HPQ.Aggr, HPQ.PrimExpr))]                  -> NEL.NonEmpty HSql.SqlExpr-        groupBy' = handleEmpty-                   . map sqlExpr-                   . map expr-                   . filter (M.isNothing . aggrOp)+        groupBy' aggs = handleEmpty $ do+          (_, (HPQ.GroupBy, e)) <- aggs+          pure $ sqlExpr e         attr = sqlBinding . Arr.second (uncurry aggrExpr)-        expr (_, (_, e)) = e-        aggrOp (_, (x, _)) = x --aggrExpr :: Maybe (HPQ.AggrOp, [HPQ.OrderExpr], HPQ.AggrDistinct) -> HPQ.PrimExpr -> HPQ.PrimExpr-aggrExpr = maybe id (\(op, ord, distinct) e -> HPQ.AggrExpr distinct op e ord)+aggrExpr :: HPQ.Aggr -> HPQ.PrimExpr -> HPQ.PrimExpr+aggrExpr = \case+  HPQ.GroupBy -> id+  HPQ.Aggr op ord distinct filter -> \e -> HPQ.AggrExpr distinct op e ord filter  window :: PQ.Bindings (HPQ.WndwOp, HPQ.Partition) -> Select -> Select window wndws' s = SelectFrom $ newSelect

@@ -128,8 +128,8 @@ aggregatorWindowFunction :: A.Aggregator a b -> (a' -> a) -> WindowFunction a' b aggregatorWindowFunction agg g = WindowFunction $ PM.PackMap $ \f a ->   pm (\(mop, expr) -> case mop of-         Nothing -> pure expr-         Just (op, _, _) -> f (HPQ.WndwAggregate op expr)) a+         HPQ.GroupBy -> pure expr+         HPQ.Aggr op _ _ _ -> f (HPQ.WndwAggregate op expr)) a   where A.Aggregator (PM.PackMap pm) = lmap g agg