opaleye 0.10.1.1 → 0.10.2.0

raw patch · 37 files changed

+251/−154 lines, 37 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• Doc/Tutorial/TutorialBasic.lhs +2/−5
• Doc/Tutorial/TutorialBasicMonomorphic.lhs +4/−4
• README.md +1/−1
• Test/Opaleye/Test/Arbitrary.hs +1/−1
• Test/Opaleye/Test/Fields.hs +0/−1
• Test/QuickCheck.hs +0/−1
• Test/Test.hs +1/−2
• opaleye.cabal +3/−3
• src/Opaleye/Aggregate.hs +9/−7
• src/Opaleye/Field.hs +2/−1
• src/Opaleye/FunctionalJoin.hs +0/−3
• src/Opaleye/Internal/Aggregate.hs +50/−21
• src/Opaleye/Internal/Binary.hs +0/−1
• src/Opaleye/Internal/Constant.hs +0/−3
• src/Opaleye/Internal/Distinct.hs +0/−2
• src/Opaleye/Internal/HaskellDB/PrimQuery.hs +23/−14
• src/Opaleye/Internal/HaskellDB/Sql.hs +1/−1
• src/Opaleye/Internal/HaskellDB/Sql/Default.hs +26/−27
• src/Opaleye/Internal/HaskellDB/Sql/Print.hs +10/−3
• src/Opaleye/Internal/JSONBuildObjectFields.hs +0/−1
• src/Opaleye/Internal/MaybeFields.hs +8/−0
• src/Opaleye/Internal/Optimize.hs +2/−3
• src/Opaleye/Internal/PackMap.hs +1/−1
• src/Opaleye/Internal/PrimQuery.hs +9/−7
• src/Opaleye/Internal/Print.hs +5/−0
• src/Opaleye/Internal/QueryArr.hs +0/−2
• src/Opaleye/Internal/RunQuery.hs +1/−1
• src/Opaleye/Internal/RunQueryExternal.hs +0/−1
• src/Opaleye/Internal/Sql.hs +24/−16
• src/Opaleye/Internal/Table.hs +1/−3
• src/Opaleye/Internal/Unpackspec.hs +0/−1
• src/Opaleye/Internal/Values.hs +1/−3
• src/Opaleye/Internal/Window.hs +5/−6
• src/Opaleye/MaybeFields.hs +1/−0
• src/Opaleye/Operators.hs +31/−0
• src/Opaleye/With.hs +20/−8

@@ -1,3 +1,12 @@+## 0.10.2.0++* Added `isJustAnd`++* Add `withMaterialized` (thanks to Shane O'Brien)++* Added 'dateTruncTimestamp` and `dateTruncTimestamptz` (thanks to+  @njaremko)+ ## 0.10.1.1  * Fix bugs in `WITH`.  See

@@ -171,8 +171,7 @@ Projection gives us our first example of using "do notation" to write Opaleye queries. -Here we run the `personSelect` passing in () to signify "zero-arguments".  We pattern match on the results and return only the+Here we run the `personSelect`, pattern match on the results and return only the fields we are interested in.  > nameAge :: Select (Field SqlText, Field SqlInt4)@@ -644,9 +643,7 @@ Outer join ========== -Opaleye supports left joins.  (Full outer joins and right joins are-left to be added as a simple starter project for a new Opaleye-contributor!)+Opaleye supports left joins.  Because left joins can change non-nullable fields into nullable fields we have to make sure the type of the output supports

@@ -7,7 +7,7 @@ > import           Prelude hiding (sum) > > import           Opaleye (Field, FieldNullable,->                          Table, table, selectTable,+>                          Table, table, tableWithSchema, selectTable, >                          tableField, >                          Select, (.==), >                          aggregate, groupBy,@@ -69,9 +69,9 @@  > personTable' :: Table (Field SqlText, Field SqlInt4, Field SqlText) >                       (Field SqlText, Field SqlInt4, Field SqlText)-> personTable' = table "personTable" (p3 ( tableField "name"->                                        , tableField "age"->                                        , tableField "address" ))+> personTable' = tableWithSchema "myschema" "personTable" (p3 ( tableField "name"+>                                                             , tableField "age"+>                                                             , tableField "address" ))  By default, the table `"personTable"` is looked up in PostgreSQL's default `"public"` schema. If we wanted to specify a different schema we

@@ -1,4 +1,4 @@-# Brief introduction to Opaleye [![Hackage version](https://img.shields.io/hackage/v/opaleye.svg?label=Hackage)](https://hackage.haskell.org/package/opaleye) [![Build status](https://img.shields.io/github/workflow/status/tomjaguarpaw/haskell-opaleye/ci/master.svg)](https://github.com/tomjaguarpaw/haskell-opaleye/actions)+# Brief introduction to Opaleye [![Hackage version](https://img.shields.io/hackage/v/opaleye.svg?label=Hackage)](https://hackage.haskell.org/package/opaleye)[![Stackage version](https://www.stackage.org/package/opaleye/badge/nightly?label=Stackage)](https://www.stackage.org/package/opaleye)[![Build status](https://img.shields.io/github/actions/workflow/status/tomjaguarpaw/haskell-opaleye/ci.yml?branch=master)](https://github.com/tomjaguarpaw/haskell-opaleye/actions)  Opaleye is a Haskell library that provides an SQL-generating embedded domain specific language for targeting Postgres.  You need Opaleye if

@@ -16,7 +16,7 @@ import qualified Opaleye.Exists as OE import qualified Opaleye.Join as OJ -import           Control.Applicative (pure, (<$>), (<*>), liftA2)+import           Control.Applicative (liftA2) import qualified Control.Arrow as Arrow import           Control.Arrow ((<<<)) import           Control.Category ((.), id)

@@ -18,7 +18,6 @@ import qualified Opaleye.Internal.Values as OV  import           Control.Arrow ((>>>))-import           Control.Applicative (pure) import qualified Data.Profunctor.Product.Default as D import qualified Data.Profunctor as P import qualified Data.Profunctor.Product as PP

@@ -20,7 +20,6 @@ import qualified Opaleye.Exists as OE  import qualified Database.PostgreSQL.Simple as PGS-import           Control.Applicative (Applicative, pure, (<$>), (<*>)) import qualified Control.Arrow as Arrow import           Control.Arrow ((<<<)) import           Control.Category (Category, (.), id)

@@ -6,7 +6,7 @@ module Main where  import qualified Configuration.Dotenv             as Dotenv-import           Control.Applicative              ((<$>), (<*>), (<|>))+import           Control.Applicative              ((<|>)) import qualified Control.Applicative              as A import           Control.Arrow                    ((&&&), (***), (<<<), (>>>)) import qualified Control.Arrow                    as Arr@@ -15,7 +15,6 @@ import qualified Data.Function                    as F import           Data.Int (Int32) import qualified Data.List                        as L-import           Data.Monoid                      ((<>)) import qualified Data.Ord                         as Ord import qualified Data.Profunctor                  as P import qualified Data.Profunctor.Product          as PP

@@ -1,6 +1,6 @@ name:            opaleye copyright:       Copyright (c) 2014-2018 Purely Agile Limited; 2019-2023 Tom Ellis-version:         0.10.1.1+version:         0.10.2.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@@ -27,7 +27,7 @@   hs-source-dirs: src   build-depends:       aeson               >= 0.6     && < 2.3-    , base                >= 4.9     && < 4.19+    , base                >= 4.9     && < 4.20     , base16-bytestring   >= 0.1.1.6 && < 1.1     , case-insensitive    >= 1.2     && < 1.3     , bytestring          >= 0.10    && < 0.12@@ -38,7 +38,7 @@     , profunctors         >= 4.0     && < 5.7     , scientific          >= 0.3     && < 0.4     , semigroups          >= 0.13    && < 0.21-    , text                >= 0.11    && < 2.1+    , text                >= 0.11    && < 2.2     , transformers        >= 0.3     && < 0.7     , time-compat         >= 1.9.5   && < 1.12     , time-locale-compat  >= 0.1     && < 0.2

@@ -35,19 +35,18 @@        , countRows        ) where -import           Control.Applicative (pure) import           Data.Profunctor     (lmap) import qualified Data.Profunctor as P  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+import qualified Opaleye.Internal.Unpackspec as U  import qualified Opaleye.Field     as F import qualified Opaleye.Order     as Ord@@ -106,11 +105,11 @@ -- | 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' setDistinct) c))+  A.Aggregator (PM.PackMap (\f c -> pm (f . setDistinct) c))   where-    setDistinct HPQ.GroupBy = HPQ.GroupBy-    setDistinct aggr =-      aggr+    setDistinct (HPQ.GroupBy expr) = HPQ.GroupBy expr+    setDistinct (HPQ.Aggregate aggr) =+      HPQ.Aggregate aggr         { HPQ.aggrDistinct = HPQ.AggrDistinct         } @@ -195,7 +194,10 @@  stringAgg :: F.Field T.SqlText           -> Aggregator (F.Field T.SqlText) (F.Field T.SqlText)-stringAgg = A.makeAggr' . Just . HPQ.AggrStringAggr . IC.unColumn+stringAgg delimiter =+  A.makeAggrExplicit+    (U.unpackspecField <* lmap (const delimiter) U.unpackspecField)+    HPQ.AggrStringAggr  -- | Count the number of rows in a query.  This is different from -- 'aggregate' 'count' because it always returns exactly one row, even

@@ -20,7 +20,8 @@   Field,   FieldNullable,   Nullability(..),-  -- * Coercing fields+  -- * Casting fields+  C.unsafeCast,   unsafeCoerceField,   -- * Working with @NULL@   -- | Instead of working with @NULL@ you are recommended to use

@@ -10,9 +10,6 @@   fullJoinF,   ) where -import           Control.Applicative             ((<$>), (<*>))-import           Control.Arrow                   ((<<<))- import qualified Data.Profunctor.Product.Default as D import qualified Data.Profunctor.Product         as PP 

@@ -1,7 +1,9 @@ {-# LANGUAGE TupleSections #-} module Opaleye.Internal.Aggregate where -import           Control.Applicative (Applicative, liftA2, pure, (<*>))+import           Control.Applicative (liftA2)+import           Data.Foldable (toList)+import           Data.Traversable (for)  import qualified Data.Profunctor as P import qualified Data.Profunctor.Product as PP@@ -12,6 +14,7 @@ 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.Unpackspec as U import qualified Opaleye.SqlTypes as T  import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ@@ -30,19 +33,28 @@ takes a list of @a@ and returns a single value of type @b@. -} newtype Aggregator a b =-  Aggregator (PM.PackMap (HPQ.Aggr, HPQ.PrimExpr) HPQ.PrimExpr a b)+  Aggregator (PM.PackMap HPQ.Aggregate 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 (aggr, e)))+  (\f e -> f (aggr e)))   where     aggr = case mAggrOp of       Nothing -> HPQ.GroupBy-      Just op -> HPQ.Aggr op [] HPQ.AggrAll Nothing+      Just op -> \e -> HPQ.Aggregate (HPQ.Aggr op [e] [] HPQ.AggrAll [] Nothing)  makeAggr :: HPQ.AggrOp -> Aggregator (C.Field_ n a) (C.Field_ n' b) makeAggr = makeAggr' . Just +makeAggrExplicit :: U.Unpackspec a a' -> HPQ.AggrOp -> Aggregator a (C.Field_ n b)+makeAggrExplicit unpackspec op =+  C.Column <$> Aggregator (PM.PackMap (\f e -> f (aggr e)))+  where+    aggr a = HPQ.Aggregate (HPQ.Aggr op exprs [] HPQ.AggrAll [] Nothing)+      where+        exprs = U.collectPEs unpackspec a++ -- | Order the values within each aggregation in `Aggregator` using -- the given ordering. This is only relevant for aggregations that -- depend on the order they get their elements, like@@ -81,18 +93,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' (setOrder (O.orderExprs c o))) c))+  (\f c -> pm (f . setOrder (O.orderExprs c o)) c))   where-    setOrder _ HPQ.GroupBy = HPQ.GroupBy-    setOrder order aggr =-      aggr+    setOrder _ (HPQ.GroupBy e) = HPQ.GroupBy e+    setOrder order (HPQ.Aggregate aggr) =+      HPQ.Aggregate aggr         { HPQ.aggrOrder = order         }  runAggregator   :: Applicative f   => Aggregator a b-  -> ((HPQ.Aggr, HPQ.PrimExpr) -> f HPQ.PrimExpr)+  -> (HPQ.Aggregate -> f HPQ.PrimExpr)   -> a -> f b runAggregator (Aggregator a) = PM.traversePM a @@ -127,25 +139,32 @@           PM.run (runAggregator agg (extractAggregateFields t0) c0)          projPEs = map fst projPEs_inners-        inners  = map snd projPEs_inners+        inners  = concatMap snd projPEs_inners          primQ' = PQ.Aggregate projPEs (PQ.Rebind True inners primQ)  extractAggregateFields-  :: T.Tag-  -> (m, HPQ.PrimExpr)+  :: Traversable t+  => T.Tag+  -> (t HPQ.PrimExpr)   -> PM.PM [((HPQ.Symbol,-              (m, HPQ.Symbol)),-              (HPQ.Symbol, HPQ.PrimExpr))]+              t HPQ.Symbol),+              PQ.Bindings HPQ.PrimExpr)]            HPQ.PrimExpr-extractAggregateFields tag (m, pe) = do+extractAggregateFields tag agg = do   i <- PM.new    let souter = HPQ.Symbol ("result" ++ i) tag-      sinner = HPQ.Symbol ("inner" ++ i) tag -  PM.write ((souter, (m, sinner)), (sinner, pe))+  bindings <- for agg $ \pe -> do+    j <- PM.new+    let sinner = HPQ.Symbol ("inner" ++ j) tag+    pure (sinner, pe) +  let agg' = fmap fst bindings++  PM.write ((souter, agg'), toList bindings)+   pure (HPQ.AttrExpr souter)  unsafeMax :: Aggregator (C.Field a) (C.Field a)@@ -169,12 +188,12 @@ 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))+      Aggregator (PM.PackMap (\f c -> pm (f . setFilter c) c))   where     true = P.lmap (const (T.sqlBool True)) (makeAggr HPQ.AggrBoolAnd)-    setFilter _ HPQ.GroupBy = HPQ.GroupBy-    setFilter row aggr =-      aggr+    setFilter _ (HPQ.GroupBy e) = HPQ.GroupBy e+    setFilter row (HPQ.Aggregate aggr) =+      HPQ.Aggregate aggr         { HPQ.aggrFilter = aggrFilter'         }       where@@ -182,6 +201,16 @@         aggrFilter' = Just $ case HPQ.aggrFilter aggr of           Nothing -> cond'           Just cond -> HPQ.BinExpr HPQ.OpAnd cond cond'++withinGroup :: O.Order a -> Aggregator a b -> Aggregator a b+withinGroup o (Aggregator (PM.PackMap pm)) = Aggregator (PM.PackMap+  (\f c -> pm (f . setOrder (O.orderExprs c o)) c))+  where+    setOrder _ (HPQ.GroupBy e) = HPQ.GroupBy e+    setOrder order (HPQ.Aggregate aggr) =+      HPQ.Aggregate aggr+        { HPQ.aggrGroup = order+        }  -- { Boilerplate instances 

@@ -17,7 +17,6 @@ import qualified Data.Profunctor.Product as PP import           Data.Profunctor.Product.Default (Default, def) -import           Control.Applicative (Applicative, pure, (<*>)) import           Control.Arrow ((***))  extractBinaryFields :: T.Tag -> (HPQ.PrimExpr, HPQ.PrimExpr)

@@ -25,9 +25,6 @@ import qualified Data.Profunctor.Product.Default as D import qualified Data.Profunctor                 as P -import           Control.Applicative (Applicative, pure, (<*>))-import           Data.Functor                    ((<$>))- import qualified Database.PostgreSQL.Simple.Range as R import           Database.PostgreSQL.Simple.Newtypes ( Aeson, getAeson ) 

@@ -10,8 +10,6 @@ import           Opaleye.Field (Field_) import           Opaleye.Aggregate (Aggregator, groupBy, aggregate) -import           Control.Applicative (Applicative, pure, (<*>))- import qualified Data.Profunctor as P import qualified Data.Profunctor.Product as PP import           Data.Profunctor.Product.Default (Default, def)

@@ -2,6 +2,8 @@ --                HWT Group (c) 2003, haskelldb-users@lists.sourceforge.net -- License     :  BSD-style +{-# LANGUAGE DeriveTraversable #-}+ module Opaleye.Internal.HaskellDB.PrimQuery where  import qualified Opaleye.Internal.Tag as T@@ -22,7 +24,7 @@                 | CompositeExpr     PrimExpr Attribute -- ^ Composite Type Query                 | BinExpr   BinOp PrimExpr PrimExpr                 | UnExpr    UnOp PrimExpr-                | AggrExpr  AggrDistinct AggrOp PrimExpr [OrderExpr] (Maybe PrimExpr)+                | AggrExpr  (Aggr' PrimExpr)                 | WndwExpr  WndwOp Partition                 | ConstExpr Literal                 | CaseExpr [(PrimExpr,PrimExpr)] PrimExpr@@ -80,26 +82,33 @@ data AggrOp     = AggrCount | AggrSum | AggrAvg | AggrMin | AggrMax                 | AggrStdDev | AggrStdDevP | AggrVar | AggrVarP                 | AggrBoolOr | AggrBoolAnd | AggrArr | JsonArr-                | AggrStringAggr PrimExpr+                | AggrStringAggr                 | AggrOther String                 deriving (Show,Read)  data AggrDistinct = AggrDistinct | AggrAll                   deriving (Eq,Show,Read) -data Aggr-  = GroupBy-  | Aggr-      { aggrOp :: !AggrOp-      , aggrOrder :: ![OrderExpr]-      , aggrDistinct :: !AggrDistinct-      , aggrFilter :: !(Maybe PrimExpr)-      }-  deriving (Show, Read)+type Aggregate = Aggregate' PrimExpr -data OrderExpr = OrderExpr OrderOp PrimExpr-               deriving (Show,Read)+data Aggregate' a = GroupBy a | Aggregate (Aggr' a)+  deriving (Functor, Foldable, Traversable, Show, Read) +data Aggr' a = Aggr+  { aggrOp :: !AggrOp+  , aggrExprs :: ![a]+  , aggrOrder :: ![OrderExpr' a]+  , aggrDistinct :: !AggrDistinct+  , aggrGroup :: ![OrderExpr' a]+  , aggrFilter :: !(Maybe PrimExpr)+  }+  deriving (Functor, Foldable, Traversable, Show, Read)++type OrderExpr = OrderExpr' PrimExpr++data OrderExpr' a = OrderExpr OrderOp a+  deriving (Functor, Foldable, Traversable, Show, Read)+ data OrderNulls = NullsFirst | NullsLast                 deriving (Show,Read) @@ -125,7 +134,7 @@   | WndwFirstValue PrimExpr   | WndwLastValue PrimExpr   | WndwNthValue PrimExpr PrimExpr-  | WndwAggregate AggrOp PrimExpr+  | WndwAggregate AggrOp [PrimExpr]   deriving (Show,Read)  data Partition = Partition

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

@@ -2,9 +2,9 @@ --                HWT Group (c) 2003, haskelldb-users@lists.sourceforge.net -- License     :  BSD-style -module Opaleye.Internal.HaskellDB.Sql.Default  where+{-# LANGUAGE LambdaCase #-} -import Control.Applicative ((<$>))+module Opaleye.Internal.HaskellDB.Sql.Default  where  import Opaleye.Internal.HaskellDB.PrimQuery import qualified Opaleye.Internal.HaskellDB.PrimQuery as PQ@@ -130,21 +130,16 @@                                 UnOpFun     -> FunSqlExpr op' [e']                                 UnOpPrefix  -> PrefixSqlExpr op' (ParensSqlExpr e')                                 UnOpPostfix -> PostfixSqlExpr op' (ParensSqlExpr e')-      -- TODO: The current arrangement whereby the delimiter parameter-      -- of string_agg is in the AggrStringAggr constructor, but the-      -- parameter being aggregated is not, seems unsatisfactory-      -- 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 mfilter ->+      AggrExpr (Aggr op e ord distinct group mfilter) ->         let           (op', e') = showAggrOp gen op e           ord' = toSqlOrder gen <$> ord           distinct' = case distinct of             AggrDistinct -> SqlDistinct             AggrAll      -> SqlNotDistinct+          group' = toSqlOrder gen <$> group           mfilter' = sqlExpr gen <$> mfilter-         in AggrFunSqlExpr op' e' ord' distinct' mfilter'+         in AggrFunSqlExpr op' e' ord' distinct' group' mfilter'       WndwExpr op window  -> let (op', e') = showWndwOp gen op                                  window' = toSqlPartition gen window                               in WndwFunSqlExpr op' e' window'@@ -223,23 +218,27 @@ sqlUnOp  (UnOpOther s) = (s, UnOpFun)  -showAggrOp :: SqlGenerator -> AggrOp -> PrimExpr -> (String, [SqlExpr])-showAggrOp gen op arg = case op of-  AggrCount -> ("COUNT", [sqlExpr gen arg])-  AggrSum -> ("SUM", [sqlExpr gen arg])-  AggrAvg -> ("AVG", [sqlExpr gen arg])-  AggrMin -> ("MIN", [sqlExpr gen arg])-  AggrMax -> ("MAX", [sqlExpr gen arg])-  AggrStdDev -> ("StdDev", [sqlExpr gen arg])-  AggrStdDevP -> ("StdDevP", [sqlExpr gen arg])-  AggrVar -> ("Var", [sqlExpr gen arg])-  AggrVarP -> ("VarP", [sqlExpr gen arg])-  AggrBoolAnd -> ("BOOL_AND", [sqlExpr gen arg])-  AggrBoolOr -> ("BOOL_OR", [sqlExpr gen arg])-  AggrArr -> ("ARRAY_AGG", [sqlExpr gen arg])-  JsonArr -> ("JSON_AGG", [sqlExpr gen arg])-  AggrStringAggr sep -> ("STRING_AGG", [sqlExpr gen arg, sqlExpr gen sep])-  AggrOther s -> (s, [sqlExpr gen arg])+showAggrOp :: SqlGenerator -> AggrOp -> [PrimExpr] -> (String, [SqlExpr])+showAggrOp gen op args = (showAggrOpFunction op, map (sqlExpr gen) args)+++showAggrOpFunction :: AggrOp -> String+showAggrOpFunction = \case+  AggrCount -> "COUNT"+  AggrSum -> "SUM"+  AggrAvg -> "AVG"+  AggrMin -> "MIN"+  AggrMax -> "MAX"+  AggrStdDev -> "StdDev"+  AggrStdDevP -> "StdDevP"+  AggrVar -> "Var"+  AggrVarP -> "VarP"+  AggrBoolAnd -> "BOOL_AND"+  AggrBoolOr -> "BOOL_OR"+  AggrArr -> "ARRAY_AGG"+  JsonArr -> "JSON_AGG"+  AggrStringAggr -> "STRING_AGG"+  AggrOther s -> s   showWndwOp :: SqlGenerator -> WndwOp -> (String, [SqlExpr])

@@ -192,9 +192,16 @@       DefaultSqlExpr         -> text "DEFAULT"       ArraySqlExpr es        -> text "ARRAY" <> brackets (commaH ppSqlExpr es)       RangeSqlExpr t s e     -> ppRange t s e-      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)+      AggrFunSqlExpr f es ord distinct group mfilter ->+        text f <> args <+> within <+> filter+        where+          args = parens (ppSqlDistinct distinct <+> commaH ppSqlExpr es <+> ppOrderBy ord)+          within = case group of+            [] -> empty+            _ -> text "WITHIN GROUP" <+> parens (ppOrderBy group)+          filter = 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"

@@ -9,7 +9,6 @@ import Opaleye.Field (Field) import Opaleye.Internal.HaskellDB.PrimQuery (Literal (StringLit), PrimExpr (ConstExpr, FunExpr)) import Opaleye.Internal.PGTypesExternal (SqlJson)-import Data.Semigroup  -- | Combine @JSONBuildObjectFields@ using @('<>')@ newtype JSONBuildObjectFields

@@ -142,6 +142,14 @@    where a `implies` b = Opaleye.Internal.Operators.not a .|| b +isJustAnd ::+  MaybeFields a ->+  (a -> Opaleye.Field.Field SqlBool) ->+  Opaleye.Field.Field SqlBool+isJustAnd ma cond = matchMaybe ma $ \case+  Nothing -> Opaleye.SqlTypes.sqlBool False+  Just a -> cond a+ optional :: SelectArr i a -> SelectArr i (MaybeFields a) optional = Opaleye.Internal.Lateral.laterally (optionalInternal (MaybeFields . isNotNull))   where isNotNull = Opaleye.Internal.Operators.not . Opaleye.Field.isNull

@@ -8,9 +8,8 @@ import           Opaleye.Internal.Helpers   ((.:))  import qualified Data.List.NonEmpty as NEL-import           Data.Semigroup ((<>)) -import           Control.Applicative ((<$>), (<*>), liftA2, pure)+import           Control.Applicative (liftA2) import           Control.Arrow (first)  optimize :: PQ.PrimQuery' a -> PQ.PrimQuery' a@@ -73,7 +72,7 @@   , PQ.relExpr   = return .: PQ.RelExpr   , PQ.rebind    = \b -> fmap . PQ.Rebind b   , PQ.forUpdate = fmap PQ.ForUpdate-  , PQ.with      = \recursive name cols -> liftA2 (PQ.With recursive name cols)+  , PQ.with      = \recursive materialized name cols -> liftA2 (PQ.With recursive materialized name cols)   }   where -- If only the first argument is Just, do n1 on it         -- If only the second argument is Just, do n2 on it

@@ -7,7 +7,7 @@  import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ -import           Control.Applicative (Applicative, pure, (<*>), liftA2)+import           Control.Applicative (liftA2) import           Control.Arrow (first, second) import qualified Control.Monad.Trans.State as State import           Data.Profunctor (Profunctor, dimap, rmap)

@@ -5,7 +5,6 @@ import           Prelude hiding (product)  import qualified Data.List.NonEmpty as NEL-import           Data.Semigroup (Semigroup, (<>)) import qualified Opaleye.Internal.HaskellDB.Sql as HSql import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ import           Opaleye.Internal.HaskellDB.PrimQuery (Symbol)@@ -50,6 +49,9 @@ data Recursive = NonRecursive | Recursive   deriving Show +data Materialized = Materialized | NotMaterialized+  deriving Show+ aLeftJoin :: HPQ.PrimExpr -> PrimQuery -> PrimQueryArr aLeftJoin cond primQuery' = PrimQueryArr $ \lat primQueryL ->   Join LeftJoin cond (NonLateral, primQueryL) (lat, primQuery')@@ -131,7 +133,7 @@                   | Product   (NEL.NonEmpty (Lateral, PrimQuery' a)) [HPQ.PrimExpr]                   -- | The subqueries to take the product of and the                   --   restrictions to apply-                  | Aggregate (Bindings (HPQ.Aggr, HPQ.Symbol))+                  | Aggregate (Bindings (HPQ.Aggregate' HPQ.Symbol))                               (PrimQuery' a)                   | Window (Bindings (HPQ.WndwOp, HPQ.Partition)) (PrimQuery' a)                   -- | Represents both @DISTINCT ON@ and @ORDER BY@@@ -163,7 +165,7 @@                   -- ForUpdate in the future                   --                   -- https://www.postgresql.org/docs/current/sql-select.html#SQL-FOR-UPDATE-SHARE-                  | With Recursive Symbol [Symbol] (PrimQuery' a) (PrimQuery' a)+                  | With Recursive (Maybe Materialized) Symbol [Symbol] (PrimQuery' a) (PrimQuery' a)                  deriving Show  type PrimQuery = PrimQuery' ()@@ -176,7 +178,7 @@   , empty             :: a -> p'   , baseTable         :: TableIdentifier -> Bindings HPQ.PrimExpr -> p'   , product           :: NEL.NonEmpty (Lateral, p) -> [HPQ.PrimExpr] -> p'-  , aggregate         :: Bindings (HPQ.Aggr, HPQ.Symbol)+  , aggregate         :: Bindings (HPQ.Aggregate' HPQ.Symbol)                       -> p                       -> p'   , window            :: Bindings (HPQ.WndwOp, HPQ.Partition) -> p -> p'@@ -201,7 +203,7 @@     -- ^ A relation-valued expression   , rebind            :: Bool -> Bindings HPQ.PrimExpr -> p -> p'   , forUpdate         :: p -> p'-  , with              :: Recursive -> Symbol -> [Symbol] -> p -> p -> p'+  , with              :: Recursive -> Maybe Materialized -> Symbol -> [Symbol] -> p -> p -> p'   }  @@ -249,7 +251,7 @@   , relExpr = \pe bs -> g (relExpr f pe bs)   , rebind = \s bs p -> g (rebind f s bs (self p))   , forUpdate = \p -> g (forUpdate f (self p))-  , with = \r s ss p1 p2 -> g (with f r s ss (self p1) (self p2))+  , with = \r m s ss p1 p2 -> g (with f r m s ss (self p1) (self p2))   }  applyPrimQueryFoldF ::@@ -272,7 +274,7 @@   Exists s q -> exists f s q   Rebind star pes q -> rebind f star pes q   ForUpdate q -> forUpdate f q-  With recursive name cols a b -> with f recursive name cols a b+  With recursive materialized name cols a b -> with f recursive materialized name cols a b  primQueryFoldF ::   PrimQueryFoldP a p p' -> (PrimQuery' a -> p) -> PrimQuery' a -> p'

@@ -126,12 +126,17 @@ ppRecursive Sql.Recursive = text "RECURSIVE" ppRecursive Sql.NonRecursive = mempty +ppMaterialized :: Sql.Materialized -> Doc+ppMaterialized Sql.Materialized = text "MATERIALIZED"+ppMaterialized Sql.NotMaterialized = text "NOT MATERIALIZED"+ ppWith :: With -> Doc ppWith w   =  text "WITH" <+> ppRecursive (Sql.wRecursive w)   <+> HPrint.ppTable (Sql.wTable w)   <+> parens (HPrint.commaV unColumn (Sql.wCols w))   <+> text "AS"+  <+> foldMap ppMaterialized (Sql.wMaterialized w)   $$ parens (ppSql (Sql.wWith w))   $$ ppSql (Sql.wSelect w)   where unColumn (HSql.SqlColumn col) = text col

@@ -18,11 +18,9 @@ import           Control.Arrow ((&&&), (***), arr, returnA) import qualified Control.Category as C import           Control.Category ((<<<), id)-import           Control.Applicative (Applicative, pure, (<*>)) import           Control.Monad.Trans.State.Strict (State, evalState, runState, state) import qualified Data.Profunctor as P import qualified Data.Profunctor.Product as PP-import           Data.Semigroup ((<>))  -- | A parametrised 'Select'.  A @SelectArr a b@ accepts an argument -- of type @a@.

@@ -7,7 +7,7 @@ module Opaleye.Internal.RunQuery where  import           Control.Applicative-  (Applicative, pure, (<$>), (*>), (<*>), liftA2)+  (liftA2)  import qualified Database.PostgreSQL.Simple as PGS import qualified Database.PostgreSQL.Simple.Cursor  as PGSC (Cursor)

@@ -10,7 +10,6 @@                          IRQ.FromField,                  ) where -import           Control.Applicative (pure, (<$>)) import qualified Database.PostgreSQL.Simple as PGS import qualified Database.PostgreSQL.Simple.Cursor  as PGSC 

@@ -83,12 +83,14 @@ data Lateral = Lateral | NonLateral deriving Show data LockStrength = Update deriving Show data Recursive = NonRecursive | Recursive deriving Show+data Materialized = Materialized | NotMaterialized deriving Show data With = With {-  wTable     :: HSql.SqlTable, -- The name of the result, i.e. WITH <name> AS-  wCols      :: [HSql.SqlColumn],-  wRecursive :: Recursive,-  wWith      :: Select,-  wSelect    :: Select+  wTable        :: HSql.SqlTable, -- The name of the result, i.e. WITH <name> AS+  wCols         :: [HSql.SqlColumn],+  wRecursive    :: Recursive,+  wMaterialized :: Maybe Materialized,+  wWith         :: Select,+  wSelect       :: Select } deriving Show  @@ -158,13 +160,13 @@           PQ.Lateral    -> Lateral           PQ.NonLateral -> NonLateral -aggregate :: PQ.Bindings (HPQ.Aggr, HPQ.Symbol)+aggregate :: PQ.Bindings (HPQ.Aggregate' HPQ.Symbol)           -> Select           -> Select aggregate aggrs' s =   SelectFrom $ newSelect { attrs = SelectAttrs (ensureColumns (map attr aggrs))                          , tables = oneTable s-                         , groupBy = (Just . groupBy') aggrs }+                         , groupBy = Just (groupBy' aggrs) }   where --- Although in the presence of an aggregation function,         --- grouping by an empty list is equivalent to omitting group         --- by, the equivalence does not hold in the absence of an@@ -188,19 +190,21 @@         handleEmpty :: [HSql.SqlExpr] -> NEL.NonEmpty HSql.SqlExpr         handleEmpty = ensureColumnsGen SP.deliteral -        aggrs = (map . Arr.second . Arr.second) HPQ.AttrExpr aggrs'+        aggrs :: [(Symbol, HPQ.Aggregate)]+        aggrs = (map . Arr.second . fmap) HPQ.AttrExpr aggrs' -        groupBy' :: [(symbol, (HPQ.Aggr, HPQ.PrimExpr))]+        groupBy' :: [(symbol, HPQ.Aggregate)]                  -> NEL.NonEmpty HSql.SqlExpr         groupBy' aggs = handleEmpty $ do-          (_, (HPQ.GroupBy, e)) <- aggs+          (_, HPQ.GroupBy e) <- aggs           pure $ sqlExpr e-        attr = sqlBinding . Arr.second (uncurry aggrExpr) -aggrExpr :: HPQ.Aggr -> HPQ.PrimExpr -> HPQ.PrimExpr+        attr = sqlBinding . Arr.second aggrExpr++aggrExpr :: HPQ.Aggregate -> HPQ.PrimExpr aggrExpr = \case-  HPQ.GroupBy -> id-  HPQ.Aggr op ord distinct filter -> \e -> HPQ.AggrExpr distinct op e ord filter+  HPQ.GroupBy e -> e+  HPQ.Aggregate aggr -> HPQ.AggrExpr aggr  window :: PQ.Bindings (HPQ.WndwOp, HPQ.Partition) -> Select -> Select window wndws' s = SelectFrom $ newSelect@@ -264,8 +268,8 @@   bSelect2 = select2   } -with :: PQ.Recursive -> Symbol -> [Symbol] -> Select -> Select -> Select-with recursive name cols wWith wSelect =+with :: PQ.Recursive -> Maybe PQ.Materialized -> Symbol -> [Symbol] -> Select -> Select -> Select+with recursive materialized name cols wWith wSelect =   SelectFrom     newSelect       { attrs = Star@@ -276,6 +280,10 @@    wRecursive = case recursive of      PQ.NonRecursive -> NonRecursive      PQ.Recursive -> Recursive+   wMaterialized = case materialized of+     Nothing -> Nothing+     Just PQ.Materialized -> Just Materialized+     Just PQ.NotMaterialized -> Just NotMaterialized    wCols = map (HSql.SqlColumn . sqlSymbol) cols  

@@ -18,9 +18,7 @@ import           Data.Profunctor.Product (ProductProfunctor) import qualified Data.Profunctor.Product as PP import qualified Data.List.NonEmpty as NEL-import           Data.Monoid (Monoid, mempty, mappend)-import           Data.Semigroup (Semigroup, (<>))-import           Control.Applicative (Applicative, pure, (<*>), liftA2)+import           Control.Applicative (liftA2) import qualified Control.Arrow as Arr  -- | Define a table as follows, where \"id\", \"color\", \"location\",

@@ -8,7 +8,6 @@ import qualified Opaleye.Internal.Column as IC import qualified Opaleye.Field as F -import           Control.Applicative (Applicative, pure, (<*>)) import           Data.Profunctor (Profunctor, dimap) import           Data.Profunctor.Product (ProductProfunctor) import qualified Data.Profunctor.Product as PP

@@ -8,7 +8,6 @@ import           Opaleye.Internal.Column (Field_(Column)) import qualified Opaleye.Internal.Column as C import qualified Opaleye.Column as OC-import qualified Opaleye.Internal.Unpackspec as U import qualified Opaleye.Internal.Tag as T import qualified Opaleye.Internal.Operators as O import qualified Opaleye.Internal.PrimQuery as PQ@@ -25,9 +24,8 @@ import           Data.Profunctor.Product (ProductProfunctor) import qualified Data.Profunctor.Product as PP import           Data.Profunctor.Product.Default (Default, def)-import           Data.Semigroup (Semigroup, (<>)) -import           Control.Applicative (Applicative, pure, (<*>), liftA2)+import           Control.Applicative (liftA2)  nonEmptyValues :: Rowspec columns columns'                -> NEL.NonEmpty columns

@@ -7,11 +7,11 @@ -- Perhaps the answer should be "Window"?  This is also attested by -- the WINDOW declaration in a SELECT. +{-# LANGUAGE LambdaCase #-}+ module Opaleye.Internal.Window where -import           Control.Applicative (Applicative, pure, (<*>), liftA2) import           Data.Profunctor (lmap, Profunctor, dimap)-import           Data.Semigroup (Semigroup, (<>))  import qualified Opaleye.Internal.Aggregate as A import qualified Opaleye.Internal.PackMap as PM@@ -127,11 +127,10 @@ -- argument to 'over'). aggregatorWindowFunction :: A.Aggregator a b -> (a' -> a) -> WindowFunction a' b aggregatorWindowFunction agg g = WindowFunction $ PM.PackMap $ \f a ->-  pm (\(mop, expr) -> case mop of-         HPQ.GroupBy -> pure expr-         HPQ.Aggr op _ _ _ -> f (HPQ.WndwAggregate op expr)) a+  pm (\case+         HPQ.GroupBy expr -> pure expr+         HPQ.Aggregate (HPQ.Aggr op e _ _ _ _) -> f (HPQ.WndwAggregate op e)) a   where A.Aggregator (PM.PackMap pm) = lmap g agg-  -- | 'over' applies a 'WindowFunction' on a particular 'Window'.  For -- example,

@@ -19,6 +19,7 @@   fromMaybeFields,   maybeFields,   maybeFieldsToNullable,+  isJustAnd,   -- * Creating a 'Select' which returns 'MaybeFields'   Opaleye.Join.optional,   Opaleye.MaybeFields.traverseMaybeFields,

@@ -104,6 +104,9 @@   , IntervalNum   , addInterval   , minusInterval+  , TimestampPrecision(..)+  , dateTruncTimestamp+  , dateTruncTimestamptz   -- * Deprecated   ) @@ -137,6 +140,9 @@  import qualified Data.Profunctor.Product.Default as D +import qualified Data.Text as Text+import qualified Data.Text.Encoding as TE+ {-| Keep only the rows of a query satisfying a given condition, using an SQL @WHERE@ clause.  It is equivalent to the Haskell function @@ -492,3 +498,28 @@ -- | Current date and time (start of current transaction) now :: F.Field T.SqlTimestamptz now = Column $ HPQ.FunExpr "now" []++data TimestampPrecision =+  MicrosecondsPrecision+  | MillisecondsPrecision+  | SecondPrecision+  | MinutePrecision+  | HourPrecision+  | DayPrecision+  | WeekPrecision+  | MonthPrecision+  | QuarterPrecision+  | YearPrecision+  | DecadePrecision+  | CenturyPrecision+  | MillenniumPrecision+  deriving Show++precisionToExpr :: TimestampPrecision -> HPQ.PrimExpr+precisionToExpr p = HPQ.ConstExpr . HPQ.ByteStringLit . TE.encodeUtf8 . Text.toLower . Text.dropEnd 9 . Text.pack $ show p++dateTruncTimestamp :: TimestampPrecision -> F.Field T.SqlTimestamp -> F.Field T.SqlTimestamp+dateTruncTimestamp p (Column e) = Column $ HPQ.FunExpr "date_trunc" [(precisionToExpr p), e]++dateTruncTimestamptz :: TimestampPrecision -> F.Field T.SqlTimestamptz -> F.Field T.SqlTimestamptz+dateTruncTimestamptz p (Column e) = Column $ HPQ.FunExpr "date_trunc" [(precisionToExpr p), e]

@@ -2,11 +2,13 @@  module Opaleye.With   ( with,+    withMaterialized,     withRecursive,     withRecursiveDistinct,      -- * Explicit versions     withExplicit,+    withMaterializedExplicit,     withRecursiveExplicit,     withRecursiveDistinctExplicit,   )@@ -30,6 +32,9 @@ with :: Default Unpackspec a a => Select a -> (Select a -> Select b) -> Select b with = withExplicit def +withMaterialized :: Default Unpackspec a a => Select a -> (Select a -> Select b) -> Select b+withMaterialized = withMaterializedExplicit def+ -- | Denotionally, @withRecursive s f@ is the smallest set of rows @r@ such -- that --@@ -65,16 +70,22 @@  withExplicit :: Unpackspec a a -> Select a -> (Select a -> Select b) -> Select b withExplicit unpackspec rhsSelect bodySelect = productQueryArr $ do-  withG unpackspec PQ.NonRecursive (\_ -> rebind rhsSelect) bodySelect+  withG unpackspec PQ.NonRecursive Nothing (\_ -> rebind rhsSelect) bodySelect   where     rebind = (>>> rebindExplicitPrefixNoStar "rebind" unpackspec) +withMaterializedExplicit :: Unpackspec a a -> Select a -> (Select a -> Select b) -> Select b+withMaterializedExplicit unpackspec rhsSelect bodySelect = productQueryArr $ do+  withG unpackspec PQ.NonRecursive (Just PQ.Materialized) (\_ -> rebind rhsSelect) bodySelect+  where+    rebind = (>>> rebindExplicitPrefixNoStar "rebind" unpackspec)+ withRecursiveExplicit :: Binaryspec a a -> Select a -> (a -> Select a) -> Select a withRecursiveExplicit binaryspec base recursive = productQueryArr $ do   let bodySelect selectCte = selectCte   let rhsSelect selectCte = unionAllExplicit binaryspec base (selectCte >>= recursive) -  withG unpackspec PQ.Recursive rhsSelect bodySelect+  withG unpackspec PQ.Recursive Nothing rhsSelect bodySelect   where     unpackspec = binaryspecToUnpackspec binaryspec @@ -83,17 +94,18 @@   let bodySelect selectCte = selectCte   let rhsSelect selectCte = unionExplicit binaryspec base (selectCte >>= recursive) -  withG unpackspec PQ.Recursive rhsSelect bodySelect+  withG unpackspec PQ.Recursive Nothing rhsSelect bodySelect   where     unpackspec = binaryspecToUnpackspec binaryspec  withG ::   Unpackspec a a ->   PQ.Recursive ->+  Maybe PQ.Materialized ->   (Select a -> Select a) ->   (Select a -> Select b) ->   State Tag.Tag (b, PQ.PrimQuery)-withG unpackspec recursive rhsSelect bodySelect = do+withG unpackspec recursive materialized rhsSelect bodySelect = do   (selectCte, withCte) <- freshCte unpackspec    let rhsSelect' = rhsSelect selectCte@@ -102,14 +114,14 @@   (_, rhsQ) <- runSimpleSelect rhsSelect'   bodyQ <- runSimpleSelect bodySelect' -  pure (withCte recursive rhsQ bodyQ)+  pure (withCte recursive materialized rhsQ bodyQ)  freshCte ::   Unpackspec a a ->   State     Tag.Tag     ( Select a,-      PQ.Recursive -> PQ.PrimQuery -> (b, PQ.PrimQuery) -> (b, PQ.PrimQuery)+      PQ.Recursive -> Maybe PQ.Materialized -> PQ.PrimQuery -> (b, PQ.PrimQuery) -> (b, PQ.PrimQuery)     ) freshCte unpackspec = do   cteName <- HPQ.Symbol "cte" <$> Tag.fresh@@ -131,8 +143,8 @@    pure     ( selectCte,-      \recursive withQ (withedCols, withedQ) ->-        (withedCols, PQ.With recursive cteName (map fst cteBindings) withQ withedQ)+      \recursive materialized withQ (withedCols, withedQ) ->+        (withedCols, PQ.With recursive materialized cteName (map fst cteBindings) withQ withedQ)     )  binaryspecToUnpackspec :: Binaryspec a a -> Unpackspec a a