Merge branch 'master' into format-config

changelog.md

@@ -1,9 +1,20 @@
-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
 =======
 - @parsonsmatt

esqueleto.cabal

@@ -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 @@ test-suite mysql
     , 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 @@ test-suite postgresql
     , 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 @@ test-suite sqlite
     , resourcet >=1.2
     , tagged >=0.2
     , text >=0.11 && <1.3
-    , time 
+    , time
     , transformers >=0.2
     , unliftio
     , unordered-containers >=0.2

src/Database/Esqueleto.hs

@@ -410,66 +410,3 @@ import qualified Database.Persist
 --
 -- 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])

src/Database/Esqueleto/Experimental.hs

@@ -30,12 +30,27 @@ module Database.Esqueleto.Experimental
 
       -- * Documentation
 
-      SqlSetOperation(Union, UnionAll, Except, Intersect)
+      From(..)
-    , pattern SelectQuery
-    , 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 @@ module Database.Esqueleto.Experimental
     , 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 Control.Monad.Trans.Class (lift)
 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
+import Database.Esqueleto.Internal.Internal hiding (from, on, From)
-          ( 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 GHC.TypeLits
 
+
 -- $setup
 --
 -- If you're already using "Database.Esqueleto", then you can get
@@ -95,9 +161,11 @@ import GHC.TypeLits
 --
 -- ...
 --
--- 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 @@ import GHC.TypeLits
 -- @
 -- select $ do
 -- peopleWithPosts <-
---   from $ SelectQuery $ do
+--   from $ do
 --     (people :& blogPosts) <-
 --       from $ Table \@Person
 --       \`InnerJoin\` Table \@BlogPost
@@ -303,7 +371,7 @@ import GHC.TypeLits
 -- @
 -- select $ do
 -- (authors, blogPosts) <- from $
---   (SelectQuery $ do
+--   (do
 --     (author :& blogPost) <-
 --       from $ Table \@Person
 --       \`InnerJoin\` Table \@BlogPost
@@ -312,8 +380,8 @@ import GHC.TypeLits
 --     where_ (author ^. PersonId ==. val currentPersonId)
 --     pure (author, blogPost)
 --   )
---   \`Union\`
+--   \`union_\`
---   (SelectQuery $ do
+--   (do
 --     (follow :& blogPost :& author) <-
 --       from $ Table \@Follow
 --       \`InnerJoin\` Table \@BlogPost
@@ -329,6 +397,56 @@ import GHC.TypeLits
 -- 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 @@ import GHC.TypeLits
 data (:&) a b = a :& b
 infixl 2 :&
 
--- | Data type that represents SQL set operations. This includes
+data SqlSetOperation a =
--- 'UNION', 'UNION' 'ALL', 'EXCEPT', and 'INTERSECT'. This data
+    SqlSetUnion (SqlSetOperation a) (SqlSetOperation a)
--- type is defined as a binary tree, with @SelectQuery@ on the leaves.
+  | 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
+-- Data type that represents SQL set operations. This includes
--- can be used as an infix function in a @from@ to help with readability
+-- '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 ...)
+--   (do
---   \`Union\`
+--      a <- from Table @A
---   (SelectQuery ...)
+--      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,31 +573,101 @@ pattern SelectQuery q = SelectQueryP Never q
 -- select $ from $ Table \@People
 -- @
 data From a where
-  Table         :: PersistEntity ent => From (SqlExpr (Entity ent))
+  Table
-  SubQuery      :: (SqlSelect a' r, SqlSelect a'' r', ToAlias a, a' ~ ToAliasT a, ToAliasReference a', ToAliasReferenceT a' ~ a'')
+    :: PersistEntity ent
-                => SqlQuery a
+    => From (SqlExpr (Entity ent))
-                -> From a''
+  SubQuery
-  SqlSetOperation :: (SqlSelect a' r, ToAlias a, a' ~ ToAliasT a, ToAliasReference a', ToAliasReferenceT a' ~ a'')
+    :: ( SqlSelect a' r
-                  => SqlSetOperation a
+       , SqlSelect a'' r'
-                  -> From a''
+       , ToAlias a
-  InnerJoinFrom :: From a
+       , a' ~ ToAliasT a
-                -> (From b, (a :& b) -> SqlExpr (Value Bool))
+       , ToAliasReference a'
-                -> From (a :& b)
+       , ToAliasReferenceT a' ~ a''
-  CrossJoinFrom :: From a
+       )
-                -> From b
+    => SqlQuery a
-                -> From (a :& b)
+    -> From a''
-  LeftJoinFrom  :: ToMaybe b
+  FromCte
-                => From a
+    :: Ident
-                -> (From b, (a :& ToMaybeT b) -> SqlExpr (Value Bool))
+    -> a
-                -> From (a :& ToMaybeT b)
+    -> From a
-  RightJoinFrom :: ToMaybe a
+  SqlSetOperation
-                => From a
+    :: ( SqlSelect a' r
-                -> (From b, (ToMaybeT a :& b) -> SqlExpr (Value Bool))
+       , ToAlias a
-                -> From (ToMaybeT a :& b)
+       , a' ~ ToAliasT a
-  FullJoinFrom  :: (ToMaybe a, ToMaybe b )
+       , ToAliasReference a'
-                => From a
+       , ToAliasReferenceT a' ~ a''
-                -> (From b, (ToMaybeT a :& ToMaybeT b) -> SqlExpr (Value Bool))
+       )
-                -> From (ToMaybeT a :& ToMaybeT b)
+    => 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 @@ data From a where
 -- \`on\` (\\(p :& bP) ->
 --         p ^. PersonId ==. bP ^. BlogPostAuthorId)
 -- @
---
+on :: ValidOnClauseValue a => a -> (b -> SqlExpr (Value Bool)) -> (a, b -> SqlExpr (Value Bool))
-on :: ToFrom a => a -> (b -> SqlExpr (Value Bool)) -> (a, b -> SqlExpr (Value Bool))
 on = (,)
 infix 9 `on`
 
@@ -449,17 +687,34 @@ type JoinErrorMsg jk = 'Text "Missing on statement for " ':<>: 'Text jk
 
 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 (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 (LeftOuterJoin a (b, c -> SqlExpr (Value Bool))) = c
+  ToFromT (RightOuterJoin a (b, c -> SqlExpr (Value Bool))) = c
+  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,29 +731,146 @@ instance {-# OVERLAPPABLE #-} ToFrom (RightOuterJoin a b) where
 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')
+class ToInnerJoin lateral lhs rhs res where
-       => ToFrom (LeftOuterJoin a (b, (a' :& mb) -> SqlExpr (Value Bool))) where
+  toInnerJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> From res
-  toFrom (LeftOuterJoin lhs (rhs, on')) = LeftJoinFrom (toFrom lhs) (toFrom rhs, on')
 
-instance (ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b', ToMaybe a', ma ~ ToMaybeT a', ToMaybe b', mb ~ ToMaybeT b')
+instance ( SqlSelect bAlias r
-       => ToFrom (FullOuterJoin a (b, (ma :& mb) -> SqlExpr (Value Bool))) where
+         , 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')
+        => ToInnerJoin NotLateral a b (a' :& b') where
+  toInnerJoin _ 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
+         , 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', ToFrom b, ToFromT b ~ b', ToMaybe a', ma ~ ToMaybeT a')
+instance ( ToFrom a
-       => ToFrom (RightOuterJoin a (b, (ma :& b') -> SqlExpr (Value Bool))) where
+         , ToFromT a ~ a'
-  toFrom (RightOuterJoin lhs (rhs, on')) = RightJoinFrom (toFrom lhs) (toFrom rhs, on')
+         , ToMaybe a'
-
+         , ma ~ ToMaybeT a'
-instance (ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b') => ToFrom (InnerJoin a (b, (a' :& b') -> SqlExpr (Value Bool))) where
+         , ToFrom b
-  toFrom (InnerJoin lhs (rhs, on')) = InnerJoinFrom (toFrom lhs) (toFrom rhs, on')
+         , ToFromT b ~ b'
-
+         , ErrorOnLateral b
-instance (ToFrom a, ToFrom b) => ToFrom (CrossJoin a b) where
+         ) => ToFrom (RightOuterJoin a (b, (ma :& b') -> SqlExpr (Value Bool))) where
-  toFrom (CrossJoin lhs rhs) = CrossJoinFrom (toFrom lhs) (toFrom rhs)
+  toFrom (RightOuterJoin lhs (rhs, on')) = RightJoinFrom (toFrom lhs) (toFrom rhs,  on')
 
 type family Nullable a where
   Nullable (Maybe a) = a
@@ -610,25 +982,17 @@ from parts = do
           where
             getVal :: PersistEntity ent => From (SqlExpr (Entity ent)) -> Proxy ent
             getVal = const Proxy
-      runFrom (SubQuery subquery) = do
+      runFrom (SubQuery subquery) =
-          -- We want to update the IdentState without writing the query to side data
+        fromSubQuery NormalSubQuery subquery
-          (ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ subquery
+
-          aliasedValue <- toAlias ret
+      runFrom (FromCte ident ref) =
-          -- Make a fake query with the aliased results, this allows us to ensure that the query is only run once
+          pure (ref, FromIdent ident)
-          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 (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 @@ from parts = do
                             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)
+                  pure (SqlSetUnion o1' o2', ret)
-                UnionAll  o1 o2 -> do
+                SqlSetUnionAll  o1 o2 -> do
                   (o1', ret) <- aliasQueries o1
                   (o2', _  ) <- aliasQueries o2
-                  pure (UnionAll o1' o2', ret)
+                  pure (SqlSetUnionAll o1' o2', ret)
-                Except    o1 o2 -> do
+                SqlSetExcept    o1 o2 -> do
                   (o1', ret) <- aliasQueries o1
                   (o2', _  ) <- aliasQueries o2
-                  pure (Except o1' o2', ret)
+                  pure (SqlSetExcept o1' o2', ret)
-                Intersect o1 o2 -> do
+                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
+                SqlSetUnion     o1 o2 -> doSetOperation "UNION"     info o1 o2
-                UnionAll  o1 o2 -> doSetOperation "UNION ALL" info o1 o2
+                SqlSetUnionAll  o1 o2 -> doSetOperation "UNION ALL" info o1 o2
-                Except    o1 o2 -> doSetOperation "EXCEPT"    info o1 o2
+                SqlSetExcept    o1 o2 -> doSetOperation "EXCEPT"    info o1 o2
-                Intersect o1 o2 -> doSetOperation "INTERSECT" info o1 o2
+                SqlSetIntersect o1 o2 -> doSetOperation "INTERSECT" info o1 o2
 
             doSetOperation operationText info o1 o2 =
                   let
@@ -687,16 +1051,31 @@ from parts = do
         (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 @@ from parts = do
         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 @@ instance ( ToAliasReference a
          , 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"

src/Database/Esqueleto/Internal/Internal.hs

@@ -47,6 +47,7 @@ import Data.Semigroup
 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.ByteString as B
 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 @@ where_ expr = Q $ W.tell mempty { sdWhereClause = Where expr }
 -- 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 @@ data SideData = SideData { sdDistinctClause :: !DistinctClause
                          , 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 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')
+    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 @@ data FromClause =
     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 @@ instance Show FromClause where
       ]
     OnClause expr ->
       "(OnClause " <> render' expr <> ")"
-    FromQuery ident _->
+    FromQuery ident _ subQueryType ->
-      "(FromQuery " <> show ident <> ")"
+      "(FromQuery " <> show ident <> " " <> show subQueryType <> ")"
-
+    FromIdent ident ->
+      "(FromIdent " <> show ident <> ")"
 
     where
       dummy = SqlBackend
@@ -1800,12 +1818,14 @@ collectOnClauses sqlBackend = go Set.empty []
     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 @@ toRawSql mode (conn, firstIdentState) query =
                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,6 +2755,33 @@ intersperseB a = mconcat . intersperse a . filter (/= mempty)
 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
@@ -2783,9 +2832,15 @@ makeFrom info mode fs = ret
               , 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 @@ data RenderExprException = RenderExprUnexpectedECompositeKey T.Text
 --
 -- @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])

src/Database/Esqueleto/Internal/Sql.hs

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

test/Common/Test.hs

@@ -878,7 +878,7 @@ testSelectSubQuery run = describe "select subquery" $ do
         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" $ run $ do
@@ -887,7 +887,7 @@ testSelectSubQuery run = describe "select subquery" $ do
         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
@@ -958,7 +958,7 @@ testSelectSubQuery run = describe "select subquery" $ do
         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)
@@ -972,10 +972,9 @@ testSelectSubQuery run = describe "select subquery" $ do
         l3k <- insert l3
         let q = do
                 (lord :& (_, dogCounts)) <- Experimental.from $ Table @Lord
-                        `LeftOuterJoin` (SelectQuery $ do
+                        `LeftOuterJoin` do
-                                      lord <- Experimental.from $ Table @Lord
+                            lord <- Experimental.from $ Table @Lord
-                                      pure (lord ^. LordId, lord ^. LordDogs)
+                            pure (lord ^. LordId, lord ^. LordDogs)
-                                   )
                         `Experimental.on` (\(lord :& (lordId, _)) ->
                                              just (lord ^. LordId) ==. lordId)
                 groupBy (lord ^. LordId, dogCounts)
@@ -987,17 +986,17 @@ testSelectSubQuery run = describe "select subquery" $ do
           _ <- 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`
+                  `union_`
-                  (SelectQuery $ do
+                  (do
                     p <- Experimental.from $ Table @Person
                     where_ $ isNothing $ p ^. PersonAge
                     return (p ^. PersonName))
-                  `Union`
+                  `union_`
-                  (SelectQuery $ do
+                  (do
                     p <- Experimental.from $ Table @Person
                     where_ $ isNothing $ p ^. PersonAge
                     return (p ^. PersonName))

test/PostgreSQL/Test.hs

@@ -33,6 +33,8 @@ import qualified Data.Text as T
 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 @@ testFilterWhere =
           ] :: [(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 @@ main = do
       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 @@ main = do
           cleanJSON
         testJSONInsertions
         testJSONOperators
+      testLateralQuery
 
 
 run, runSilent, runVerbose :: Run