esqueleto 3.3.4.1 → 3.4.0.0

raw patch · 8 files changed

+950/−231 lines, 8 filesdep ~attoparsecPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: attoparsec

API changes (from Hackage documentation)

Files

• changelog.md +12/−1
• esqueleto.cabal +4/−4
• src/Database/Esqueleto.hs +0/−63
• src/Database/Esqueleto/Experimental.hs +642/−136
• src/Database/Esqueleto/Internal/Internal.hs +133/−15
• src/Database/Esqueleto/Internal/Sql.hs +4/−0
• test/Common/Test.hs +11/−12
• test/PostgreSQL/Test.hs +144/−0

@@ -1,8 +1,19 @@-3.3.4.1+3.4.0.0+=======+- @belevy, @charukiewicz+  - [#215](https://github.com/bitemyapp/esqueleto/pull/215)+    - Added support for common table expressions (`with`, `withRecursive`)+    - Added support for lateral JOINs with updated example (Example #6)+    - Deprecated `SelectQuery`, removing the neccessity to tag `SqlQuery` values+    - Deprecated use of data constructors for SQL set operations (replaced with functions)+    - Refactored module structure to fix haddock build (fixes build from `3.3.4.0`) +3.3.4.1+======= - @maxgabriel   - [#214](https://github.com/bitemyapp/esqueleto/pull/214)     - Add suggested hlint rules for proper `isNothing` usage+  3.3.4.0 =======

@@ -1,7 +1,7 @@ cabal-version: 1.12  name:           esqueleto-version:        3.3.4.1+version:        3.4.0.0 synopsis:       Type-safe EDSL for SQL queries on persistent backends. description:    @esqueleto@ is a bare bones, type-safe EDSL for SQL queries that works with unmodified @persistent@ SQL backends.  Its language closely resembles SQL, so you don't have to learn new concepts, just new syntax, and it's fairly easy to predict the generated SQL and optimize it for your backend. Most kinds of errors committed when writing SQL are caught as compile-time errors---although it is possible to write type-checked @esqueleto@ queries that fail at runtime.                 .@@ -96,7 +96,7 @@     , resourcet >=1.2     , tagged >=0.2     , text >=0.11 && <1.3-    , time +    , time     , transformers >=0.2     , unliftio     , unordered-containers >=0.2@@ -133,7 +133,7 @@     , resourcet >=1.2     , tagged >=0.2     , text >=0.11 && <1.3-    , time +    , time     , transformers >=0.2     , unliftio     , unordered-containers >=0.2@@ -167,7 +167,7 @@     , resourcet >=1.2     , tagged >=0.2     , text >=0.11 && <1.3-    , time +    , time     , transformers >=0.2     , unliftio     , unordered-containers >=0.2

@@ -410,66 +410,3 @@ -- -- In order to use these functions, you need to explicitly import -- their corresponding modules, they're not re-exported here.------------------------------------------------------------------------------ | @valkey i = 'val' . 'toSqlKey'@--- (<https://github.com/prowdsponsor/esqueleto/issues/9>).-valkey :: (ToBackendKey SqlBackend entity, PersistField (Key entity)) =>-          Int64 -> SqlExpr (Value (Key entity))-valkey = val . toSqlKey----- | @valJ@ is like @val@ but for something that is already a @Value@. The use--- case it was written for was, given a @Value@ lift the @Key@ for that @Value@--- into the query expression in a type safe way. However, the implementation is--- more generic than that so we call it @valJ@.------ Its important to note that the input entity and the output entity are--- constrained to be the same by the type signature on the function--- (<https://github.com/prowdsponsor/esqueleto/pull/69>).------ /Since: 1.4.2/-valJ :: (PersistField (Key entity)) =>-        Value (Key entity) -> SqlExpr (Value (Key entity))-valJ = val . unValue------------------------------------------------------------------------------ | Synonym for 'Database.Persist.Store.delete' that does not--- clash with @esqueleto@'s 'delete'.-deleteKey :: ( PersistStore backend-             , BaseBackend backend ~ PersistEntityBackend val-             , MonadIO m-             , PersistEntity val )-          => Key val -> ReaderT backend m ()-deleteKey = Database.Persist.delete---- | Avoid N+1 queries and join entities into a map structure--- @--- getFoosAndNestedBarsFromParent :: ParentId -> (Map (Key Foo) (Foo, [Maybe (Entity Bar)]))--- getFoosAndNestedBarsFromParent parentId = 'fmap' associateJoin $ 'select' $--- 'from' $ \\(foo `'LeftOuterJoin`` bar) -> do---   'on' (bar '?.' BarFooId '==.' foo '^.' FooId)---   'where_' (foo '^.' FooParentId '==.' 'val' parentId)---   'pure' (foo, bar)--- @------ @since 3.1.2-associateJoin-  :: forall e1 e0-   . Ord (Key e0)-  => [(Entity e0, e1)]-  -> Map.Map (Key e0) (e0, [e1])-associateJoin = foldr f start-  where-    start = Map.empty-    f (one, many) =-      Map.insertWith-        (\(oneOld, manyOld) (_, manyNew) -> (oneOld, manyNew ++ manyOld ))-        (entityKey one)-        (entityVal one, [many])

@@ -30,12 +30,27 @@        -- * Documentation -      SqlSetOperation(Union, UnionAll, Except, Intersect)-    , pattern SelectQuery-    , From(..)+      From(..)     , on     , from     , (:&)(..)++      -- ** Set Operations+      -- $sql-set-operations+    , union_+    , Union(..)+    , unionAll_+    , UnionAll(..)+    , except_+    , Except(..)+    , intersect_+    , Intersect(..)+    , pattern SelectQuery++      -- ** Common Table Expressions+    , with+    , withRecursive+       -- * Internals     , ToFrom(..)     , ToFromT@@ -46,11 +61,82 @@     , ToAliasReference(..)     , ToAliasReferenceT     -- * The Normal Stuff-    , module Database.Esqueleto-    )+    , where_, groupBy, orderBy, rand, asc, desc, limit, offset+             , distinct, distinctOn, don, distinctOnOrderBy, having, locking+             , sub_select, (^.), (?.)+             , val, isNothing, just, nothing, joinV, withNonNull+             , countRows, count, countDistinct+             , not_, (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)+             , between, (+.), (-.), (/.), (*.)+             , random_, round_, ceiling_, floor_+             , min_, max_, sum_, avg_, castNum, castNumM+             , coalesce, coalesceDefault+             , lower_, upper_, trim_, ltrim_, rtrim_, length_, left_, right_+             , like, ilike, (%), concat_, (++.), castString+             , subList_select, valList, justList+             , in_, notIn, exists, notExists+             , set, (=.), (+=.), (-=.), (*=.), (/=.)+             , case_, toBaseId+  , subSelect+  , subSelectMaybe+  , subSelectCount+  , subSelectForeign+  , subSelectList+  , subSelectUnsafe+  , ToBaseId(..)+  , when_+  , then_+  , else_+  , Value(..)+  , ValueList(..)+  , OrderBy+  , DistinctOn+  , LockingKind(..)+  , SqlString+    -- ** Joins+  , InnerJoin(..)+  , CrossJoin(..)+  , LeftOuterJoin(..)+  , RightOuterJoin(..)+  , FullOuterJoin(..)+  , JoinKind(..)+  , OnClauseWithoutMatchingJoinException(..)+    -- * SQL backend+  , SqlQuery+  , SqlExpr+  , SqlEntity+  , select+  , selectSource+  , delete+  , deleteCount+  , update+  , updateCount+  , insertSelect+  , insertSelectCount+  , (<#)+  , (<&>)+  -- ** Rendering Queries+  , renderQueryToText+  , renderQuerySelect+  , renderQueryUpdate+  , renderQueryDelete+  , renderQueryInsertInto+    -- * Internal.Language+    -- * RDBMS-specific modules+    -- $rdbmsSpecificModules++    -- * Helpers+  , valkey+  , valJ+  , associateJoin++    -- * Re-exports+    -- $reexports+  , deleteKey+  , module Database.Esqueleto.Internal.PersistentImport+  )     where -import Database.Esqueleto hiding (from, on, From(..)) import qualified Control.Monad.Trans.Writer as W import qualified Control.Monad.Trans.State as S import Control.Monad.Trans.Class (lift)@@ -58,32 +144,12 @@ import Data.Semigroup #endif import Data.Proxy (Proxy(..))+import qualified Data.Text.Lazy.Builder as TLB import Database.Esqueleto.Internal.PersistentImport-import Database.Esqueleto.Internal.Internal-          ( SqlExpr(..)-          , InnerJoin(..)-          , CrossJoin(..)-          , LeftOuterJoin(..)-          , RightOuterJoin(..)-          , FullOuterJoin(..)-          , FromClause(..)-          , SqlQuery(..)-          , SideData(..)-          , Value(..)-          , JoinKind(..)-          , newIdentFor-          , SqlSelect(..)-          , Mode(..)-          , toRawSql-          , Ident(..)-          , to3, to4, to5, to6, to7, to8-          , from3, from4, from5, from6, from7, from8-          , veryUnsafeCoerceSqlExprValue-          , parensM-          , NeedParens(..)-          )+import Database.Esqueleto.Internal.Internal hiding (from, on, From) import GHC.TypeLits + -- $setup -- -- If you're already using "Database.Esqueleto", then you can get@@ -95,9 +161,11 @@ -- -- ... ----- import Database.Esqueleto hiding (on, from) -- import Database.Esqueleto.Experimental -- @+--+-- Note: Prior to @esqueleto-3.3.4.0@, the @Database.Esqueleto.Experimental@+-- module did not reexport @Data.Esqueleto@.  ---------------------------------------------------------------------- @@ -272,7 +340,7 @@ -- @ -- select $ do -- peopleWithPosts <----   from $ SelectQuery $ do+--   from $ do --     (people :& blogPosts) <- --       from $ Table \@Person --       \`InnerJoin\` Table \@BlogPost@@ -303,7 +371,7 @@ -- @ -- select $ do -- (authors, blogPosts) <- from $---   (SelectQuery $ do+--   (do --     (author :& blogPost) <- --       from $ Table \@Person --       \`InnerJoin\` Table \@BlogPost@@ -312,8 +380,8 @@ --     where_ (author ^. PersonId ==. val currentPersonId) --     pure (author, blogPost) --   )---   \`Union\`---   (SelectQuery $ do+--   \`union_\`+--   (do --     (follow :& blogPost :& author) <- --       from $ Table \@Follow --       \`InnerJoin\` Table \@BlogPost@@ -329,6 +397,56 @@ -- limit 25 -- pure (authors, blogPosts) -- @+--+-- === Example 6: LATERAL JOIN+--+-- As of version @3.4.0.0@, lateral subquery joins are supported.+--+--+-- @+-- select $ do+-- (salesPerson :& maxSaleAmount :& maxSaleCustomerName) <-+--   from $ Table \@SalesPerson+--   \`CrossJoin\` (\\salesPerson -> do+--         sales <- from $ Table \@Sale+--         where_ $ sales ^. SaleSalesPersonId ==. salesPerson ^. SalesPersonId+--         pure $ max_ (sales ^. SaleAmount)+--         )+--   \`CrossJoin\` (\\(salesPerson :& maxSaleAmount) -> do+--         sales <- from $ Table \@Sale+--         where_ $ sales ^. SaleSalesPersonId ==. salesPerson ^. SalesPersonId+--              &&. sales ^. SaleAmount ==. maxSaleAmount+--         pure $ sales ^. SaleCustomerName)+--         )+-- pure (salesPerson ^. SalesPersonName, maxSaleAmount, maxSaleCustomerName)+-- @+--+-- This is the equivalent to the following SQL (example taken from the+-- [MySQL Lateral Derived Table](https://dev.mysql.com/doc/refman/8.0/en/lateral-derived-tables.html)+-- documentation):+--+-- @+-- SELECT+--   salesperson.name,+--   max_sale.amount,+--   max_sale_customer.customer_name+-- FROM+--   salesperson,+--   -- calculate maximum size, cache it in transient derived table max_sale+--   LATERAL+--   (SELECT MAX(amount) AS amount+--     FROM all_sales+--     WHERE all_sales.salesperson_id = salesperson.id)+--   AS max_sale,+--   LATERAL+--   (SELECT customer_name+--     FROM all_sales+--     WHERE all_sales.salesperson_id = salesperson.id+--     AND all_sales.amount =+--         -- the cached maximum size+--         max_sale.amount)+--   AS max_sale_customer;+-- @  -- | A left-precedence pair. Pronounced \"and\". Used to represent expressions -- that have been joined together.@@ -344,59 +462,110 @@ data (:&) a b = a :& b infixl 2 :& --- | Data type that represents SQL set operations. This includes--- 'UNION', 'UNION' 'ALL', 'EXCEPT', and 'INTERSECT'. This data--- type is defined as a binary tree, with @SelectQuery@ on the leaves.+data SqlSetOperation a =+    SqlSetUnion (SqlSetOperation a) (SqlSetOperation a)+  | SqlSetUnionAll (SqlSetOperation a) (SqlSetOperation a)+  | SqlSetExcept (SqlSetOperation a) (SqlSetOperation a)+  | SqlSetIntersect (SqlSetOperation a) (SqlSetOperation a)+  | SelectQueryP NeedParens (SqlQuery a)+++-- $sql-set-operations ----- Each constructor corresponding to the aforementioned set operations--- can be used as an infix function in a @from@ to help with readability+-- Data type that represents SQL set operations. This includes+-- 'UNION', 'UNION' 'ALL', 'EXCEPT', and 'INTERSECT'. These types form+-- a binary tree, with @SqlQuery@ values on the leaves.+--+-- Each function corresponding to the aforementioned set operations+-- can be used as an infix in a @from@ to help with readability -- and lead to code that closely resembles the underlying SQL. For example, -- -- @ -- select $ from $---   (SelectQuery ...)---   \`Union\`---   (SelectQuery ...)+--   (do+--      a <- from Table @A+--      pure $ a ^. ASomeCol+--   )+--   \`union_\`+--   (do+--      b <- from Table @B+--      pure $ b ^. BSomeCol+--   ) -- @ -- -- is translated into -- -- @ -- SELECT * FROM (---   (SELECT * FROM ...)+--   (SELECT a.some_col FROM a) --   UNION---   (SELECT * FROM ...)+--   (SELECT b.some_col FROM b) -- ) -- @ ----- @SelectQuery@ can be used without any of the set operations to construct--- a subquery. This can be used in 'JOIN' trees. For example,------ @--- select $ from $---   Table \@SomeTable---   \`InnerJoin\` (SelectQuery ...)---   \`on\` ...--- @------ is translated into------ @--- SELECT *--- FROM SomeTable--- INNER JOIN (SELECT * FROM ...)--- ON ...--- @-data SqlSetOperation a =-    Union (SqlSetOperation a) (SqlSetOperation a)-  | UnionAll (SqlSetOperation a) (SqlSetOperation a)-  | Except (SqlSetOperation a) (SqlSetOperation a)-  | Intersect (SqlSetOperation a) (SqlSetOperation a)-  | SelectQueryP NeedParens (SqlQuery a) +{-# DEPRECATED Union "/Since: 3.4.0.0/ - \+    Use the 'union_' function instead of the 'Union' data constructor" #-}+data Union a b = a `Union` b++-- | @UNION@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.+union_ :: a -> b -> Union a b+union_ = Union++{-# DEPRECATED UnionAll "/Since: 3.4.0.0/ - \+    Use the 'unionAll_' function instead of the 'UnionAll' data constructor" #-}+data UnionAll a b = a `UnionAll` b++-- | @UNION@ @ALL@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.+unionAll_ :: a -> b -> UnionAll a b+unionAll_ = UnionAll++{-# DEPRECATED Except "/Since: 3.4.0.0/ - \+    Use the 'except_' function instead of the 'Except' data constructor" #-}+data Except a b = a `Except` b++-- | @EXCEPT@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.+except_ :: a -> b -> Except a b+except_ = Except++{-# DEPRECATED Intersect "/Since: 3.4.0.0/ - \+    Use the 'intersect_' function instead of the 'Intersect' data constructor" #-}+data Intersect a b = a `Intersect` b++-- | @INTERSECT@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.+intersect_ :: a -> b -> Intersect a b+intersect_ = Intersect++class SetOperationT a ~ b => ToSetOperation a b | a -> b where+  toSetOperation :: a -> SqlSetOperation b++instance ToSetOperation (SqlSetOperation a) a where+  toSetOperation = id+instance ToSetOperation (SqlQuery a) a where+  toSetOperation = SelectQueryP Never+instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (Union a b) c where+  toSetOperation (Union a b) = SqlSetUnion (toSetOperation a) (toSetOperation b)+instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (UnionAll a b) c where+  toSetOperation (UnionAll a b) = SqlSetUnionAll (toSetOperation a) (toSetOperation b)+instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (Except a b) c where+  toSetOperation (Except a b) = SqlSetExcept (toSetOperation a) (toSetOperation b)+instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (Intersect a b) c where+  toSetOperation (Intersect a b) = SqlSetIntersect (toSetOperation a) (toSetOperation b)++type family SetOperationT a where+  SetOperationT (Union a b) = SetOperationT a+  SetOperationT (UnionAll a b) = SetOperationT a+  SetOperationT (Except a b) = SetOperationT a+  SetOperationT (Intersect a b) = SetOperationT a+  SetOperationT (SqlQuery a) = a+  SetOperationT (SqlSetOperation a) = a++{-# DEPRECATED SelectQuery "/Since: 3.4.0.0/ - \+    It is no longer necessary to tag 'SqlQuery' values with @SelectQuery@" #-} pattern SelectQuery :: SqlQuery a -> SqlSetOperation a pattern SelectQuery q = SelectQueryP Never q + -- | Data type that represents the syntax of a 'JOIN' tree. In practice, -- only the @Table@ constructor is used directly when writing queries. For example, --@@ -404,32 +573,102 @@ -- select $ from $ Table \@People -- @ data From a where-  Table         :: PersistEntity ent => From (SqlExpr (Entity ent))-  SubQuery      :: (SqlSelect a' r, SqlSelect a'' r', ToAlias a, a' ~ ToAliasT a, ToAliasReference a', ToAliasReferenceT a' ~ a'')-                => SqlQuery a-                -> From a''-  SqlSetOperation :: (SqlSelect a' r, ToAlias a, a' ~ ToAliasT a, ToAliasReference a', ToAliasReferenceT a' ~ a'')-                  => SqlSetOperation a-                  -> From a''-  InnerJoinFrom :: From a-                -> (From b, (a :& b) -> SqlExpr (Value Bool))-                -> From (a :& b)-  CrossJoinFrom :: From a-                -> From b-                -> From (a :& b)-  LeftJoinFrom  :: ToMaybe b-                => From a-                -> (From b, (a :& ToMaybeT b) -> SqlExpr (Value Bool))-                -> From (a :& ToMaybeT b)-  RightJoinFrom :: ToMaybe a-                => From a-                -> (From b, (ToMaybeT a :& b) -> SqlExpr (Value Bool))-                -> From (ToMaybeT a :& b)-  FullJoinFrom  :: (ToMaybe a, ToMaybe b )-                => From a-                -> (From b, (ToMaybeT a :& ToMaybeT b) -> SqlExpr (Value Bool))-                -> From (ToMaybeT a :& ToMaybeT b)+  Table+    :: PersistEntity ent+    => From (SqlExpr (Entity ent))+  SubQuery+    :: ( SqlSelect a' r+       , SqlSelect a'' r'+       , ToAlias a+       , a' ~ ToAliasT a+       , ToAliasReference a'+       , ToAliasReferenceT a' ~ a''+       )+    => SqlQuery a+    -> From a''+  FromCte+    :: Ident+    -> a+    -> From a+  SqlSetOperation+    :: ( SqlSelect a' r+       , ToAlias a+       , a' ~ ToAliasT a+       , ToAliasReference a'+       , ToAliasReferenceT a' ~ a''+       )+    => SqlSetOperation a+    -> From a''+  InnerJoinFrom+    :: From a+    -> (From b, (a :& b) -> SqlExpr (Value Bool))+    -> From (a :& b)+  InnerJoinFromLateral+    :: ( SqlSelect b' r+       , SqlSelect b'' r'+       , ToAlias b+       , b' ~ ToAliasT b+       , ToAliasReference b'+       , ToAliasReferenceT b' ~ b''+       )+    => From a+    -> ((a -> SqlQuery b), (a :& b'') -> SqlExpr (Value Bool))+    -> From (a :& b'')+  CrossJoinFrom+    :: From a+    -> From b+    -> From (a :& b)+  CrossJoinFromLateral+    :: ( SqlSelect b' r+       , SqlSelect b'' r'+       , ToAlias b+       , b' ~ ToAliasT b+       , ToAliasReference b'+       , ToAliasReferenceT b' ~ b''+       )+    => From a+    -> (a -> SqlQuery b)+    -> From (a :& b'')+  LeftJoinFrom+    :: ToMaybe b+    => From a+    -> (From b, (a :& ToMaybeT b) -> SqlExpr (Value Bool))+    -> From (a :& ToMaybeT b)+  LeftJoinFromLateral+    :: ( SqlSelect b' r+       , SqlSelect b'' r'+       , ToAlias b+       , b' ~ ToAliasT b+       , ToAliasReference b'+       , ToAliasReferenceT b' ~ b''+       , ToMaybe b''+       )+    => From a+    -> ((a -> SqlQuery b), (a :& ToMaybeT b'') -> SqlExpr (Value Bool))+    -> From (a :& ToMaybeT b'')+  RightJoinFrom+    :: ToMaybe a+    => From a+    -> (From b, (ToMaybeT a :& b) -> SqlExpr (Value Bool))+    -> From (ToMaybeT a :& b)+  FullJoinFrom+    :: (ToMaybe a, ToMaybe b )+    => From a+    -> (From b, (ToMaybeT a :& ToMaybeT b) -> SqlExpr (Value Bool))+    -> From (ToMaybeT a :& ToMaybeT b) +-- | Constraint for `on`. Ensures that only types that require an `on` can be used on+-- the left hand side. This was previously reusing the ToFrom class which was actually+-- a bit too lenient as it allowed to much. Expanding this class should not be needed.+--+-- @since 3.4.0.0+class ValidOnClauseValue a where+instance ValidOnClauseValue (From a) where+instance ValidOnClauseValue (SqlQuery a) where+instance ValidOnClauseValue (SqlSetOperation a) where+instance ValidOnClauseValue (a -> SqlQuery b) where+instance {-# OVERLAPPABLE #-} (TypeError ('Text "Illegal use of ON")) => ValidOnClauseValue a where+ -- | An @ON@ clause that describes how two tables are related. This should be -- used as an infix operator after a 'JOIN'. For example, --@@ -440,8 +679,7 @@ -- \`on\` (\\(p :& bP) -> --         p ^. PersonId ==. bP ^. BlogPostAuthorId) -- @----on :: ToFrom a => a -> (b -> SqlExpr (Value Bool)) -> (a, b -> SqlExpr (Value Bool))+on :: ValidOnClauseValue a => a -> (b -> SqlExpr (Value Bool)) -> (a, b -> SqlExpr (Value Bool)) on = (,) infix 9 `on` @@ -449,17 +687,34 @@  type family ToFromT a where   ToFromT (From a) = a+  ToFromT (SqlQuery a) = ToAliasReferenceT (ToAliasT a)+  ToFromT (Union a b) = ToAliasReferenceT (ToAliasT (SetOperationT a))+  ToFromT (UnionAll a b) = ToAliasReferenceT (ToAliasT (SetOperationT a))+  ToFromT (Except a b) = ToAliasReferenceT (ToAliasT (SetOperationT a))+  ToFromT (Intersect a b) = ToAliasReferenceT (ToAliasT (SetOperationT a))   ToFromT (SqlSetOperation a) = ToAliasReferenceT (ToAliasT a)+  ToFromT (InnerJoin a (b, c -> SqlExpr (Value Bool))) = c   ToFromT (LeftOuterJoin a (b, c -> SqlExpr (Value Bool))) = c-  ToFromT (FullOuterJoin a (b, c -> SqlExpr (Value Bool))) = c   ToFromT (RightOuterJoin a (b, c -> SqlExpr (Value Bool))) = c-  ToFromT (InnerJoin a (b, c -> SqlExpr (Value Bool))) = c-  ToFromT (CrossJoin a b) = (ToFromT a :& ToFromT b)+  ToFromT (FullOuterJoin a (b, c -> SqlExpr (Value Bool))) = c+  ToFromT (CrossJoin a (c -> SqlQuery b)) = ToFromT a :& ToAliasReferenceT (ToAliasT b)+  ToFromT (CrossJoin a b) = ToFromT a :& ToFromT b   ToFromT (InnerJoin a b) = TypeError (JoinErrorMsg "InnerJoin")   ToFromT (LeftOuterJoin a b) = TypeError (JoinErrorMsg "LeftOuterJoin")   ToFromT (RightOuterJoin a b) = TypeError (JoinErrorMsg "RightOuterJoin")   ToFromT (FullOuterJoin a b) = TypeError (JoinErrorMsg "FullOuterJoin") +data Lateral+data NotLateral++type family IsLateral a where+  IsLateral (a -> SqlQuery b) = Lateral+  IsLateral a = NotLateral++class ErrorOnLateral a where+instance (TypeError ('Text "LATERAL can only be used for INNER, LEFT, and CROSS join kinds.")) => ErrorOnLateral (a -> SqlQuery b) where+instance {-# OVERLAPPABLE #-} ErrorOnLateral a where+ {-- Type class magic to allow the use of the `InnerJoin` family of data constructors in from --} class ToFrom a where   toFrom :: a -> From (ToFromT a)@@ -476,30 +731,147 @@ instance {-# OVERLAPPABLE #-} ToFrom (FullOuterJoin a b) where   toFrom = undefined +instance ( ToAlias a+         , a' ~ ToAliasT a+         , ToAliasReference a'+         , a'' ~ ToAliasReferenceT a'+         , SqlSelect a' r'+         , SqlSelect a'' r'+         ) => ToFrom (SqlQuery a) where+  toFrom = SubQuery++instance ( SqlSelect c' r+         , SqlSelect c'' r'+         , ToAlias c+         , c' ~ ToAliasT c+         , ToAliasReference c'+         , ToAliasReferenceT c' ~ c''+         , ToSetOperation a c+         , ToSetOperation b c+         , c ~ SetOperationT a+         )  => ToFrom (Union a b) where+  toFrom u = SqlSetOperation $ toSetOperation u++instance ( SqlSelect c' r+         , SqlSelect c'' r'+         , ToAlias c+         , c' ~ ToAliasT c+         , ToAliasReference c'+         , ToAliasReferenceT c' ~ c''+         , ToSetOperation a c+         , ToSetOperation b c+         , c ~ SetOperationT a+         )  => ToFrom (UnionAll a b) where+  toFrom u = SqlSetOperation $ toSetOperation u+ instance (SqlSelect a' r,SqlSelect a'' r', ToAlias a, a' ~ ToAliasT a, ToAliasReference a', ToAliasReferenceT a' ~ a'')  => ToFrom (SqlSetOperation a) where   -- If someone uses just a plain SelectQuery it should behave like a normal subquery   toFrom (SelectQueryP _ q) = SubQuery q   -- Otherwise use the SqlSetOperation   toFrom q = SqlSetOperation q -instance (ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b', ToMaybe b', mb ~ ToMaybeT b')-       => ToFrom (LeftOuterJoin a (b, (a' :& mb) -> SqlExpr (Value Bool))) where-  toFrom (LeftOuterJoin lhs (rhs, on')) = LeftJoinFrom (toFrom lhs) (toFrom rhs, on')+class ToInnerJoin lateral lhs rhs res where+  toInnerJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> From res -instance (ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b', ToMaybe a', ma ~ ToMaybeT a', ToMaybe b', mb ~ ToMaybeT b')-       => ToFrom (FullOuterJoin a (b, (ma :& mb) -> SqlExpr (Value Bool))) where-  toFrom (FullOuterJoin lhs (rhs, on')) = FullJoinFrom (toFrom lhs) (toFrom rhs, on')+instance ( SqlSelect bAlias r+         , SqlSelect bAliasRef r'+         , ToAlias b+         , bAlias ~ ToAliasT b+         , ToAliasReference bAlias+         , bAliasRef ~ ToAliasReferenceT bAlias+         , ToFrom a+         , ToFromT a ~ a'+         ) => ToInnerJoin Lateral a (a' -> SqlQuery b) (a' :& bAliasRef) where+  toInnerJoin _ lhs q on' = InnerJoinFromLateral (toFrom lhs) (q, on') -instance (ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b', ToMaybe a', ma ~ ToMaybeT a')-       => ToFrom (RightOuterJoin a (b, (ma :& b') -> SqlExpr (Value Bool))) where-  toFrom (RightOuterJoin lhs (rhs, on')) = RightJoinFrom (toFrom lhs) (toFrom rhs, on')+instance (ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b')+        => ToInnerJoin NotLateral a b (a' :& b') where+  toInnerJoin _ lhs rhs on' = InnerJoinFrom (toFrom lhs) (toFrom rhs, on') -instance (ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b') => ToFrom (InnerJoin a (b, (a' :& b') -> SqlExpr (Value Bool))) where-  toFrom (InnerJoin lhs (rhs, on')) = InnerJoinFrom (toFrom lhs) (toFrom rhs, on')+instance ( ToFrom a+         , ToFromT a ~ a'+         , ToInnerJoin (IsLateral b) a b b'+         ) => ToFrom (InnerJoin a (b, b' -> SqlExpr (Value Bool))) where+         toFrom (InnerJoin lhs (rhs, on')) =+           let+            toProxy :: b -> Proxy (IsLateral b)+            toProxy _ = Proxy+           in toInnerJoin (toProxy rhs) lhs rhs on' -instance (ToFrom a, ToFrom b) => ToFrom (CrossJoin a b) where+instance ( ToFrom a+         , ToFrom b+         , ToFromT (CrossJoin a b) ~ (ToFromT a :& ToFromT b)+         ) => ToFrom (CrossJoin a b) where   toFrom (CrossJoin lhs rhs) = CrossJoinFrom (toFrom lhs) (toFrom rhs) +instance {-# OVERLAPPING #-}+         ( ToFrom a+         , ToFromT a ~ a'+         , SqlSelect bAlias r+         , SqlSelect bAliasRef r'+         , ToAlias b+         , bAlias ~ ToAliasT b+         , ToAliasReference bAlias+         , bAliasRef ~ ToAliasReferenceT bAlias+         )+       => ToFrom (CrossJoin a (a' -> SqlQuery b)) where+  toFrom (CrossJoin lhs q) = CrossJoinFromLateral (toFrom lhs) q++class ToLeftJoin lateral lhs rhs res where+  toLeftJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> From res++instance ( ToFrom a+         , ToFromT a ~ a'+         , SqlSelect bAlias r+         , SqlSelect bAliasRef r'+         , ToAlias b+         , bAlias ~ ToAliasT b+         , ToAliasReference bAlias+         , bAliasRef ~ ToAliasReferenceT bAlias+         , ToMaybe bAliasRef+         , mb ~ ToMaybeT bAliasRef+         ) => ToLeftJoin Lateral a (a' -> SqlQuery b) (a' :& mb) where+  toLeftJoin _ lhs q on' = LeftJoinFromLateral (toFrom lhs) (q, on')++instance ( ToFrom a+         , ToFromT a ~ a'+         , ToFrom b+         , ToFromT b ~ b'+         , ToMaybe b'+         , mb ~ ToMaybeT b'+         ) => ToLeftJoin NotLateral a b (a' :& mb) where+  toLeftJoin _ lhs rhs on' = LeftJoinFrom (toFrom lhs) (toFrom rhs, on')++instance ( ToLeftJoin (IsLateral b) a b b'+         ) => ToFrom (LeftOuterJoin a (b, b' -> SqlExpr (Value Bool))) where+         toFrom (LeftOuterJoin lhs (rhs, on')) =+           let+            toProxy :: b -> Proxy (IsLateral b)+            toProxy _ = Proxy+           in toLeftJoin (toProxy rhs) lhs rhs on'++instance ( ToFrom a+         , ToFromT a ~ a'+         , ToFrom b+         , ToFromT b ~ b'+         , ToMaybe a'+         , ma ~ ToMaybeT a'+         , ToMaybe b'+         , mb ~ ToMaybeT b'+         , ErrorOnLateral b+         ) => ToFrom (FullOuterJoin a (b, (ma :& mb) -> SqlExpr (Value Bool))) where+  toFrom (FullOuterJoin lhs (rhs, on')) = FullJoinFrom (toFrom lhs) (toFrom rhs, on')++instance ( ToFrom a+         , ToFromT a ~ a'+         , ToMaybe a'+         , ma ~ ToMaybeT a'+         , ToFrom b+         , ToFromT b ~ b'+         , ErrorOnLateral b+         ) => ToFrom (RightOuterJoin a (b, (ma :& b') -> SqlExpr (Value Bool))) where+  toFrom (RightOuterJoin lhs (rhs, on')) = RightJoinFrom (toFrom lhs) (toFrom rhs,  on')+ type family Nullable a where   Nullable (Maybe a) = a   Nullable a =  a@@ -610,25 +982,17 @@           where             getVal :: PersistEntity ent => From (SqlExpr (Entity ent)) -> Proxy ent             getVal = const Proxy-      runFrom (SubQuery subquery) = do-          -- We want to update the IdentState without writing the query to side data-          (ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ subquery-          aliasedValue <- toAlias ret-          -- Make a fake query with the aliased results, this allows us to ensure that the query is only run once-          let aliasedQuery = Q $ W.WriterT $ pure (aliasedValue, sideData)-          -- Add the FromQuery that renders the subquery to our side data-          subqueryAlias <- newIdentFor (DBName "q")-          -- Pass the aliased results of the subquery to the outer query-          -- create aliased references from the outer query results (e.g value from subquery will be `subquery`.`value`),-          -- this is probably overkill as the aliases should already be unique but seems to be good practice.-          ref <- toAliasReference subqueryAlias aliasedValue-          pure (ref , FromQuery subqueryAlias (\info -> toRawSql SELECT info aliasedQuery))+      runFrom (SubQuery subquery) =+        fromSubQuery NormalSubQuery subquery +      runFrom (FromCte ident ref) =+          pure (ref, FromIdent ident)+       runFrom (SqlSetOperation operation) = do           (aliasedOperation, ret) <- aliasQueries operation           ident <- newIdentFor (DBName "u")           ref <- toAliasReference ident ret-          pure (ref, FromQuery ident $ operationToSql aliasedOperation)+          pure (ref, FromQuery ident (operationToSql aliasedOperation) NormalSubQuery)            where             aliasQueries o =@@ -648,32 +1012,32 @@                             else                               Never                   pure (SelectQueryP p' $ Q $ W.WriterT $ pure (aliasedRet, sideData), aliasedRet)-                Union     o1 o2 -> do+                SqlSetUnion     o1 o2 -> do                   (o1', ret) <- aliasQueries o1                   (o2', _  ) <- aliasQueries o2-                  pure (Union o1' o2', ret)-                UnionAll  o1 o2 -> do+                  pure (SqlSetUnion o1' o2', ret)+                SqlSetUnionAll  o1 o2 -> do                   (o1', ret) <- aliasQueries o1                   (o2', _  ) <- aliasQueries o2-                  pure (UnionAll o1' o2', ret)-                Except    o1 o2 -> do+                  pure (SqlSetUnionAll o1' o2', ret)+                SqlSetExcept    o1 o2 -> do                   (o1', ret) <- aliasQueries o1                   (o2', _  ) <- aliasQueries o2-                  pure (Except o1' o2', ret)-                Intersect o1 o2 -> do+                  pure (SqlSetExcept o1' o2', ret)+                SqlSetIntersect o1 o2 -> do                   (o1', ret) <- aliasQueries o1                   (o2', _  ) <- aliasQueries o2-                  pure (Intersect o1' o2', ret)+                  pure (SqlSetIntersect o1' o2', ret)              operationToSql o info =               case o of                 SelectQueryP p q  ->                   let (builder, values) = toRawSql SELECT info q                   in (parensM p builder, values)-                Union     o1 o2 -> doSetOperation "UNION"     info o1 o2-                UnionAll  o1 o2 -> doSetOperation "UNION ALL" info o1 o2-                Except    o1 o2 -> doSetOperation "EXCEPT"    info o1 o2-                Intersect o1 o2 -> doSetOperation "INTERSECT" info o1 o2+                SqlSetUnion     o1 o2 -> doSetOperation "UNION"     info o1 o2+                SqlSetUnionAll  o1 o2 -> doSetOperation "UNION ALL" info o1 o2+                SqlSetExcept    o1 o2 -> doSetOperation "EXCEPT"    info o1 o2+                SqlSetIntersect o1 o2 -> doSetOperation "INTERSECT" info o1 o2              doSetOperation operationText info o1 o2 =                   let@@ -687,16 +1051,31 @@         (rightVal, rightFrom) <- runFrom rightPart         let ret = leftVal :& rightVal         pure $ (ret, FromJoin leftFrom InnerJoinKind rightFrom (Just (on' ret)))+      runFrom (InnerJoinFromLateral leftPart (q, on')) = do+        (leftVal, leftFrom) <- runFrom leftPart+        (rightVal, rightFrom) <- fromSubQuery LateralSubQuery (q leftVal)+        let ret = leftVal :& rightVal+        pure $ (ret, FromJoin leftFrom InnerJoinKind rightFrom (Just (on' ret)))       runFrom (CrossJoinFrom leftPart rightPart) = do         (leftVal, leftFrom) <- runFrom leftPart         (rightVal, rightFrom) <- runFrom rightPart         let ret = leftVal :& rightVal         pure $ (ret, FromJoin leftFrom CrossJoinKind rightFrom Nothing)+      runFrom (CrossJoinFromLateral leftPart q) = do+        (leftVal, leftFrom) <- runFrom leftPart+        (rightVal, rightFrom) <- fromSubQuery LateralSubQuery (q leftVal)+        let ret = leftVal :& rightVal+        pure $ (ret, FromJoin leftFrom CrossJoinKind rightFrom Nothing)       runFrom (LeftJoinFrom leftPart (rightPart, on')) = do         (leftVal, leftFrom) <- runFrom leftPart         (rightVal, rightFrom) <- runFrom rightPart         let ret = leftVal :& (toMaybe rightVal)         pure $ (ret, FromJoin leftFrom LeftOuterJoinKind rightFrom (Just (on' ret)))+      runFrom (LeftJoinFromLateral leftPart (q, on')) = do+        (leftVal, leftFrom) <- runFrom leftPart+        (rightVal, rightFrom) <- fromSubQuery LateralSubQuery (q leftVal)+        let ret = leftVal :& (toMaybe rightVal)+        pure $ (ret, FromJoin leftFrom LeftOuterJoinKind rightFrom (Just (on' ret)))       runFrom (RightJoinFrom leftPart (rightPart, on')) = do         (leftVal, leftFrom) <- runFrom leftPart         (rightVal, rightFrom) <- runFrom rightPart@@ -708,6 +1087,124 @@         let ret = (toMaybe leftVal) :& (toMaybe rightVal)         pure $ (ret, FromJoin leftFrom FullOuterJoinKind rightFrom (Just (on' ret))) +fromSubQuery :: ( SqlSelect a' r+                , SqlSelect a'' r'+                , ToAlias a+                , a' ~ ToAliasT a+                , ToAliasReference a'+                , ToAliasReferenceT a' ~ a''+                )+             => SubQueryType -> SqlQuery a -> SqlQuery (ToAliasReferenceT (ToAliasT a), FromClause)+fromSubQuery subqueryType subquery = do+    -- We want to update the IdentState without writing the query to side data+    (ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ subquery+    aliasedValue <- toAlias ret+    -- Make a fake query with the aliased results, this allows us to ensure that the query is only run once+    let aliasedQuery = Q $ W.WriterT $ pure (aliasedValue, sideData)+    -- Add the FromQuery that renders the subquery to our side data+    subqueryAlias <- newIdentFor (DBName "q")+    -- Pass the aliased results of the subquery to the outer query+    -- create aliased references from the outer query results (e.g value from subquery will be `subquery`.`value`),+    -- this is probably overkill as the aliases should already be unique but seems to be good practice.+    ref <- toAliasReference subqueryAlias aliasedValue+    pure (ref , FromQuery subqueryAlias (\info -> toRawSql SELECT info aliasedQuery) subqueryType)++++-- | @WITH@ clause used to introduce a [Common Table Expression (CTE)](https://en.wikipedia.org/wiki/Hierarchical_and_recursive_queries_in_SQL#Common_table_expression).+-- CTEs are supported in most modern SQL engines and can be useful+-- in performance tuning. In Esqueleto, CTEs should be used as a+-- subquery memoization tactic. While when writing plain SQL, CTEs+-- are sometimes used to organize the SQL code, in Esqueleto, this+-- is better achieved through function that return 'SqlQuery' values.+--+-- @+-- select $ do+-- cte <- with subQuery+-- cteResult <- from cte+-- where_ $ cteResult ...+-- pure cteResult+-- @+--+-- __WARNING__: In some SQL engines using a CTE can diminish performance.+-- In these engines the CTE is treated as an optimization fence. You should+-- always verify that using a CTE will in fact improve your performance+-- over a regular subquery.+--+-- /Since: 3.4.0.0/+with :: ( ToAlias a+        , ToAliasReference (ToAliasT a)+        , SqlSelect (ToAliasT a) r+        ) => SqlQuery a -> SqlQuery (From (ToAliasReferenceT (ToAliasT a)))+with query = do+  (ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ query+  aliasedValue <- toAlias ret+  let aliasedQuery = Q $ W.WriterT $ pure (aliasedValue, sideData)+  ident <- newIdentFor (DBName "cte")+  let clause = CommonTableExpressionClause NormalCommonTableExpression ident (\info -> toRawSql SELECT info aliasedQuery)+  Q $ W.tell mempty{sdCteClause = [clause]}+  ref <- toAliasReference ident aliasedValue+  pure $ FromCte ident ref++-- | @WITH@ @RECURSIVE@ allows one to make a recursive subquery, which can+-- reference itself. Like @WITH@, this is supported in most modern SQL engines.+-- Useful for hierarchical, self-referential data, like a tree of data.+--+-- @+-- select $ do+-- cte <- withRecursive+--          (do $+--              person <- from $ Table \@Person+--              where_ $ person ^. PersonId ==. val personId+--              pure person+--          )+--          unionAll_+--          (\\self -> do $+--              (p :& f :& p2 :& pSelf) <- from self+--                       \`InnerJoin\` $ Table \@Follow+--                       \`on\` (\\(p :& f) ->+--                               p ^. PersonId ==. f ^. FollowFollower)+--                       \`InnerJoin\` $ Table \@Person+--                       \`on\` (\\(p :& f :& p2) ->+--                               f ^. FollowFollowed ==. p2 ^. PersonId)+--                       \`LeftOuterJoin\` self+--                       \`on\` (\\(_ :& _ :& p2 :& pSelf) ->+--                               just (p2 ^. PersonId) ==. pSelf ?. PersonId)+--              where_ $ isNothing (pSelf ?. PersonId)+--              groupBy (p2 ^. PersonId)+--              pure p2+--          )+-- from cte+-- @+--+-- /Since: 3.4.0.0/+withRecursive :: ( ToAlias a+                 , ToAliasReference (ToAliasT a)+                 , SqlSelect a r+                 , SqlSelect (ToAliasT a) r+                 , ref ~ ToAliasReferenceT (ToAliasT a)+                 , RecursiveCteUnion unionKind+                 )+              => SqlQuery a+              -> unionKind+              -> (From ref -> SqlQuery a)+              -> SqlQuery (From ref)+withRecursive baseCase unionKind recursiveCase = do+  (ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ baseCase+  aliasedValue <- toAlias ret+  let aliasedQuery = Q $ W.WriterT $ pure (aliasedValue, sideData)+  ident <- newIdentFor (DBName "cte")+  ref <- toAliasReference ident aliasedValue+  let refFrom = FromCte ident ref+  let recursiveQuery = recursiveCase refFrom+  let clause = CommonTableExpressionClause RecursiveCommonTableExpression ident+               (\info -> (toRawSql SELECT info aliasedQuery)+                      <> (unionKeyword unionKind, mempty)+                      <> (toRawSql SELECT info recursiveQuery)+               )+  Q $ W.tell mempty{sdCteClause = [clause]}+  pure refFrom+ type family ToAliasT a where   ToAliasT (SqlExpr (Value a)) = SqlExpr (Value a)   ToAliasT (SqlExpr (Entity a)) = SqlExpr (Entity a)@@ -877,3 +1374,12 @@          , ToAliasReference h          ) => ToAliasReference (a,b,c,d,e,f,g,h) where   toAliasReference ident x = to8 <$> (toAliasReference ident $ from8 x)+++class RecursiveCteUnion a where+  unionKeyword :: a -> TLB.Builder++instance RecursiveCteUnion (a -> b -> Union a b) where+  unionKeyword _ = "\nUNION\n"+instance RecursiveCteUnion (a -> b -> UnionAll a b) where+  unionKeyword _ = "\nUNION ALL\n"

@@ -47,6 +47,7 @@ import qualified Data.Monoid as Monoid import Data.Proxy (Proxy(..)) import Database.Esqueleto.Internal.PersistentImport+import qualified Database.Persist import Database.Persist.Sql.Util (entityColumnNames, entityColumnCount, parseEntityValues, isIdField, hasCompositeKey) import qualified Data.Set as Set import Data.Set (Set)@@ -57,6 +58,7 @@ import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import qualified Data.HashSet as HS+import qualified Data.Map.Strict as Map import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB@@ -137,7 +139,6 @@ -- and tuple-joins do not need an 'on' clause, but 'InnerJoin' and the various -- outer joins do. ----- Note that this function will be replaced by the one in -- "Database.Esqueleto.Experimental" in version 4.0.0.0 of the library. The -- @Experimental@ module has a dramatically improved means for introducing -- tables and entities that provides more power and less potential for runtime@@ -1680,14 +1681,15 @@                          , sdOrderByClause  :: ![OrderByClause]                          , sdLimitClause    :: !LimitClause                          , sdLockingClause  :: !LockingClause+                         , sdCteClause      :: ![CommonTableExpressionClause]                          }  instance Semigroup SideData where-  SideData d f s w g h o l k <> SideData d' f' s' w' g' h' o' l' k' =-    SideData (d <> d') (f <> f') (s <> s') (w <> w') (g <> g') (h <> h') (o <> o') (l <> l') (k <> k')+  SideData d f s w g h o l k c <> SideData d' f' s' w' g' h' o' l' k' c' =+    SideData (d <> d') (f <> f') (s <> s') (w <> w') (g <> g') (h <> h') (o <> o') (l <> l') (k <> k') (c <> c')  instance Monoid SideData where-  mempty = SideData mempty mempty mempty mempty mempty mempty mempty mempty mempty+  mempty = SideData mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty   mappend = (<>)  -- | The @DISTINCT@ "clause".@@ -1711,14 +1713,29 @@     FromStart Ident EntityDef   | FromJoin FromClause JoinKind FromClause (Maybe (SqlExpr (Value Bool)))   | OnClause (SqlExpr (Value Bool))-  | FromQuery Ident (IdentInfo -> (TLB.Builder, [PersistValue]))+  | FromQuery Ident (IdentInfo -> (TLB.Builder, [PersistValue])) SubQueryType+  | FromIdent Ident +data CommonTableExpressionKind+  = RecursiveCommonTableExpression+  | NormalCommonTableExpression+  deriving Eq++data CommonTableExpressionClause =+  CommonTableExpressionClause CommonTableExpressionKind Ident (IdentInfo -> (TLB.Builder, [PersistValue]))++data SubQueryType+  = NormalSubQuery+  | LateralSubQuery+  deriving Show+ collectIdents :: FromClause -> Set Ident collectIdents fc = case fc of   FromStart i _ -> Set.singleton i   FromJoin lhs _ rhs _ -> collectIdents lhs <> collectIdents rhs   OnClause _ -> mempty-  FromQuery _ _ -> mempty+  FromQuery _ _ _ -> mempty+  FromIdent _ -> mempty  instance Show FromClause where   show fc = case fc of@@ -1740,9 +1757,10 @@       ]     OnClause expr ->       "(OnClause " <> render' expr <> ")"-    FromQuery ident _->-      "(FromQuery " <> show ident <> ")"-+    FromQuery ident _ subQueryType ->+      "(FromQuery " <> show ident <> " " <> show subQueryType <> ")"+    FromIdent ident ->+      "(FromIdent " <> show ident <> ")"      where       dummy = SqlBackend@@ -1800,12 +1818,14 @@     findRightmostIdent (FromStart i _) = Just i     findRightmostIdent (FromJoin _ _ r _) = findRightmostIdent r     findRightmostIdent (OnClause {}) = Nothing-    findRightmostIdent (FromQuery _ _) = Nothing+    findRightmostIdent (FromQuery _ _ _) = Nothing+    findRightmostIdent (FromIdent _) = Nothing      findLeftmostIdent (FromStart i _) = Just i     findLeftmostIdent (FromJoin l _ _ _) = findLeftmostIdent l     findLeftmostIdent (OnClause {}) = Nothing-    findLeftmostIdent (FromQuery _ _) = Nothing+    findLeftmostIdent (FromQuery _ _ _) = Nothing+    findLeftmostIdent (FromIdent _) = Nothing      tryMatch       :: Set Ident@@ -2632,14 +2652,16 @@                havingClause                orderByClauses                limitClause-               lockingClause = sd+               lockingClause+               cteClause = sd       -- Pass the finalIdentState (containing all identifiers       -- that were used) to the subsequent calls.  This ensures       -- that no name clashes will occur on subqueries that may       -- appear on the expressions below.       info = (projectBackend conn, finalIdentState)   in mconcat-      [ makeInsertInto info mode ret+      [ makeCte        info cteClause+      , makeInsertInto info mode ret       , makeSelect     info mode distinctClause ret       , makeFrom       info mode fromClauses       , makeSet        info setClauses@@ -2733,7 +2755,34 @@ uncommas' :: Monoid a => [(TLB.Builder, a)] -> (TLB.Builder, a) uncommas' = (uncommas *** mconcat) . unzip +makeCte :: IdentInfo -> [CommonTableExpressionClause] -> (TLB.Builder, [PersistValue])+makeCte info cteClauses =+  let+    withCteText+      | hasRecursive = "WITH RECURSIVE "+      | otherwise = "WITH " +      where+        hasRecursive =+          any (== RecursiveCommonTableExpression) $+            fmap (\(CommonTableExpressionClause cteKind _ _) -> cteKind) cteClauses++    cteClauseToText (CommonTableExpressionClause _ cteIdent cteFn) =+      first (\tlb ->+          useIdent info cteIdent <> " AS " <> parens tlb+      ) $ cteFn info++    cteBody =+      mconcat $+        intersperse (",\n", mempty) $+          fmap cteClauseToText cteClauses+  in+  if length cteClauses == 0 then+    mempty+  else+    first (\tlb -> withCteText <> tlb <> "\n") cteBody++ makeInsertInto :: SqlSelect a r => IdentInfo -> Mode -> a -> (TLB.Builder, [PersistValue]) makeInsertInto info INSERT_INTO ret = sqlInsertInto info ret makeInsertInto _    _           _   = mempty@@ -2783,9 +2832,15 @@               , maybe mempty makeOnClause monClause               ]     mk _ (OnClause _) = throw (UnexpectedCaseErr MakeFromError)-    mk _ (FromQuery ident f) =+    mk _ (FromQuery ident f subqueryType) =       let (queryText, queryVals) = f info-      in ((parens queryText) <> " AS " <> useIdent info ident, queryVals)+          lateralKeyword =+            case subqueryType of+              NormalSubQuery -> ""+              LateralSubQuery -> "LATERAL "+      in (lateralKeyword <> (parens queryText) <> " AS " <> useIdent info ident, queryVals)+    mk _ (FromIdent ident) =+      (useIdent info ident, mempty)      base ident@(I identText) def =       let db@(DBName dbText) = entityDB def@@ -3608,3 +3663,66 @@ -- -- @since 3.2.0 instance Exception RenderExprException+++----------------------------------------------------------------------+++-- | @valkey i = 'val' . 'toSqlKey'@+-- (<https://github.com/prowdsponsor/esqueleto/issues/9>).+valkey :: (ToBackendKey SqlBackend entity, PersistField (Key entity)) =>+          Int64 -> SqlExpr (Value (Key entity))+valkey = val . toSqlKey+++-- | @valJ@ is like @val@ but for something that is already a @Value@. The use+-- case it was written for was, given a @Value@ lift the @Key@ for that @Value@+-- into the query expression in a type safe way. However, the implementation is+-- more generic than that so we call it @valJ@.+--+-- Its important to note that the input entity and the output entity are+-- constrained to be the same by the type signature on the function+-- (<https://github.com/prowdsponsor/esqueleto/pull/69>).+--+-- /Since: 1.4.2/+valJ :: (PersistField (Key entity)) =>+        Value (Key entity) -> SqlExpr (Value (Key entity))+valJ = val . unValue+++----------------------------------------------------------------------+++-- | Synonym for 'Database.Persist.Store.delete' that does not+-- clash with @esqueleto@'s 'delete'.+deleteKey :: ( PersistStore backend+             , BaseBackend backend ~ PersistEntityBackend val+             , MonadIO m+             , PersistEntity val )+          => Key val -> R.ReaderT backend m ()+deleteKey = Database.Persist.delete++-- | Avoid N+1 queries and join entities into a map structure+-- @+-- getFoosAndNestedBarsFromParent :: ParentId -> (Map (Key Foo) (Foo, [Maybe (Entity Bar)]))+-- getFoosAndNestedBarsFromParent parentId = 'fmap' associateJoin $ 'select' $+-- 'from' $ \\(foo `'LeftOuterJoin`` bar) -> do+--   'on' (bar '?.' BarFooId '==.' foo '^.' FooId)+--   'where_' (foo '^.' FooParentId '==.' 'val' parentId)+--   'pure' (foo, bar)+-- @+--+-- @since 3.1.2+associateJoin+  :: forall e1 e0+   . Ord (Key e0)+  => [(Entity e0, e1)]+  -> Map.Map (Key e0) (e0, [e1])+associateJoin = foldr f start+  where+    start = Map.empty+    f (one, many) =+      Map.insertWith+        (\(oneOld, manyOld) (_, manyNew) -> (oneOld, manyNew ++ manyOld ))+        (entityKey one)+        (entityVal one, [many])

@@ -73,6 +73,10 @@   , toArgList   , builderToText   , Ident(..)+  , valkey+  , valJ+  , deleteKey+  , associateJoin   ) where  import Database.Esqueleto.Internal.Internal

@@ -891,7 +891,7 @@         let q = do                 p <- Experimental.from $ Table @Person                 return ( p ^. PersonName, p ^. PersonAge)-        ret <- select $ Experimental.from $ SelectQuery q+        ret <- select $ Experimental.from q         liftIO $ ret `shouldBe` [ (Value $ personName p1, Value $ personAge p1) ]      it "supports sub-selecting Maybe entities" $ do@@ -901,7 +901,7 @@         l1Deeds <- mapM (\k -> insert' $ Deed k (entityKey l1e)) (map show [1..3 :: Int])         let l1WithDeeds = do d <- l1Deeds                              pure (l1e, Just d)-        ret <- select $ Experimental.from $ SelectQuery $ do+        ret <- select $ Experimental.from $ do           (lords :& deeds) <-               Experimental.from $ Table @Lord               `LeftOuterJoin` Table @Deed@@ -976,7 +976,7 @@         mapM_ (\k -> insert $ Deed k l3k) (map show [4..10 :: Int])         let q = do                 (lord :& deed) <- Experimental.from $ Table @Lord-                        `InnerJoin` (SelectQuery $ Experimental.from $ Table @Deed)+                        `InnerJoin` (Experimental.from $ Table @Deed)                         `Experimental.on` (\(lord :& deed) ->                                              lord ^. LordId ==. deed ^. DeedOwnerId)                 groupBy (lord ^. LordId)@@ -991,10 +991,9 @@         l3k <- insert l3         let q = do                 (lord :& (_, dogCounts)) <- Experimental.from $ Table @Lord-                        `LeftOuterJoin` (SelectQuery $ do-                                      lord <- Experimental.from $ Table @Lord-                                      pure (lord ^. LordId, lord ^. LordDogs)-                                   )+                        `LeftOuterJoin` do+                            lord <- Experimental.from $ Table @Lord+                            pure (lord ^. LordId, lord ^. LordDogs)                         `Experimental.on` (\(lord :& (lordId, _)) ->                                              just (lord ^. LordId) ==. lordId)                 groupBy (lord ^. LordId, dogCounts)@@ -1007,17 +1006,17 @@           _ <- insert p1           _ <- insert p2           let q = Experimental.from $-                  (SelectQuery $ do+                  (do                     p <- Experimental.from $ Table @Person                     where_ $ not_ $ isNothing $ p ^. PersonAge                     return (p ^. PersonName))-                  `Union`-                  (SelectQuery $ do+                  `union_`+                  (do                     p <- Experimental.from $ Table @Person                     where_ $ isNothing $ p ^. PersonAge                     return (p ^. PersonName))-                  `Union`-                  (SelectQuery $ do+                  `union_`+                  (do                     p <- Experimental.from $ Table @Person                     where_ $ isNothing $ p ^. PersonAge                     return (p ^. PersonName))

@@ -33,6 +33,8 @@ import qualified Data.Text.Encoding as TE import Data.Time.Clock (getCurrentTime, diffUTCTime, UTCTime) import Database.Esqueleto hiding (random_)+import Database.Esqueleto.Experimental hiding (random_, from, on)+import qualified Database.Esqueleto.Experimental as Experimental import qualified Database.Esqueleto.Internal.Sql as ES import Database.Esqueleto.PostgreSQL (random_) import qualified Database.Esqueleto.PostgreSQL as EP@@ -1151,6 +1153,146 @@           ] :: [(Maybe Int, Maybe Rational, Maybe Rational)]         ) +testCommonTableExpressions :: Spec+testCommonTableExpressions = do+  describe "You can run them" $ do+    it "will run" $ do+      run $ do++        void $ select $ do+          limitedLordsCte <-+            Experimental.with $ do+              lords <- Experimental.from $ Experimental.Table @Lord+              limit 10+              pure lords+          lords <- Experimental.from limitedLordsCte+          orderBy [asc $ lords ^. LordId]+          pure lords++      True `shouldBe` True++  it "can do multiple recursive queries" $ do+    vals <- run $ do+      let oneToTen = Experimental.withRecursive+                     (pure $ val (1 :: Int))+                     Experimental.unionAll_+                     (\self -> do+                         v <- Experimental.from self+                         where_ $ v <. val 10+                         pure $ v +. val 1+                     )++      select $ do+        cte <- oneToTen+        cte2 <- oneToTen+        res1 <- Experimental.from cte+        res2 <- Experimental.from cte2+        pure (res1, res2)+    vals `shouldBe` (((,) <$> fmap Value [1..10] <*> fmap Value [1..10]))++  it "passing previous query works" $+    let+      oneToTen =+        Experimental.withRecursive+           (pure $ val (1 :: Int))+           Experimental.unionAll_+           (\self -> do+               v <- Experimental.from self+               where_ $ v <. val 10+               pure $ v +. val 1+           )++      oneMore q =+        Experimental.with $ do+          v <- Experimental.from q+          pure $ v +. val 1+    in do+    vals <- run $ do++      select $ do+        cte <- oneToTen+        cte2 <- oneMore cte+        res <- Experimental.from cte2+        pure res+    vals `shouldBe` fmap Value [2..11]++-- Since lateral queries arent supported in Sqlite or older versions of mysql+-- the test is in the Postgres module+testLateralQuery :: Spec+testLateralQuery = do+  describe "Lateral queries" $ do+    it "supports CROSS JOIN LATERAL" $ do+      _ <- run $ do+        select $ do+            l :& c <-+              Experimental.from $ Table @Lord+              `CrossJoin` \lord -> do+                    deed <- Experimental.from $ Table @Deed+                    where_ $ lord ^. LordId ==. deed ^. DeedOwnerId+                    pure $ countRows @Int+            pure (l, c)+      True `shouldBe` True++    it "supports INNER JOIN LATERAL" $ do+      run $ do+        let subquery lord = do+                            deed <- Experimental.from $ Table @Deed+                            where_ $ lord ^. LordId ==. deed ^. DeedOwnerId+                            pure $ countRows @Int+        res <- select $ do+          l :& c <- Experimental.from $ Table @Lord+                          `InnerJoin` subquery+                          `Experimental.on` (const $ val True)+          pure (l, c)++        let _ = res :: [(Entity Lord, Value Int)]+        pure ()+      True `shouldBe` True++    it "supports LEFT JOIN LATERAL" $ do+      run $ do+        res <- select $ do+          l :& c <- Experimental.from $ Table @Lord+                          `LeftOuterJoin` (\lord -> do+                                    deed <- Experimental.from $ Table @Deed+                                    where_ $ lord ^. LordId ==. deed ^. DeedOwnerId+                                    pure $ countRows @Int)+                          `Experimental.on` (const $ val True)+          pure (l, c)++        let _ = res :: [(Entity Lord, Value (Maybe Int))]+        pure ()+      True `shouldBe` True++  {--+    it "compile error on RIGHT JOIN LATERAL" $ do+      run $ do+        res <- select $ do+          l :& c <- Experimental.from $ Table @Lord+                          `RightOuterJoin` (\lord -> do+                                      deed <- Experimental.from $ Table @Deed+                                      where_ $ lord ?. LordId ==. just (deed ^. DeedOwnerId)+                                      pure $ countRows @Int)+                          `Experimental.on` (const $ val True)+          pure (l, c)++        let _ = res :: [(Maybe (Entity Lord), Value Int)]+        pure ()+    it "compile error on FULL OUTER JOIN LATERAL" $ do+      run $ do+        res <- select $ do+          l :& c <- Experimental.from $ Table @Lord+                          `FullOuterJoin` (\lord -> do+                                      deed <- Experimental.from $ Table @Deed+                                      where_ $ lord ?. LordId ==. just (deed ^. DeedOwnerId)+                                      pure $ countRows @Int)+                          `Experimental.on` (const $ val True)+          pure (l, c)++        let _ = res :: [(Maybe (Entity Lord), Value (Maybe Int))]+        pure ()+    --}+ type JSONValue = Maybe (JSONB A.Value)  createSaneSQL :: (PersistField a) => SqlExpr (Value a) -> T.Text -> [PersistValue] -> IO ()@@ -1226,6 +1368,7 @@       testUpsert       testInsertSelectWithConflict       testFilterWhere+      testCommonTableExpressions       describe "PostgreSQL JSON tests" $ do         -- NOTE: We only clean the table once, so we         -- can use its contents across all JSON tests@@ -1234,6 +1377,7 @@           cleanJSON         testJSONInsertions         testJSONOperators+      testLateralQuery   run, runSilent, runVerbose :: Run