diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/Doc/Tutorial/TutorialBasic.lhs b/Doc/Tutorial/TutorialBasic.lhs --- a/Doc/Tutorial/TutorialBasic.lhs +++ b/Doc/Tutorial/TutorialBasic.lhs @@ -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 diff --git a/Doc/Tutorial/TutorialBasicMonomorphic.lhs b/Doc/Tutorial/TutorialBasicMonomorphic.lhs --- a/Doc/Tutorial/TutorialBasicMonomorphic.lhs +++ b/Doc/Tutorial/TutorialBasicMonomorphic.lhs @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/Test/Opaleye/Test/Arbitrary.hs b/Test/Opaleye/Test/Arbitrary.hs --- a/Test/Opaleye/Test/Arbitrary.hs +++ b/Test/Opaleye/Test/Arbitrary.hs @@ -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) diff --git a/Test/Opaleye/Test/Fields.hs b/Test/Opaleye/Test/Fields.hs --- a/Test/Opaleye/Test/Fields.hs +++ b/Test/Opaleye/Test/Fields.hs @@ -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 diff --git a/Test/QuickCheck.hs b/Test/QuickCheck.hs --- a/Test/QuickCheck.hs +++ b/Test/QuickCheck.hs @@ -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) diff --git a/Test/Test.hs b/Test/Test.hs --- a/Test/Test.hs +++ b/Test/Test.hs @@ -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 diff --git a/opaleye.cabal b/opaleye.cabal --- a/opaleye.cabal +++ b/opaleye.cabal @@ -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 diff --git a/src/Opaleye/Aggregate.hs b/src/Opaleye/Aggregate.hs --- a/src/Opaleye/Aggregate.hs +++ b/src/Opaleye/Aggregate.hs @@ -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 diff --git a/src/Opaleye/Field.hs b/src/Opaleye/Field.hs --- a/src/Opaleye/Field.hs +++ b/src/Opaleye/Field.hs @@ -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 diff --git a/src/Opaleye/FunctionalJoin.hs b/src/Opaleye/FunctionalJoin.hs --- a/src/Opaleye/FunctionalJoin.hs +++ b/src/Opaleye/FunctionalJoin.hs @@ -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 diff --git a/src/Opaleye/Internal/Aggregate.hs b/src/Opaleye/Internal/Aggregate.hs --- a/src/Opaleye/Internal/Aggregate.hs +++ b/src/Opaleye/Internal/Aggregate.hs @@ -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 diff --git a/src/Opaleye/Internal/Binary.hs b/src/Opaleye/Internal/Binary.hs --- a/src/Opaleye/Internal/Binary.hs +++ b/src/Opaleye/Internal/Binary.hs @@ -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) diff --git a/src/Opaleye/Internal/Constant.hs b/src/Opaleye/Internal/Constant.hs --- a/src/Opaleye/Internal/Constant.hs +++ b/src/Opaleye/Internal/Constant.hs @@ -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 ) diff --git a/src/Opaleye/Internal/Distinct.hs b/src/Opaleye/Internal/Distinct.hs --- a/src/Opaleye/Internal/Distinct.hs +++ b/src/Opaleye/Internal/Distinct.hs @@ -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) diff --git a/src/Opaleye/Internal/HaskellDB/PrimQuery.hs b/src/Opaleye/Internal/HaskellDB/PrimQuery.hs --- a/src/Opaleye/Internal/HaskellDB/PrimQuery.hs +++ b/src/Opaleye/Internal/HaskellDB/PrimQuery.hs @@ -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 diff --git a/src/Opaleye/Internal/HaskellDB/Sql.hs b/src/Opaleye/Internal/HaskellDB/Sql.hs --- a/src/Opaleye/Internal/HaskellDB/Sql.hs +++ b/src/Opaleye/Internal/HaskellDB/Sql.hs @@ -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 diff --git a/src/Opaleye/Internal/HaskellDB/Sql/Default.hs b/src/Opaleye/Internal/HaskellDB/Sql/Default.hs --- a/src/Opaleye/Internal/HaskellDB/Sql/Default.hs +++ b/src/Opaleye/Internal/HaskellDB/Sql/Default.hs @@ -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]) diff --git a/src/Opaleye/Internal/HaskellDB/Sql/Print.hs b/src/Opaleye/Internal/HaskellDB/Sql/Print.hs --- a/src/Opaleye/Internal/HaskellDB/Sql/Print.hs +++ b/src/Opaleye/Internal/HaskellDB/Sql/Print.hs @@ -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" diff --git a/src/Opaleye/Internal/JSONBuildObjectFields.hs b/src/Opaleye/Internal/JSONBuildObjectFields.hs --- a/src/Opaleye/Internal/JSONBuildObjectFields.hs +++ b/src/Opaleye/Internal/JSONBuildObjectFields.hs @@ -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 diff --git a/src/Opaleye/Internal/MaybeFields.hs b/src/Opaleye/Internal/MaybeFields.hs --- a/src/Opaleye/Internal/MaybeFields.hs +++ b/src/Opaleye/Internal/MaybeFields.hs @@ -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 diff --git a/src/Opaleye/Internal/Optimize.hs b/src/Opaleye/Internal/Optimize.hs --- a/src/Opaleye/Internal/Optimize.hs +++ b/src/Opaleye/Internal/Optimize.hs @@ -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 diff --git a/src/Opaleye/Internal/PackMap.hs b/src/Opaleye/Internal/PackMap.hs --- a/src/Opaleye/Internal/PackMap.hs +++ b/src/Opaleye/Internal/PackMap.hs @@ -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) diff --git a/src/Opaleye/Internal/PrimQuery.hs b/src/Opaleye/Internal/PrimQuery.hs --- a/src/Opaleye/Internal/PrimQuery.hs +++ b/src/Opaleye/Internal/PrimQuery.hs @@ -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' diff --git a/src/Opaleye/Internal/Print.hs b/src/Opaleye/Internal/Print.hs --- a/src/Opaleye/Internal/Print.hs +++ b/src/Opaleye/Internal/Print.hs @@ -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 diff --git a/src/Opaleye/Internal/QueryArr.hs b/src/Opaleye/Internal/QueryArr.hs --- a/src/Opaleye/Internal/QueryArr.hs +++ b/src/Opaleye/Internal/QueryArr.hs @@ -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@. diff --git a/src/Opaleye/Internal/RunQuery.hs b/src/Opaleye/Internal/RunQuery.hs --- a/src/Opaleye/Internal/RunQuery.hs +++ b/src/Opaleye/Internal/RunQuery.hs @@ -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) diff --git a/src/Opaleye/Internal/RunQueryExternal.hs b/src/Opaleye/Internal/RunQueryExternal.hs --- a/src/Opaleye/Internal/RunQueryExternal.hs +++ b/src/Opaleye/Internal/RunQueryExternal.hs @@ -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 diff --git a/src/Opaleye/Internal/Sql.hs b/src/Opaleye/Internal/Sql.hs --- a/src/Opaleye/Internal/Sql.hs +++ b/src/Opaleye/Internal/Sql.hs @@ -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 AS - wCols :: [HSql.SqlColumn], - wRecursive :: Recursive, - wWith :: Select, - wSelect :: Select + wTable :: HSql.SqlTable, -- The name of the result, i.e. WITH 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 diff --git a/src/Opaleye/Internal/Table.hs b/src/Opaleye/Internal/Table.hs --- a/src/Opaleye/Internal/Table.hs +++ b/src/Opaleye/Internal/Table.hs @@ -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\", diff --git a/src/Opaleye/Internal/Unpackspec.hs b/src/Opaleye/Internal/Unpackspec.hs --- a/src/Opaleye/Internal/Unpackspec.hs +++ b/src/Opaleye/Internal/Unpackspec.hs @@ -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 diff --git a/src/Opaleye/Internal/Values.hs b/src/Opaleye/Internal/Values.hs --- a/src/Opaleye/Internal/Values.hs +++ b/src/Opaleye/Internal/Values.hs @@ -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 diff --git a/src/Opaleye/Internal/Window.hs b/src/Opaleye/Internal/Window.hs --- a/src/Opaleye/Internal/Window.hs +++ b/src/Opaleye/Internal/Window.hs @@ -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, diff --git a/src/Opaleye/MaybeFields.hs b/src/Opaleye/MaybeFields.hs --- a/src/Opaleye/MaybeFields.hs +++ b/src/Opaleye/MaybeFields.hs @@ -19,6 +19,7 @@ fromMaybeFields, maybeFields, maybeFieldsToNullable, + isJustAnd, -- * Creating a 'Select' which returns 'MaybeFields' Opaleye.Join.optional, Opaleye.MaybeFields.traverseMaybeFields, diff --git a/src/Opaleye/Operators.hs b/src/Opaleye/Operators.hs --- a/src/Opaleye/Operators.hs +++ b/src/Opaleye/Operators.hs @@ -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] diff --git a/src/Opaleye/With.hs b/src/Opaleye/With.hs --- a/src/Opaleye/With.hs +++ b/src/Opaleye/With.hs @@ -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