Add source to SqlAggregate, the Over instance uses this to prevent pseudo-aggregates(from groupBy) and already windowed values from being windowed

From raw

changelog.md

@@ -1,9 +1,22 @@
+3.5.0.0
+=======- 
+- @belevy
+  - [#228](https://github.com/bitemyapp/esqueleto/pull/228)
+        - Destroy all GADTs; Removes the From GADT and SqlExpr GADT 
+        - From GADT is replaced with a From data type and FromRaw 
+        - SqlExpr is now all defined in terms of ERaw
+        - Modified ERaw to contain a SqlExprMeta with any extra information 
+          that may be needed
+        - Experimental top level is now strictly for documentation and all the 
+          implementation details are in Experimental.* modules
+
 3.4.1.0
 =======
 - @Vlix
   - [#232](https://github.com/bitemyapp/esqueleto/pull/232)
     - Export the `ValidOnClauseValue` type family
 
+
 3.4.0.1
 =======
 - @arthurxavierx

esqueleto.cabal

@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           esqueleto
-version:        3.4.1.0
+version:        3.5.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.
                 .
@@ -30,6 +30,8 @@ library
     exposed-modules:
         Database.Esqueleto
         Database.Esqueleto.Experimental
+        Database.Esqueleto.Experimental.Aggregates
+        Database.Esqueleto.Experimental.WindowFunctions
         Database.Esqueleto.Internal.Language
         Database.Esqueleto.Internal.Sql
         Database.Esqueleto.Internal.Internal
@@ -38,9 +40,16 @@ library
         Database.Esqueleto.PostgreSQL
         Database.Esqueleto.PostgreSQL.JSON
         Database.Esqueleto.SQLite
+        Database.Esqueleto.Experimental.From
+        Database.Esqueleto.Experimental.From.CommonTableExpression
+        Database.Esqueleto.Experimental.From.Join
+        Database.Esqueleto.Experimental.From.SqlSetOperation
+        Database.Esqueleto.Experimental.ToAlias
+        Database.Esqueleto.Experimental.ToAliasReference
+        Database.Esqueleto.Experimental.ToMaybe
     other-modules:
-        Database.Esqueleto.Internal.PersistentImport
         Database.Esqueleto.PostgreSQL.JSON.Instances
+        Database.Esqueleto.Internal.PersistentImport
         Paths_esqueleto
     hs-source-dirs:
         src/
@@ -156,7 +165,6 @@ test-suite sqlite
         Paths_esqueleto
     hs-source-dirs:
         test
-    ghc-options: -Wall
     build-depends:
         base >=4.8 && <5.0
       , attoparsec

examples/Main.hs

@@ -10,6 +10,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
@@ -19,15 +20,14 @@ module Main
     ) where
 
 import Blog
-import Control.Monad (void)
-import Control.Monad (forM_)
+import Control.Monad (forM_, void)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Logger (MonadLogger)
 import Control.Monad.Reader (MonadReader(..), runReaderT)
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Data.Monoid ((<>))
-import Database.Esqueleto
+import Database.Esqueleto.Experimental
 import Database.Persist.Postgresql (ConnectionString, withPostgresqlConn)
 import Database.Persist.TH
        ( AtLeastOneUniqueKey(..)
@@ -62,9 +62,9 @@ putPersons :: (MonadIO m, MonadLogger m)
            => SqlPersistT m ()
 putPersons = do
   -- | Select all values from the `person` table
-  people <- select $
-              from $ \person -> do
-              return person
+  people <- select $ do
+            person <- from $ table @Person
+            return person
 
   -- | entityVal extracts the Person value, which we then extract
   -- | the person name from the record and print it
@@ -75,8 +75,8 @@ getJohns :: (MonadIO m, MonadLogger m)
          => SqlReadT m [Entity Person]
 getJohns =
   -- | Select all persons where their name is equal to "John"
-  select $
-  from $ \p -> do
+  select $ do
+    p <- from $ table @Person
     where_ (p ^. PersonName ==. val "John")
     return p
 
@@ -85,8 +85,8 @@ getAdults :: (MonadIO m, MonadLogger m)
           => SqlReadT m [Entity Person]
 getAdults =
   -- | Select any Person where their age is >= 18 and NOT NULL
-  select $
-  from $ \p -> do
+  select $ do
+    p <- from $ table @Person
     where_ (p ^. PersonAge >=. just (val 18))
     return p
 
@@ -95,8 +95,10 @@ getBlogPostsByAuthors :: (MonadIO m, MonadLogger m)
                       => SqlReadT m [(Entity BlogPost, Entity Person)]
 getBlogPostsByAuthors =
   -- | Select all persons and their blogposts, ordering by title
-  select $
-  from $ \(b, p) -> do
+  select $ do
+    p :& b <-
+        from $ table @Person
+        `crossJoin` table @BlogPost
     where_ (b ^. BlogPostAuthorId ==. p ^. PersonId)
     orderBy [asc (b ^. BlogPostTitle)]
     return (b, p)
@@ -108,9 +110,11 @@ getAuthorMaybePosts =
   -- | Select all persons doing a left outer join on blogposts
   -- | Since a person may not have any blogposts the BlogPost Entity is wrapped
   -- | in a Maybe
-  select $
-  from $ \(p `LeftOuterJoin` mb) -> do
-    on (just (p ^. PersonId) ==. mb ?. BlogPostAuthorId)
+  select $ do
+    (p :& mb) <-
+        from $ table @Person
+        `leftJoin` table @BlogPost
+        `on` (\(p :& mb) -> (just (p ^. PersonId) ==. mb ?. BlogPostAuthorId))
     orderBy [asc (p ^. PersonName), asc (mb ?. BlogPostTitle)]
     return (p, mb)
 
@@ -122,10 +126,13 @@ followers =
   -- | Note carefully that the order of the ON clauses is reversed!
   -- | You're required to write your ons in reverse order because that helps composability
   -- | (see the documentation of on for more details).
-  select $
-  from $ \(p1 `InnerJoin` f `InnerJoin` p2) -> do
-    on (p2 ^. PersonId ==. f ^. FollowFollowed)
-    on (p1 ^. PersonId ==. f ^. FollowFollower)
+  select $ do
+    (p1 :& f :& p2) <-
+        from $ table @Person
+        `innerJoin` table @Follow
+        `on` (\(p1 :& f) -> p1 ^. PersonId ==. f ^. FollowFollower)
+        `innerJoin` table @Person
+        `on` (\(_ :& f :& p2) -> p2 ^. PersonId ==. f ^. FollowFollowed)
     return (p1, f, p2)
 
 
@@ -146,8 +153,8 @@ deleteYoungsters = do
   -- | In this case where `ON DELETE CASCADE` is not generated by migration
   -- | we select all the entities we want to delete and then for each one
   -- | one we extract the key and use Persistent's `deleteCascade`
-  youngsters <- select $
-    from $ \p -> do
+  youngsters <- select $ do
+    p <- from $ table @Person
     where_ (p ^. PersonAge <. just (val 14))
     pure p
   forM_ youngsters (deleteCascade . entityKey)
@@ -157,7 +164,8 @@ insertBlogPosts :: (MonadIO m, MonadLogger m)
                 => SqlWriteT m ()
 insertBlogPosts =
   -- | Insert a new blogpost for every person
-  insertSelect $ from $ \p ->
+  insertSelect $ do
+    p <- from $ table @Person
     return $ BlogPost <# (val "Group Blog Post") <&> (p ^. PersonId)
 
 

src/Database/Esqueleto.hs

@@ -1,4 +1,8 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, RankNTypes #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RankNTypes #-}
 -- | The @esqueleto@ EDSL (embedded domain specific language).
 -- This module replaces @Database.Persist@, so instead of
 -- importing that module you should just import this one:
@@ -71,6 +75,8 @@ module Database.Esqueleto
   , else_
   , from
   , Value(..)
+  , pattern Value
+  , unValue
   , ValueList(..)
   , OrderBy
   , DistinctOn
@@ -125,8 +131,8 @@ import Control.Monad.Trans.Reader (ReaderT)
 import Data.Int (Int64)
 import qualified Data.Map.Strict as Map
 import Database.Esqueleto.Internal.Language
-import Database.Esqueleto.Internal.Sql
 import Database.Esqueleto.Internal.PersistentImport
+import Database.Esqueleto.Internal.Sql
 import qualified Database.Persist
 
 

src/Database/Esqueleto/Experimental/Aggregates.hs

@@ -0,0 +1,153 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Database.Esqueleto.Experimental.Aggregates
+    where
+
+import Control.Monad.IO.Class
+import qualified Control.Monad.Trans.Writer as W
+import Data.Coerce (Coercible, coerce)
+import Data.Proxy
+import Database.Esqueleto.Internal.Internal
+       ( GroupByClause(..)
+       , SideData(..)
+       , SqlExpr(..)
+       , SqlQuery(..)
+       , SqlQueryHaving(..)
+       , SqlSelect(..)
+       , ToSomeValues(..)
+       , noMeta
+       , select
+       , unsafeSqlFunction
+       )
+import qualified Database.Esqueleto.Internal.Internal as I
+import Database.Esqueleto.Internal.PersistentImport
+       ( Entity
+       , EntityField
+       , Key
+       , PersistEntity
+       , PersistField
+       , SqlReadT
+       , persistIdField
+       )
+
+class SqlExprEntity expr where
+    (^.) :: (PersistEntity val, PersistField typ)
+        => expr (Entity val)
+        -> EntityField val typ
+        -> expr typ
+    (?.) :: (PersistEntity val, PersistField typ)
+        => expr (Maybe (Entity val))
+        -> EntityField val typ
+        -> expr (Maybe typ)
+
+    -- | Project a field of an entity.
+instance SqlExprEntity SqlExpr where
+    (^.) = (I.^.)
+    (?.) = (I.?.)
+
+newtype SqlAggregate source a = SqlAggregate { unsafeSqlAggregate :: SqlExpr a }
+deriving via SqlExpr instance SqlExprEntity (SqlAggregate source)
+instance forall a source. PersistField a => SqlSelect (SqlAggregate source a) a where
+    sqlSelectCols info (SqlAggregate e) = sqlSelectCols info e
+    sqlSelectColCount = const 1
+    sqlSelectProcessRow _ = sqlSelectProcessRow (Proxy :: Proxy (SqlExpr a))
+instance SqlQueryHaving (SqlAggregate source Bool) where
+    having expr = Q $ W.tell mempty { sdHavingClause = I.Where (coerce expr) }
+instance SqlQueryHaving (SqlAggregate source (Maybe Bool)) where
+    having expr = Q $ W.tell mempty { sdHavingClause = I.Where (coerce expr) }
+
+test :: (PersistEntity ent, PersistField a, PersistField b, PersistField c)
+     => SqlExpr (Maybe (Entity ent))
+     -> EntityField ent a
+     -> SqlExpr b
+     -> SqlExpr c
+     -> SqlQuery (SqlExpr (Maybe a), SqlExpr b, SqlExpr (Maybe Int), SqlExpr Int)
+test ent field y other = do
+    groupBy (ent, y) $ \(ent', y') ->
+        pure (ent' ?. field, y', sum_ other, countRows_)
+
+
+-- Tuple magic, only SqlExprs are on the leaves.
+-- The Coercible instance from the SqlExpr a -> SqlExpr b allows 0 cost casting
+class Coercible a r => Aggregateable a r | a -> r, r -> a where
+    toAggregate :: a -> r
+    toAggregate = coerce
+
+    fromAggregate :: r -> a
+    fromAggregate = coerce
+
+data GroupedValue
+instance Aggregateable () () where
+instance Aggregateable (SqlExpr a) (SqlAggregate GroupedValue a) where
+instance (Aggregateable a ra, Aggregateable b rb) => Aggregateable (a,b) (ra, rb) where
+instance
+    ( Aggregateable a ra
+    , Aggregateable b rb
+    , Aggregateable c rc
+    ) => Aggregateable (a,b,c) (ra,rb,rc) where
+instance
+    ( Aggregateable a ra
+    , Aggregateable b rb
+    , Aggregateable c rc
+    , Aggregateable d rd
+    ) => Aggregateable (a,b,c,d) (ra,rb,rc,rd) where
+instance
+    ( Aggregateable a ra
+    , Aggregateable b rb
+    , Aggregateable c rc
+    , Aggregateable d rd
+    , Aggregateable e re
+    ) => Aggregateable (a,b,c,d,e) (ra,rb,rc,rd,re) where
+instance
+    ( Aggregateable a ra
+    , Aggregateable b rb
+    , Aggregateable c rc
+    , Aggregateable d rd
+    , Aggregateable e re
+    , Aggregateable f rf
+    ) => Aggregateable (a,b,c,d,e,f) (ra,rb,rc,rd,re,rf) where
+instance
+    ( Aggregateable a ra
+    , Aggregateable b rb
+    , Aggregateable c rc
+    , Aggregateable d rd
+    , Aggregateable e re
+    , Aggregateable f rf
+    , Aggregateable g rg
+    ) => Aggregateable (a,b,c,d,e,f,g) (ra,rb,rc,rd,re,rf,rg) where
+instance
+    ( Aggregateable a ra
+    , Aggregateable b rb
+    , Aggregateable c rc
+    , Aggregateable d rd
+    , Aggregateable e re
+    , Aggregateable f rf
+    , Aggregateable g rg
+    , Aggregateable h rh
+    ) => Aggregateable (a,b,c,d,e,f,g,h) (ra,rb,rc,rd,re,rf,rg,rh) where
+
+groupBy :: ( ToSomeValues a
+           , Aggregateable a a'
+           , Aggregateable b b'
+           ) => a -> (a' -> SqlQuery b') -> SqlQuery b
+groupBy a f = do
+    Q $ W.tell $ mempty{sdGroupByClause = GroupBy $ toSomeValues a }
+    fmap fromAggregate $ f $ toAggregate a
+
+-- Aggregation Functions
+countRows_ :: forall n s. (PersistField n, Integral n) => SqlAggregate s n
+countRows_ = SqlAggregate $ ERaw noMeta $ \_ _ -> ("COUNT(*)", [])
+
+sum_ :: forall n a w. (PersistField a, PersistField n, Integral n) => SqlExpr a -> SqlAggregate w (Maybe n)
+sum_ = coerce . unsafeSqlFunction "SUM"
+

src/Database/Esqueleto/Experimental/From.hs

@@ -0,0 +1,144 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Database.Esqueleto.Experimental.From
+    where
+
+import Control.Arrow (first)
+import Control.Monad (ap)
+import qualified Control.Monad.Trans.Writer as W
+import Data.Proxy
+import qualified Data.Text.Lazy.Builder as TLB
+import Database.Esqueleto.Experimental.ToAlias
+import Database.Esqueleto.Experimental.ToAliasReference
+import Database.Esqueleto.Internal.Internal hiding (From(..), from, on)
+import Database.Esqueleto.Internal.PersistentImport
+
+-- | 'FROM' clause, used to bring entities into scope.
+--
+-- Internally, this function uses the `From` datatype.
+-- Unlike the old `Database.Esqueleto.from`, this does not
+-- take a function as a parameter, but rather a value that
+-- represents a 'JOIN' tree constructed out of instances of `From`.
+-- This implementation eliminates certain
+-- types of runtime errors by preventing the construction of
+-- invalid SQL (e.g. illegal nested-@from@).
+from :: ToFrom a a' => a -> SqlQuery a'
+from f = do
+    (a, clause) <- unFrom (toFrom f)
+    Q $ W.tell mempty{sdFromClause=[FromRaw $ clause]}
+    pure a
+
+type RawFn = NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])
+
+-- | Data type defining the "From" language. This should not
+-- constructed directly in application code.
+--
+-- A @From@ is a SqlQuery which returns a reference to the result of calling from
+-- and a function that produces a portion of a FROM clause. This gets passed to
+-- the FromRaw FromClause constructor directly when converting
+-- from a @From@ to a @SqlQuery@ using @from@
+--
+-- /Since: 3.5.0.0/
+newtype From a = From
+    { unFrom :: SqlQuery (a, RawFn)}
+
+
+-- | A helper class primarily designed to allow using @SqlQuery@ directly in
+-- a From expression. This is also useful for embedding a @SqlSetOperation@,
+-- as well as supporting backwards compatibility for the
+-- data constructor join tree used prior to /3.5.0.0/
+--
+-- /Since: 3.5.0.0/
+class ToFrom a r | a -> r where
+    toFrom :: a -> From r
+instance ToFrom (From a) a where
+    toFrom = id
+
+{-# DEPRECATED Table "/Since: 3.5.0.0/ - use 'table' instead" #-}
+data Table a = Table
+
+instance PersistEntity ent => ToFrom (Table ent) (SqlExpr (Entity ent)) where
+    toFrom _ = table
+
+-- | Bring a PersistEntity into scope from a table
+--
+-- @
+-- select $ from $ table \@People
+-- @
+--
+-- /Since: 3.5.0.0/
+table :: forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
+table = From $ do
+    let ed = entityDef (Proxy @ent)
+    ident <- newIdentFor (entityDB ed)
+    let entity = unsafeSqlEntity ident
+    pure $ ( entity, const $ base ident ed )
+      where
+        base ident@(I identText) def info =
+            let db@(DBName dbText) = entityDB def
+            in ( fromDBName info db <>
+                     if dbText == identText
+                     then mempty
+                     else " AS " <> useIdent info ident
+               , mempty
+               )
+
+
+{-# DEPRECATED SubQuery "/Since: 3.4.0.0/ - It is no longer necessary to tag 'SqlQuery' values with @SubQuery@" #-}
+newtype SubQuery a = SubQuery a
+instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToFrom (SubQuery (SqlQuery a)) a where
+    toFrom (SubQuery q) = selectQuery q
+instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToFrom (SqlQuery a) a where
+    toFrom = selectQuery
+
+-- | Select from a subquery, often used in conjuction with joins but can be
+-- used without any joins. Because @SqlQuery@ has a @ToFrom@ instance you probably
+-- dont need to use this function directly.
+--
+-- @
+-- select $
+--      p <- from $
+--              selectQuery do
+--              p <- from $ table \@Person
+--              limit 5
+--              orderBy [ asc p ^. PersonAge ]
+--      ...
+-- @
+--
+-- /Since: 3.5.0.0/
+selectQuery :: (SqlSelect a r, ToAlias a, ToAliasReference a) => SqlQuery a -> From a
+selectQuery subquery = From $ 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, \_ info ->
+            let (queryText,queryVals) = toRawSql SELECT info aliasedQuery
+            in
+            ( (parens queryText) <> " AS " <> useIdent info subqueryAlias
+            , queryVals
+            )
+         )

src/Database/Esqueleto/Experimental/From/CommonTableExpression.hs

@@ -0,0 +1,112 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Database.Esqueleto.Experimental.From.CommonTableExpression
+    where
+
+import qualified Control.Monad.Trans.Writer as W
+import qualified Data.Text.Lazy.Builder as TLB
+import Database.Esqueleto.Experimental.From
+import Database.Esqueleto.Experimental.From.SqlSetOperation
+import Database.Esqueleto.Experimental.ToAlias
+import Database.Esqueleto.Experimental.ToAliasReference
+import Database.Esqueleto.Internal.Internal hiding (From(..), from, on)
+import Database.Esqueleto.Internal.PersistentImport (DBName(..))
+
+-- | @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. 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 a
+        , SqlSelect a r
+        ) => SqlQuery a -> SqlQuery (From 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 $ From $ pure (ref, (\_ info -> (useIdent info ident, mempty)))
+
+-- | @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)
+--                       \`leftJoin\` 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 a
+                 , SqlSelect a r
+                 )
+              => SqlQuery a
+              -> UnionKind
+              -> (From a -> SqlQuery a)
+              -> SqlQuery (From a)
+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 = From (pure (ref, (\_ info -> (useIdent info ident, mempty))))
+    let recursiveQuery = recursiveCase refFrom
+    let clause = CommonTableExpressionClause RecursiveCommonTableExpression ident
+                 (\info -> (toRawSql SELECT info aliasedQuery)
+                        <> ("\n" <> (unUnionKind unionKind)  <> "\n", mempty)
+                        <> (toRawSql SELECT info recursiveQuery)
+                 )
+    Q $ W.tell mempty{sdCteClause = [clause]}
+    pure refFrom
+
+newtype UnionKind = UnionKind { unUnionKind :: TLB.Builder }
+instance Union_ UnionKind where
+    union_ = UnionKind "UNION"
+instance UnionAll_ UnionKind where
+    unionAll_ = UnionKind "UNION ALL"

src/Database/Esqueleto/Experimental/From/Join.hs

@@ -0,0 +1,412 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
+
+module Database.Esqueleto.Experimental.From.Join
+    where
+
+import Control.Arrow (first)
+import Data.Kind (Constraint)
+import Data.Proxy
+import qualified Data.Text.Lazy.Builder as TLB
+import Database.Esqueleto.Experimental.From
+import Database.Esqueleto.Experimental.ToAlias
+import Database.Esqueleto.Experimental.ToAliasReference
+import Database.Esqueleto.Experimental.ToMaybe
+import Database.Esqueleto.Internal.Internal hiding
+       (From(..), from, fromJoin, on)
+import GHC.TypeLits
+
+-- | A left-precedence pair. Pronounced \"and\". Used to represent expressions
+-- that have been joined together.
+--
+-- The precedence behavior can be demonstrated by:
+--
+-- @
+-- a :& b :& c == ((a :& b) :& c)
+-- @
+--
+-- See the examples at the beginning of this module to see how this
+-- operator is used in 'JOIN' operations.
+data (:&) a b = a :& b
+    deriving (Show, Eq)
+infixl 2 :&
+
+instance (ToMaybe a, ToMaybe b) => ToMaybe (a :& b) where
+    type ToMaybeT (a :& b) = (ToMaybeT a :& ToMaybeT b)
+    toMaybe (a :& b) = (toMaybe a :& toMaybe b)
+
+fromInductiveTupleP :: Proxy (a :& b) -> Proxy (a, b)
+fromInductiveTupleP = const Proxy
+toInductiveTuple :: (a, b) -> (a :& b)
+toInductiveTuple (a, b) = a :& b
+
+instance (SqlSelect a a', SqlSelect b b') => SqlSelect (a :& b) (a' :& b') where
+    sqlSelectCols esc (a :& b) = sqlSelectCols esc (a, b)
+    sqlSelectColCount  = sqlSelectColCount . fromInductiveTupleP
+    sqlSelectProcessRow p = fmap toInductiveTuple . sqlSelectProcessRow (fromInductiveTupleP p)
+
+class ValidOnClause 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,
+    --
+    -- @
+    -- select $
+    -- from $ table \@Person
+    -- \`innerJoin\` table \@BlogPost
+    -- \`on\` (\\(p :& bP) ->
+    --         p ^. PersonId ==. bP ^. BlogPostAuthorId)
+    -- @
+    on :: a -> (b -> SqlExpr Bool) -> (a, b -> SqlExpr Bool)
+    on = (,)
+infix 9 `on`
+
+instance {-# OVERLAPPABLE #-} ToFrom a a' => ValidOnClause a
+instance ValidOnClause (a -> SqlQuery b)
+
+type family ErrorOnLateral a :: Constraint where
+  ErrorOnLateral (a -> SqlQuery b) = TypeError ('Text "LATERAL can only be used for INNER, LEFT, and CROSS join kinds.")
+  ErrorOnLateral _ = ()
+
+fromJoin :: TLB.Builder -> RawFn -> RawFn -> Maybe (SqlExpr Bool) -> RawFn
+fromJoin joinKind lhs rhs monClause =
+    \paren info ->
+        first (parensM paren) $
+        mconcat [ lhs Never info
+                , (joinKind, mempty)
+                , rhs Parens info
+                , maybe mempty (makeOnClause info) monClause
+                ]
+    where
+        makeOnClause info (ERaw _ f)        = first (" ON " <>) (f Never info)
+
+type family HasOnClause actual expected :: Constraint where
+    HasOnClause (a, b -> SqlExpr Bool) c = () -- Let the compiler handle the type mismatch
+    HasOnClause a expected =
+        TypeError ( 'Text "Missing ON clause for join with"
+                    ':$$: 'ShowType a
+                    ':$$: 'Text ""
+                    ':$$: 'Text "Expected: "
+                    ':$$: 'ShowType a
+                    ':$$: 'Text "`on` " ':<>: 'ShowType (expected -> SqlExpr Bool)
+                    ':$$: 'Text ""
+                  )
+
+
+-- | INNER JOIN
+--
+-- Used as an infix operator \`innerJoin\`
+--
+-- @
+-- select $
+-- from $ table \@Person
+-- \`innerJoin\` table \@BlogPost
+-- \`on\` (\\(p :& bp) ->
+--         p ^. PersonId ==. bp ^. BlogPostAuthorId)
+-- @
+--
+-- /Since: 3.5.0.0/
+innerJoin :: ( ToFrom a a'
+             , ToFrom b b'
+             , HasOnClause rhs (a' :& b')
+             , rhs ~ (b, (a' :& b') -> SqlExpr Bool)
+             ) => a -> rhs -> From (a' :& b')
+innerJoin lhs (rhs, on') = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (toFrom rhs)
+     let ret = leftVal :& rightVal
+     pure $ (ret, fromJoin " INNER JOIN " leftFrom rightFrom (Just $ on' ret))
+
+
+-- | INNER JOIN LATERAL
+--
+-- A Lateral subquery join allows the joined query to reference entities from the
+-- left hand side of the join. Discards rows that don't match the on clause
+--
+-- Used as an infix operator \`innerJoinLateral\`
+--
+-- See example 6
+--
+-- /Since: 3.5.0.0/
+innerJoinLateral :: ( ToFrom a a'
+                    , HasOnClause rhs (a' :& b)
+                    , SqlSelect b r
+                    , ToAlias b
+                    , ToAliasReference b
+                    , rhs ~ (a' -> SqlQuery b, (a' :& b) -> SqlExpr Bool)
+                    )
+                 => a -> rhs -> From (a' :& b)
+innerJoinLateral lhs (rhsFn, on') = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (selectQuery (rhsFn leftVal))
+     let ret = leftVal :& rightVal
+     pure $ (ret, fromJoin " INNER JOIN LATERAL " leftFrom rightFrom (Just $ on' ret))
+
+-- | CROSS JOIN
+--
+-- Used as an infix \`crossJoin\`
+--
+-- @
+-- select $ do
+-- from $ table \@Person
+-- \`crossJoin\` table \@BlogPost
+-- @
+--
+-- /Since: 3.5.0.0/
+crossJoin :: ( ToFrom a a'
+             , ToFrom b b'
+             ) => a -> b -> From (a' :& b')
+crossJoin lhs rhs = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (toFrom rhs)
+     let ret = leftVal :& rightVal
+     pure $ (ret, fromJoin " CROSS JOIN " leftFrom rightFrom Nothing)
+
+-- | CROSS JOIN LATERAL
+--
+-- A Lateral subquery join allows the joined query to reference entities from the
+-- left hand side of the join.
+--
+-- Used as an infix operator \`crossJoinLateral\`
+--
+-- See example 6
+--
+-- /Since: 3.5.0.0/
+crossJoinLateral :: ( ToFrom a a'
+                    , SqlSelect b r
+                    , ToAlias b
+                    , ToAliasReference b
+                    )
+                 => a -> (a' -> SqlQuery b) -> From (a' :& b)
+crossJoinLateral lhs rhsFn = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (selectQuery (rhsFn leftVal))
+     let ret = leftVal :& rightVal
+     pure $ (ret, fromJoin " CROSS JOIN LATERAL " leftFrom rightFrom Nothing)
+
+-- | LEFT OUTER JOIN
+--
+-- Join where the right side may not exist.
+-- If the on clause fails then the right side will be NULL'ed
+-- Because of this the right side needs to be handled as a Maybe
+--
+-- Used as an infix operator \`leftJoin\`
+--
+-- @
+-- select $
+-- from $ table \@Person
+-- \`leftJoin\` table \@BlogPost
+-- \`on\` (\\(p :& bp) ->
+--         p ^. PersonId ==. bp ?. BlogPostAuthorId)
+-- @
+--
+-- /Since: 3.5.0.0/
+leftJoin :: ( ToFrom a a'
+            , ToFrom b b'
+            , ToMaybe b'
+            , HasOnClause rhs (a' :& ToMaybeT b')
+            , rhs ~ (b, (a' :& ToMaybeT b') -> SqlExpr Bool)
+            ) => a -> rhs -> From (a' :& ToMaybeT b')
+leftJoin lhs (rhs, on') = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (toFrom rhs)
+     let ret = leftVal :& toMaybe rightVal
+     pure $ (ret, fromJoin " LEFT OUTER JOIN " leftFrom rightFrom (Just $ on' ret))
+
+-- | LEFT OUTER JOIN LATERAL
+--
+-- Lateral join where the right side may not exist.
+-- In the case that the query returns nothing or the on clause fails the right
+-- side of the join will be NULL'ed
+-- Because of this the right side needs to be handled as a Maybe
+--
+-- Used as an infix operator \`leftJoinLateral\`
+--
+-- See example 6 for how to use LATERAL
+--
+-- /Since: 3.5.0.0/
+leftJoinLateral :: ( ToFrom a a'
+                   , SqlSelect b r
+                   , HasOnClause rhs (a' :& ToMaybeT b)
+                   , ToAlias b
+                   , ToAliasReference b
+                   , ToMaybe b
+                   , rhs ~ (a' -> SqlQuery b, (a' :& ToMaybeT b) -> SqlExpr Bool)
+                   )
+                 => a -> rhs -> From (a' :& ToMaybeT b)
+leftJoinLateral lhs (rhsFn, on') = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (selectQuery (rhsFn leftVal))
+     let ret = leftVal :& toMaybe rightVal
+     pure $ (ret, fromJoin " LEFT OUTER JOIN LATERAL " leftFrom rightFrom (Just $ on' ret))
+
+-- | RIGHT OUTER JOIN
+--
+-- Join where the left side may not exist.
+-- If the on clause fails then the left side will be NULL'ed
+-- Because of this the left side needs to be handled as a Maybe
+--
+-- Used as an infix operator \`rightJoin\`
+--
+-- @
+-- select $
+-- from $ table \@Person
+-- \`rightJoin\` table \@BlogPost
+-- \`on\` (\\(p :& bp) ->
+--         p ?. PersonId ==. bp ^. BlogPostAuthorId)
+-- @
+--
+-- /Since: 3.5.0.0/
+rightJoin :: ( ToFrom a a'
+             , ToFrom b b'
+             , ToMaybe a'
+             , HasOnClause rhs (ToMaybeT a' :& b')
+             , rhs ~ (b, (ToMaybeT a' :& b') -> SqlExpr Bool)
+             ) => a -> rhs -> From (ToMaybeT a' :& b')
+rightJoin lhs (rhs, on') = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (toFrom rhs)
+     let ret = toMaybe leftVal :& rightVal
+     pure $ (ret, fromJoin " RIGHT OUTER JOIN " leftFrom rightFrom (Just $ on' ret))
+
+-- | FULL OUTER JOIN
+--
+-- Join where both sides of the join may not exist.
+-- Because of this the result needs to be handled as a Maybe
+--
+-- Used as an infix operator \`fullOuterJoin\`
+--
+-- @
+-- select $
+-- from $ table \@Person
+-- \`fullOuterJoin\` table \@BlogPost
+-- \`on\` (\\(p :& bp) ->
+--         p ?. PersonId ==. bp ?. BlogPostAuthorId)
+-- @
+--
+-- /Since: 3.5.0.0/
+fullOuterJoin :: ( ToFrom a a'
+                 , ToFrom b b'
+                 , ToMaybe a'
+                 , ToMaybe b'
+                 , HasOnClause rhs (ToMaybeT a' :& ToMaybeT b')
+                 , rhs ~ (b, (ToMaybeT a' :& ToMaybeT b') -> SqlExpr Bool)
+                 ) => a -> rhs -> From (ToMaybeT a' :& ToMaybeT b')
+fullOuterJoin lhs (rhs, on') = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (toFrom rhs)
+     let ret = toMaybe leftVal :& toMaybe rightVal
+     pure $ (ret, fromJoin " FULL OUTER JOIN " leftFrom rightFrom (Just $ on' ret))
+
+infixl 2 `innerJoin`,
+         `innerJoinLateral`,
+         `leftJoin`,
+         `leftJoinLateral`,
+         `crossJoin`,
+         `crossJoinLateral`,
+         `rightJoin`,
+         `fullOuterJoin`
+
+
+------ Compatibility for old syntax
+
+data Lateral
+data NotLateral
+
+type family IsLateral a where
+    IsLateral (a -> SqlQuery b, c) = Lateral
+    IsLateral (a -> SqlQuery b) = Lateral
+    IsLateral a = NotLateral
+
+class DoInnerJoin lateral lhs rhs res | lateral rhs lhs -> res where
+    doInnerJoin :: Proxy lateral -> lhs -> rhs -> From res
+
+instance ( ToFrom a a'
+         , ToFrom b b'
+         , HasOnClause rhs (a' :& b')
+         , rhs ~ (b, (a' :& b') -> SqlExpr Bool)
+         ) => DoInnerJoin NotLateral a rhs (a' :& b') where
+    doInnerJoin _ = innerJoin
+
+instance ( ToFrom a a'
+         , SqlSelect b r
+         , ToAlias b
+         , ToAliasReference b
+         , d ~ (a' :& b)
+         ) => DoInnerJoin Lateral a (a' -> SqlQuery b, d -> SqlExpr Bool) d where
+    doInnerJoin _ = innerJoinLateral
+
+instance ( DoInnerJoin lateral lhs rhs r, lateral ~ IsLateral rhs )
+           => ToFrom (InnerJoin lhs rhs) r where
+     toFrom (InnerJoin a b) = doInnerJoin (Proxy @lateral) a b
+
+class DoLeftJoin lateral lhs rhs res | lateral rhs lhs -> res where
+    doLeftJoin :: Proxy lateral -> lhs -> rhs -> From res
+
+instance ( ToFrom a a'
+         , ToFrom b b'
+         , ToMaybe b'
+         , ToMaybeT b' ~ mb
+         , HasOnClause rhs (a' :& mb)
+         , rhs ~ (b, (a' :& mb) -> SqlExpr Bool)
+         ) => DoLeftJoin NotLateral a rhs (a' :& mb) where
+    doLeftJoin _ = leftJoin
+
+instance ( ToFrom a a'
+         , ToMaybe b
+         , d ~ (a' :& ToMaybeT b)
+         , SqlSelect b r
+         , ToAlias b
+         , ToAliasReference b
+         ) => DoLeftJoin Lateral a (a' -> SqlQuery b, d -> SqlExpr Bool) d where
+    doLeftJoin _ = leftJoinLateral
+
+instance ( DoLeftJoin lateral lhs rhs r, lateral ~ IsLateral rhs )
+           => ToFrom (LeftOuterJoin lhs rhs) r where
+     toFrom (LeftOuterJoin a b) = doLeftJoin (Proxy @lateral) a b
+
+class DoCrossJoin lateral lhs rhs res | lateral lhs rhs -> res where
+    doCrossJoin :: Proxy lateral -> lhs -> rhs -> From res
+
+instance (ToFrom a a', ToFrom b b') => DoCrossJoin NotLateral a b (a' :& b') where
+    doCrossJoin _ = crossJoin
+instance (ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b)
+  => DoCrossJoin Lateral a (a' -> SqlQuery b) (a' :& b) where
+    doCrossJoin _ = crossJoinLateral
+
+instance (DoCrossJoin lateral lhs rhs r, IsLateral rhs ~ lateral)
+  => ToFrom (CrossJoin lhs rhs) r where
+    toFrom (CrossJoin a b) = doCrossJoin (Proxy @lateral) a b
+
+instance ( ToFrom a a'
+         , ToFrom b b'
+         , ToMaybe a'
+         , ToMaybeT a' ~ ma
+         , HasOnClause rhs (ma :& b')
+         , ErrorOnLateral b
+         , rhs ~ (b, (ma :& b') -> SqlExpr Bool)
+         ) => ToFrom (RightOuterJoin a rhs) (ma :& b') where
+    toFrom (RightOuterJoin a b) = rightJoin a b
+
+instance ( ToFrom a a'
+         , ToFrom b b'
+         , ToMaybe a'
+         , ToMaybeT a' ~ ma
+         , ToMaybe b'
+         , ToMaybeT b' ~ mb
+         , HasOnClause rhs (ma :& mb)
+         , ErrorOnLateral b
+         , rhs ~ (b, (ma :& mb) -> SqlExpr Bool)
+         ) => ToFrom (FullOuterJoin a rhs) (ma :& mb) where
+    toFrom (FullOuterJoin a b) = fullOuterJoin a b
+

src/Database/Esqueleto/Experimental/From/SqlSetOperation.hs

@@ -0,0 +1,131 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Database.Esqueleto.Experimental.From.SqlSetOperation
+        where
+
+import Control.Arrow (first)
+import Control.Monad.Trans.Class (lift)
+import qualified Control.Monad.Trans.State as S
+import qualified Control.Monad.Trans.Writer as W
+import qualified Data.Text.Lazy.Builder as TLB
+import Database.Esqueleto.Experimental.From
+import Database.Esqueleto.Experimental.ToAlias
+import Database.Esqueleto.Experimental.ToAliasReference
+import Database.Esqueleto.Internal.Internal hiding (From(..), from, on)
+import Database.Esqueleto.Internal.PersistentImport
+       (DBName(..), Entity, PersistEntity, PersistValue)
+
+-- | Data type used to implement the SqlSetOperation language
+-- this type is implemented in the same way as a @From@
+--
+-- Semantically a @SqlSetOperation@ is always a @From@ but not vice versa
+--
+-- /Since: 3.5.0.0/
+newtype SqlSetOperation a = SqlSetOperation
+    { unSqlSetOperation :: NeedParens -> SqlQuery (a, IdentInfo -> (TLB.Builder, [PersistValue]))}
+
+instance ToAliasReference a => ToFrom (SqlSetOperation a) a where
+    toFrom setOperation = From $ do
+        ident <- newIdentFor (DBName "u")
+        (a, fromClause) <- unSqlSetOperation setOperation Never
+        ref <- toAliasReference ident a
+        pure (ref, \_ info -> (first parens $ fromClause info) <> (" AS " <> useIdent info ident, mempty))
+
+-- | Type class to support direct use of @SqlQuery@ in a set operation tree
+--
+-- /Since: 3.5.0.0/
+class ToSqlSetOperation a r | a -> r where
+    toSqlSetOperation :: a -> SqlSetOperation r
+instance ToSqlSetOperation (SqlSetOperation a) a where
+    toSqlSetOperation = id
+instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToSqlSetOperation (SqlQuery a) a where
+    toSqlSetOperation subquery =
+        SqlSetOperation $ \p -> do
+            (ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ subquery
+            state <- Q $ lift S.get
+            aliasedValue <- toAlias ret
+            Q $ lift $ S.put state
+            let aliasedQuery = Q $ W.WriterT $ pure (aliasedValue, sideData)
+            let p' =
+                  case p of
+                    Parens -> Parens
+                    Never ->
+                      if (sdLimitClause sideData) /= mempty
+                          || length (sdOrderByClause sideData) > 0 then
+                        Parens
+                      else
+                        Never
+            pure (aliasedValue, \info -> first (parensM p') $ toRawSql SELECT info aliasedQuery)
+
+-- | Helper function for defining set operations
+-- /Since: 3.5.0.0/
+mkSetOperation :: (ToSqlSetOperation a a', ToSqlSetOperation b a')
+               => TLB.Builder -> a -> b -> SqlSetOperation a'
+mkSetOperation operation lhs rhs = SqlSetOperation $ \p -> do
+    (leftValue, leftClause) <- unSqlSetOperation (toSqlSetOperation lhs) p
+    (_, rightClause) <- unSqlSetOperation (toSqlSetOperation rhs) p
+    pure (leftValue, \info -> leftClause info <> (operation, mempty) <> rightClause info)
+
+{-# DEPRECATED Union "/Since: 3.4.0.0/ - Use the 'union_' function instead of the 'Union' data constructor" #-}
+data Union a b = a `Union` b
+instance ToSqlSetOperation a a' => ToSqlSetOperation (Union a a) a' where
+    toSqlSetOperation (Union a b) = union_ a b
+
+-- | Overloaded @union_@ function to support use in both 'SqlSetOperation'
+-- and 'withRecursive'
+--
+-- /Since: 3.5.0.0/
+class Union_ a where
+    -- | @UNION@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
+    union_ :: a
+
+instance (ToSqlSetOperation a c, ToSqlSetOperation b c, res ~ SqlSetOperation c)
+  => Union_ (a -> b -> res) where
+    union_ = mkSetOperation " UNION "
+
+-- | Overloaded @unionAll_@ function to support use in both 'SqlSetOperation'
+-- and 'withRecursive'
+--
+-- /Since: 3.5.0.0/
+class UnionAll_ a where
+    -- | @UNION@ @ALL@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
+    unionAll_ :: a
+instance (ToSqlSetOperation a c, ToSqlSetOperation b c, res ~ SqlSetOperation c)
+  => UnionAll_ (a -> b -> res) where
+    unionAll_ = mkSetOperation " UNION ALL "
+
+{-# DEPRECATED UnionAll "/Since: 3.4.0.0/ - Use the 'unionAll_' function instead of the 'UnionAll' data constructor" #-}
+data UnionAll a b = a `UnionAll` b
+instance ToSqlSetOperation a a' => ToSqlSetOperation (UnionAll a a) a' where
+    toSqlSetOperation (UnionAll a b) = unionAll_ a b
+
+{-# DEPRECATED Except "/Since: 3.4.0.0/ - Use the 'except_' function instead of the 'Except' data constructor" #-}
+data Except a b = a `Except` b
+instance ToSqlSetOperation a a' => ToSqlSetOperation (Except a a) a' where
+    toSqlSetOperation (Except a b) = except_ a b
+
+-- | @EXCEPT@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
+except_ :: (ToSqlSetOperation a a', ToSqlSetOperation b a') => a -> b -> SqlSetOperation a'
+except_ = mkSetOperation " 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
+instance ToSqlSetOperation a a' => ToSqlSetOperation (Intersect a a) a' where
+    toSqlSetOperation (Intersect a b) = intersect_ a b
+
+-- | @INTERSECT@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
+intersect_ :: (ToSqlSetOperation a a', ToSqlSetOperation b a') => a -> b -> SqlSetOperation a'
+intersect_ = mkSetOperation " INTERSECT "
+
+{-# DEPRECATED SelectQuery "/Since: 3.4.0.0/ - It is no longer necessary to tag 'SqlQuery' values with @SelectQuery@" #-}
+pattern SelectQuery a = a
+

src/Database/Esqueleto/Experimental/ToAlias.hs

@@ -0,0 +1,88 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Database.Esqueleto.Experimental.ToAlias
+    where
+
+import Database.Esqueleto.Internal.Internal hiding (From, from, on)
+import Database.Esqueleto.Internal.PersistentImport
+
+{-# DEPRECATED ToAliasT "This type alias doesn't do anything. Please delete it. Will be removed in the next release." #-}
+type ToAliasT a = a
+
+-- Tedious tuple magic
+class ToAlias a where
+    toAlias :: a -> SqlQuery a
+
+instance {-# OVERLAPPABLE #-} ToAlias (SqlExpr a) where
+    toAlias e@(ERaw m f)
+      | Just _ <- sqlExprMetaAlias m, not (sqlExprMetaIsReference m) = pure e
+      | otherwise = do
+            ident <- newIdentFor (DBName "v")
+            pure $ ERaw noMeta{sqlExprMetaAlias = Just ident} f
+
+instance ToAlias (SqlExpr (Entity a)) where
+    toAlias (ERaw m f) = do
+       ident <- newIdentFor (DBName "v")
+       pure $ ERaw m{sqlExprMetaIsReference = False, sqlExprMetaAlias = Just ident} f
+
+instance ToAlias (SqlExpr (Maybe (Entity a))) where
+    -- FIXME: Code duplication because the compiler doesnt like half final encoding
+    toAlias (ERaw m f) = do
+       ident <- newIdentFor (DBName "v")
+       pure $ ERaw m{sqlExprMetaIsReference = False, sqlExprMetaAlias = Just ident} f
+
+instance (ToAlias a, ToAlias b) => ToAlias (a,b) where
+    toAlias (a,b) = (,) <$> toAlias a <*> toAlias b
+
+instance ( ToAlias a
+         , ToAlias b
+         , ToAlias c
+         ) => ToAlias (a,b,c) where
+    toAlias x = to3 <$> (toAlias $ from3 x)
+
+instance ( ToAlias a
+         , ToAlias b
+         , ToAlias c
+         , ToAlias d
+         ) => ToAlias (a,b,c,d) where
+    toAlias x = to4 <$> (toAlias $ from4 x)
+
+instance ( ToAlias a
+         , ToAlias b
+         , ToAlias c
+         , ToAlias d
+         , ToAlias e
+         ) => ToAlias (a,b,c,d,e) where
+    toAlias x = to5 <$> (toAlias $ from5 x)
+
+instance ( ToAlias a
+         , ToAlias b
+         , ToAlias c
+         , ToAlias d
+         , ToAlias e
+         , ToAlias f
+         ) => ToAlias (a,b,c,d,e,f) where
+    toAlias x = to6 <$> (toAlias $ from6 x)
+
+instance ( ToAlias a
+         , ToAlias b
+         , ToAlias c
+         , ToAlias d
+         , ToAlias e
+         , ToAlias f
+         , ToAlias g
+         ) => ToAlias (a,b,c,d,e,f,g) where
+    toAlias x = to7 <$> (toAlias $ from7 x)
+
+instance ( ToAlias a
+         , ToAlias b
+         , ToAlias c
+         , ToAlias d
+         , ToAlias e
+         , ToAlias f
+         , ToAlias g
+         , ToAlias h
+         ) => ToAlias (a,b,c,d,e,f,g,h) where
+    toAlias x = to8 <$> (toAlias $ from8 x)

src/Database/Esqueleto/Experimental/ToAliasReference.hs

@@ -0,0 +1,90 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Database.Esqueleto.Experimental.ToAliasReference
+    where
+
+import Data.Coerce
+import Database.Esqueleto.Internal.Internal hiding (From, from, on)
+import Database.Esqueleto.Internal.PersistentImport
+
+{-# DEPRECATED ToAliasReferenceT "This type alias doesn't do anything. Please delete it. Will be removed in the next release." #-}
+type ToAliasReferenceT a = a
+
+-- more tedious tuple magic
+class ToAliasReference a where
+    toAliasReference :: Ident -> a -> SqlQuery a
+
+instance {-# OVERLAPPABLE #-} ToAliasReference (SqlExpr a) where
+    toAliasReference aliasSource (ERaw m _)
+      | Just alias <- sqlExprMetaAlias m = pure $ ERaw m{sqlExprMetaIsReference = True} $ \_ info ->
+          (useIdent info aliasSource <> "." <> useIdent info alias, [])
+    toAliasReference _ e = pure e
+
+instance ToAliasReference (SqlExpr (Entity a)) where
+    toAliasReference aliasSource (ERaw m _)
+      | Just _ <- sqlExprMetaAlias m, False <- sqlExprMetaIsReference m =
+          pure $ ERaw m{sqlExprMetaIsReference = True} $ \_ info ->
+            (useIdent info aliasSource, [])
+    toAliasReference _ e = pure e
+
+instance ToAliasReference (SqlExpr (Maybe (Entity a))) where
+    toAliasReference aliasSource e =
+        coerce <$> toAliasReference aliasSource (coerce e :: SqlExpr (Entity a))
+
+
+instance (ToAliasReference a, ToAliasReference b) => ToAliasReference (a, b) where
+    toAliasReference ident (a,b) = (,) <$> (toAliasReference ident a) <*> (toAliasReference ident b)
+
+instance ( ToAliasReference a
+         , ToAliasReference b
+         , ToAliasReference c
+         ) => ToAliasReference (a,b,c) where
+    toAliasReference ident x = fmap to3 $ toAliasReference ident $ from3 x
+
+instance ( ToAliasReference a
+         , ToAliasReference b
+         , ToAliasReference c
+         , ToAliasReference d
+         ) => ToAliasReference (a,b,c,d) where
+    toAliasReference ident x = fmap to4 $ toAliasReference ident $ from4 x
+
+instance ( ToAliasReference a
+         , ToAliasReference b
+         , ToAliasReference c
+         , ToAliasReference d
+         , ToAliasReference e
+         ) => ToAliasReference (a,b,c,d,e) where
+    toAliasReference ident x = fmap to5 $ toAliasReference ident $ from5 x
+
+instance ( ToAliasReference a
+         , ToAliasReference b
+         , ToAliasReference c
+         , ToAliasReference d
+         , ToAliasReference e
+         , ToAliasReference f
+         ) => ToAliasReference (a,b,c,d,e,f) where
+    toAliasReference ident x = to6 <$> (toAliasReference ident $ from6 x)
+
+instance ( ToAliasReference a
+         , ToAliasReference b
+         , ToAliasReference c
+         , ToAliasReference d
+         , ToAliasReference e
+         , ToAliasReference f
+         , ToAliasReference g
+         ) => ToAliasReference (a,b,c,d,e,f,g) where
+    toAliasReference ident x = to7 <$> (toAliasReference ident $ from7 x)
+
+instance ( ToAliasReference a
+         , ToAliasReference b
+         , ToAliasReference c
+         , ToAliasReference d
+         , ToAliasReference e
+         , ToAliasReference f
+         , ToAliasReference g
+         , ToAliasReference h
+         ) => ToAliasReference (a,b,c,d,e,f,g,h) where
+    toAliasReference ident x = to8 <$> (toAliasReference ident $ from8 x)
+

src/Database/Esqueleto/Experimental/ToMaybe.hs

@@ -0,0 +1,71 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Database.Esqueleto.Experimental.ToMaybe
+    where
+
+import Database.Esqueleto.Internal.Internal hiding (From(..), from, on)
+import Database.Esqueleto.Internal.PersistentImport (Entity(..))
+
+type family Nullable a where
+    Nullable (Maybe a) = a
+    Nullable a =  a
+
+class ToMaybe a where
+    type ToMaybeT a
+    toMaybe :: a -> ToMaybeT a
+
+
+instance ToMaybe (SqlExpr a) where
+    type ToMaybeT (SqlExpr a) = SqlExpr (Maybe (Nullable a))
+    toMaybe = veryUnsafeCoerceSqlExpr
+
+instance (ToMaybe a, ToMaybe b) => ToMaybe (a,b) where
+    type ToMaybeT (a, b) = (ToMaybeT a, ToMaybeT b)
+    toMaybe (a, b) = (toMaybe a, toMaybe b)
+
+instance ( ToMaybe a , ToMaybe b , ToMaybe c) => ToMaybe (a,b,c) where
+    type ToMaybeT (a, b, c) = (ToMaybeT a, ToMaybeT b, ToMaybeT c)
+    toMaybe = to3 . toMaybe . from3
+
+instance ( ToMaybe a , ToMaybe b , ToMaybe c , ToMaybe d) => ToMaybe (a,b,c,d) where
+    type ToMaybeT (a, b, c, d) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d)
+    toMaybe = to4 . toMaybe . from4
+
+instance ( ToMaybe a , ToMaybe b , ToMaybe c , ToMaybe d , ToMaybe e) => ToMaybe (a,b,c,d,e) where
+    type ToMaybeT (a, b, c, d, e) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d, ToMaybeT e)
+    toMaybe = to5 . toMaybe . from5
+
+instance ( ToMaybe a
+         , ToMaybe b
+         , ToMaybe c
+         , ToMaybe d
+         , ToMaybe e
+         , ToMaybe f
+         ) => ToMaybe (a,b,c,d,e,f) where
+    type ToMaybeT (a, b, c, d, e, f) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d, ToMaybeT e, ToMaybeT f)
+    toMaybe = to6 . toMaybe . from6
+
+instance ( ToMaybe a
+         , ToMaybe b
+         , ToMaybe c
+         , ToMaybe d
+         , ToMaybe e
+         , ToMaybe f
+         , ToMaybe g
+         ) => ToMaybe (a,b,c,d,e,f,g) where
+    type ToMaybeT (a, b, c, d, e, f, g) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d, ToMaybeT e, ToMaybeT f, ToMaybeT g)
+    toMaybe = to7 . toMaybe . from7
+
+instance ( ToMaybe a
+         , ToMaybe b
+         , ToMaybe c
+         , ToMaybe d
+         , ToMaybe e
+         , ToMaybe f
+         , ToMaybe g
+         , ToMaybe h
+         ) => ToMaybe (a,b,c,d,e,f,g,h) where
+     type ToMaybeT (a, b, c, d, e, f, g, h) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d, ToMaybeT e, ToMaybeT f, ToMaybeT g, ToMaybeT h)
+     toMaybe = to8 . toMaybe . from8
+

src/Database/Esqueleto/Experimental/WindowFunctions.hs

@@ -0,0 +1,270 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Database.Esqueleto.Experimental.WindowFunctions
+    where
+
+import Control.Arrow (first)
+import Data.Coerce (coerce)
+import Data.Int (Int64)
+import Data.Semigroup (First(..))
+import qualified Data.Text.Lazy.Builder as TLB
+import Database.Esqueleto.Experimental.Aggregates
+import Database.Esqueleto.Internal.Internal
+       ( IdentInfo
+       , NeedParens(..)
+       , OrderBy
+       , SideData(..)
+       , SomeValue(..)
+       , SqlExpr(..)
+       , SqlQuery(..)
+       , SqlSelect(..)
+       , ToSomeValues(..)
+       , Value(..)
+       , asc
+       , noMeta
+       , parens
+       , parensM
+       , select
+       , uncommas'
+       , unsafeSqlFunction
+       , val
+       , (?.)
+       , (^.)
+       )
+import Database.Esqueleto.Internal.PersistentImport
+       ( Entity
+       , EntityField
+       , PersistEntity
+       , PersistField
+       , PersistValue(..)
+       , SqlReadT
+       , fromPersistValue
+       )
+
+--( "LAG(?) OVER (PARTITION BY ?, ? ORDER BY ? ASC ROWS BETWEEN ? PRECEEDING AND UNBOUNDED FOLLOWING)"
+--, [PersistInt64 10,PersistInt64 10,PersistBool True,PersistInt64 10,PersistInt64 1]
+--)
+example =
+    lag_ (val @Int64 10) Nothing Nothing `over_`
+        (  partitionBy_ (val @Int64 10, val True)
+        <> frame_ (rows $ between (preceeding 1) unboundedFollowing)
+        <> orderBy_ [asc (val @Int64 10)]
+        )
+
+example2 = countRows_ @Int64 `over_` ()
+
+lag :: SqlExpr (Value a) -> WindowExpr a
+lag v = lag_ v Nothing Nothing
+
+lag_ :: SqlExpr a -> Maybe (SqlExpr Int64) -> Maybe (SqlExpr a) -> WindowExpr a
+lag_ v mOffset mDefaultVal =
+    coerce $
+    case (mOffset, mDefaultVal) of
+      (Just offset, Just defaultVal) ->
+          unsafeSqlFunction "LAG" (v, offset, defaultVal)
+      (Just offset, Nothing) ->
+          unsafeSqlFunction "LAG" (v, offset)
+      (Nothing, _) ->
+          unsafeSqlFunction "LAG" v
+
+-- Phantom helper type
+data PartitionBy
+data Window = Window
+    { windowPartitionBy :: Maybe (First (SqlExpr PartitionBy))
+    , windowOrderBy     :: Maybe [SqlExpr OrderBy]
+    , windowFrame       :: Maybe (First Frame)
+    }
+
+partitionBy_ :: ToSomeValues a => a -> Window
+partitionBy_ expr = mempty{windowPartitionBy = Just $ First $ ERaw noMeta $ \_ info ->
+    let (b, v) = uncommas' $ fmap (\(SomeValue (ERaw _ f)) -> f Never info) $ toSomeValues expr
+    in ("PARTITION BY " <> b, v)
+                          }
+
+orderBy_ :: [SqlExpr OrderBy] -> Window
+orderBy_ []    = mempty
+orderBy_ exprs = mempty{windowOrderBy=Just exprs}
+
+class RenderWindow a where
+    renderWindow :: IdentInfo -> a -> (TLB.Builder, [PersistValue])
+instance RenderWindow () where
+    renderWindow _ = mempty
+instance RenderWindow Window where
+    renderWindow info window =
+        let (partition, partitionVal) = maybe mempty ((\(ERaw _ f) -> f Never info) . getFirst) (windowPartitionBy window)
+            (order, orderVal) = maybe mempty (first ((<>) " ORDER BY ") . uncommas' . fmap (\(ERaw _ f) -> f Never info)) (windowOrderBy window)
+            (frame, frameVal) = maybe mempty (renderWindow info . getFirst) (windowFrame window)
+        in (partition <> order <> frame, partitionVal <> orderVal <> frameVal)
+
+instance Semigroup Window where
+    (Window a b c) <> (Window a' b' c') = Window (a <> a') (b <> b') (c <> c')
+
+instance Monoid Window where
+    mempty = Window mempty mempty mempty
+    mappend = (<>)
+
+data Frame = Frame (Maybe FrameKind) FrameBody (Maybe FrameExclusion)
+
+frame_ :: ToFrame frame => frame -> Window
+frame_ f = mempty{windowFrame = Just $ First $ toFrame f}
+
+instance RenderWindow Frame where
+    renderWindow info (Frame mKind frameBody mExclusion) =
+        let (kind, kindVals) = maybe mempty (renderWindow info) mKind
+            (exclusion, exclusionVals) = maybe mempty (renderWindow info) mExclusion
+            (body, bodyVals) = renderWindow info frameBody
+        in (" " <> kind <> body <> exclusion, kindVals <> bodyVals <> exclusionVals)
+
+class ToFrame a where
+    toFrame :: a -> Frame
+instance ToFrame Frame where
+    toFrame = id
+
+newtype FrameKind = FrameKind { unFrameKind :: (TLB.Builder, [PersistValue]) }
+
+instance RenderWindow FrameKind where
+    renderWindow _ = unFrameKind
+
+frameKind :: ToFrame frame => TLB.Builder -> frame -> Frame
+frameKind tlb frame =
+    let Frame _ b e = toFrame frame
+    in Frame (Just (FrameKind (tlb <> " ", []))) b e
+
+range :: ToFrame frame => frame -> Frame
+range = frameKind "RANGE"
+
+rows :: ToFrame frame => frame -> Frame
+rows = frameKind "ROWS"
+
+groups :: ToFrame frame => frame -> Frame
+groups = frameKind "GROUPS"
+
+newtype FrameExclusion = FrameExclusion { unFrameExclusion :: (TLB.Builder, [PersistValue]) }
+
+instance RenderWindow FrameExclusion where
+    renderWindow _ = unFrameExclusion
+
+frameExclusion :: ToFrame frame => TLB.Builder -> frame -> Frame
+frameExclusion tlb frame =
+    let Frame k b _ = toFrame frame
+    in Frame k b (Just $ FrameExclusion (" EXCLUDE " <> tlb, []))
+
+excludeCurrentRow :: ToFrame frame => frame -> Frame
+excludeCurrentRow = frameExclusion "CURRENT ROW"
+
+excludeGroup :: ToFrame frame => frame -> Frame
+excludeGroup = frameExclusion "GROUP"
+
+excludeTies :: ToFrame frame => frame -> Frame
+excludeTies = frameExclusion "TIES"
+
+excludeNoOthers :: ToFrame frame => frame -> Frame
+excludeNoOthers = frameExclusion "NO OTHERS"
+
+-- In order to prevent runtime errors we do some magic rewriting of queries that wouldn't be valid SQL.
+-- In the case of an implicit frame end `following 10` would become BETWEEN 10 FOLLOWING AND CURRENT ROW
+-- This is illegal so `following 10` instead becomes `BETWEEN CURRENT_ROW AND 10 FOLLOWING`
+-- Additionally `BETWEEN` requires that the frame start be before the frame end.
+-- To prevent this error the frame will be flipped automatically.
+-- i.e. `between (following 10) (preceeding 10)` becomes `BETWEEEN 10 PRECEEDING AND 10 FOLLOWING`
+-- therefore `between (following 10) (preceeding 10) === between (preceeding 10) (following 10)
+data FrameBody
+    = FrameStart FrameRange
+    | FrameBetween FrameRange FrameRange
+
+instance ToFrame FrameBody where
+    toFrame b = Frame Nothing b Nothing
+
+instance RenderWindow FrameBody where
+    renderWindow info (FrameStart (FrameRangeFollowing b)) = renderWindow info (FrameBetween FrameRangeCurrentRow (FrameRangeFollowing b))
+    renderWindow info (FrameStart f) = renderWindow info f
+    renderWindow info (FrameBetween startRange endRange)
+          | startRange > endRange = renderWindow info (FrameBetween endRange startRange)
+    renderWindow  info (FrameBetween r r') =
+        let (b, v) = renderWindow info r
+            (b', v') = renderWindow info r'
+        in ("BETWEEN " <> b <> " AND " <> b', v <> v')
+
+instance ToFrame FrameRange where
+    toFrame r = Frame Nothing (FrameStart r) Nothing
+instance RenderWindow FrameRange where
+    renderWindow _ (FrameRangeCurrentRow) = ("CURRENT ROW", [])
+    renderWindow _ (FrameRangePreceeding bounds) = renderBounds bounds <> (" PRECEEDING", [])
+    renderWindow _ (FrameRangeFollowing bounds) = renderBounds bounds <> (" FOLLOWING", [])
+
+renderBounds :: FrameRangeBound -> (TLB.Builder, [PersistValue])
+renderBounds (FrameRangeUnbounded) = ("UNBOUNDED", [])
+renderBounds (FrameRangeBounded i) = ("?", [PersistInt64 i])
+
+data FrameRange
+    = FrameRangePreceeding FrameRangeBound
+    | FrameRangeCurrentRow
+    | FrameRangeFollowing FrameRangeBound
+    deriving Eq
+
+instance Ord FrameRange where
+    FrameRangePreceeding b1 <= FrameRangePreceeding b2 = b1 <= b2
+    FrameRangePreceeding _  <= FrameRangeCurrentRow    = True
+    FrameRangePreceeding _  <= FrameRangeFollowing  _  = True
+    FrameRangeCurrentRow    <= FrameRangePreceeding _  = False
+    FrameRangeCurrentRow    <= FrameRangeCurrentRow    = True
+    FrameRangeCurrentRow    <= FrameRangeFollowing  _  = True
+    FrameRangeFollowing  _  <= FrameRangePreceeding _  = False
+    FrameRangeFollowing  _  <= FrameRangeCurrentRow    = False
+    FrameRangeFollowing  b1 <= FrameRangeFollowing  b2 = b1 <= b2
+
+data FrameRangeBound
+    = FrameRangeUnbounded
+    | FrameRangeBounded Int64
+    deriving Eq
+
+instance Ord FrameRangeBound where
+    FrameRangeUnbounded <= FrameRangeBounded _ = False
+    FrameRangeUnbounded <= FrameRangeUnbounded = True
+    FrameRangeBounded _ <= FrameRangeUnbounded = True
+    FrameRangeBounded a <= FrameRangeBounded b = a <= b
+
+between :: FrameRange -> FrameRange -> FrameBody
+between = FrameBetween
+
+unboundedPreceeding :: FrameRange
+unboundedPreceeding = FrameRangePreceeding FrameRangeUnbounded
+
+preceeding :: Int64 -> FrameRange
+preceeding offset = FrameRangePreceeding (FrameRangeBounded offset)
+
+following :: Int64 -> FrameRange
+following offset = FrameRangeFollowing (FrameRangeBounded offset)
+
+unboundedFollowing :: FrameRange
+unboundedFollowing = FrameRangeFollowing FrameRangeUnbounded
+
+currentRow :: FrameRange
+currentRow = FrameRangeCurrentRow
+
+data WindowAggregate
+class Over expr where
+    over_ :: RenderWindow window => expr a -> window -> SqlAggregate WindowAggregate a
+
+newtype WindowExpr a = WindowExpr { unsafeWindowExpr :: SqlExpr a }
+instance Over WindowExpr where
+    (WindowExpr (ERaw _ f)) `over_` window = SqlAggregate $ ERaw noMeta $ \p info ->
+        let (b, v) = f Never info
+            (w, vw) = renderWindow info window
+        in (parensM p $ b <> " OVER " <> parens w , v <> vw)
+
+-- Only universally quantified SqlAggregate's can be used
+-- TODO Add nicer type error
+data NoWindow
+deriving via WindowExpr instance (s ~ NoWindow) => Over (SqlAggregate s)

src/Database/Esqueleto/Internal/Language.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -17,7 +18,9 @@ module Database.Esqueleto.Internal.Language
     {-# DEPRECATED "Use Database.Esqueleto.Internal.Internal instead. This module will be removed in 3.5.0.0 " #-}
     ( -- * The pretty face
       from
-    , Value(..)
+    , Value
+    , pattern Value
+    , unValue
     , ValueList(..)
     , SomeValue(..)
     , ToSomeValues(..)

src/Database/Esqueleto/Internal/PersistentImport.hs

@@ -151,6 +151,7 @@ import Database.Persist.Sql hiding
        , delete
        , deleteCascadeWhere
        , deleteWhereCount
+       , exists
        , getPersistMap
        , limitOffsetOrder
        , listToJSON
@@ -174,5 +175,4 @@ import Database.Persist.Sql hiding
        , (>.)
        , (>=.)
        , (||.)
-       , exists
        )

src/Database/Esqueleto/Internal/Sql.hs

@@ -37,8 +37,8 @@ module Database.Esqueleto.Internal.Sql
       -- * The guts
     , unsafeSqlCase
     , unsafeSqlBinOp
-    , unsafeSqlBinOpComposite
     , unsafeSqlValue
+    , unsafeSqlEntity
     , unsafeSqlCastAs
     , unsafeSqlFunction
     , unsafeSqlExtractSubField

src/Database/Esqueleto/MySQL.hs

@@ -14,5 +14,5 @@ import Database.Esqueleto.Internal.PersistentImport
 -- because MySQL uses `rand()`.
 --
 -- /Since: 2.6.0/
-random_ :: (PersistField a, Num a) => SqlExpr (Value a)
+random_ :: (PersistField a, Num a) => SqlExpr a
 random_ = unsafeSqlValue "RAND()"

src/Database/Esqueleto/PostgreSQL.hs

@@ -52,18 +52,18 @@ import Database.Persist.Class (OnlyOneUniqueKey)
 -- because MySQL uses `rand()`.
 --
 -- @since 2.6.0
-random_ :: (PersistField a, Num a) => SqlExpr (Value a)
+random_ :: (PersistField a, Num a) => SqlExpr a
 random_ = unsafeSqlValue "RANDOM()"
 
 -- | Empty array literal. (@val []@) does unfortunately not work
-emptyArray :: SqlExpr (Value [a])
+emptyArray :: SqlExpr [a]
 emptyArray = unsafeSqlValue "'{}'"
 
 -- | Coalesce an array with an empty default value
 maybeArray ::
      (PersistField a, PersistField [a])
-  => SqlExpr (Value (Maybe [a]))
-  -> SqlExpr (Value [a])
+  => SqlExpr (Maybe [a])
+  -> SqlExpr [a]
 maybeArray x = coalesceDefault [x] (emptyArray)
 
 -- | Aggregate mode
@@ -82,19 +82,19 @@ unsafeSqlAggregateFunction
     -> AggMode
     -> a
     -> [OrderByClause]
-    -> SqlExpr (Value b)
-unsafeSqlAggregateFunction name mode args orderByClauses = ERaw Never $ \info ->
+    -> SqlExpr b
+unsafeSqlAggregateFunction name mode args orderByClauses = ERaw noMeta $ \_ info ->
     let (orderTLB, orderVals) = makeOrderByNoNewline info orderByClauses
         -- Don't add a space if we don't have order by clauses
         orderTLBSpace =
             case orderByClauses of
-                [] -> ""
+                []    -> ""
                 (_:_) -> " "
         (argsTLB, argsVals) =
-            uncommas' $ map (\(ERaw _ f) -> f info) $ toArgList args
+            uncommas' $ map (\(ERaw _ f) -> f Never info) $ toArgList args
         aggMode =
             case mode of
-                AggModeAll -> ""
+                AggModeAll      -> ""
                 -- ALL is the default, so we don't need to
                 -- specify it
                 AggModeDistinct -> "DISTINCT "
@@ -106,14 +106,14 @@ unsafeSqlAggregateFunction name mode args orderByClauses = ERaw Never $ \info ->
 --- into an array.
 arrayAggWith
     :: AggMode
-    -> SqlExpr (Value a)
+    -> SqlExpr a
     -> [OrderByClause]
-    -> SqlExpr (Value (Maybe [a]))
+    -> SqlExpr (Maybe [a])
 arrayAggWith = unsafeSqlAggregateFunction "array_agg"
 
 --- | (@array_agg@) Concatenate input values, including @NULL@s,
 --- into an array.
-arrayAgg :: (PersistField a) => SqlExpr (Value a) -> SqlExpr (Value (Maybe [a]))
+arrayAgg :: (PersistField a) => SqlExpr a -> SqlExpr (Maybe [a])
 arrayAgg x = arrayAggWith AggModeAll x []
 
 -- | (@array_agg@) Concatenate distinct input values, including @NULL@s, into
@@ -122,19 +122,19 @@ arrayAgg x = arrayAggWith AggModeAll x []
 -- @since 2.5.3
 arrayAggDistinct
     :: (PersistField a, PersistField [a])
-    => SqlExpr (Value a)
-    -> SqlExpr (Value (Maybe [a]))
+    => SqlExpr a
+    -> SqlExpr (Maybe [a])
 arrayAggDistinct x = arrayAggWith AggModeDistinct x []
 
 -- | (@array_remove@) Remove all elements equal to the given value from the
 -- array.
 --
 -- @since 2.5.3
-arrayRemove :: SqlExpr (Value [a]) -> SqlExpr (Value a) -> SqlExpr (Value [a])
+arrayRemove :: SqlExpr [a] -> SqlExpr a -> SqlExpr [a]
 arrayRemove arr elem' = unsafeSqlFunction "array_remove" (arr, elem')
 
 -- | Remove @NULL@ values from an array
-arrayRemoveNull :: SqlExpr (Value [Maybe a]) -> SqlExpr (Value [a])
+arrayRemoveNull :: SqlExpr [Maybe a] -> SqlExpr [a]
 -- This can't be a call to arrayRemove because it changes the value type
 arrayRemoveNull x = unsafeSqlFunction "array_remove" (x, unsafeSqlValue "NULL")
 
@@ -144,10 +144,10 @@ arrayRemoveNull x = unsafeSqlFunction "array_remove" (x, unsafeSqlValue "NULL")
 stringAggWith ::
      SqlString s
   => AggMode -- ^ Aggregate mode (ALL or DISTINCT)
-  -> SqlExpr (Value s) -- ^ Input values.
-  -> SqlExpr (Value s) -- ^ Delimiter.
+  -> SqlExpr s -- ^ Input values.
+  -> SqlExpr s -- ^ Delimiter.
   -> [OrderByClause] -- ^ ORDER BY clauses
-  -> SqlExpr (Value (Maybe s)) -- ^ Concatenation.
+  -> SqlExpr (Maybe s) -- ^ Concatenation.
 stringAggWith mode expr delim os =
   unsafeSqlAggregateFunction "string_agg" mode (expr, delim) os
 
@@ -157,19 +157,19 @@ stringAggWith mode expr delim os =
 -- @since 2.2.8
 stringAgg ::
      SqlString s
-  => SqlExpr (Value s) -- ^ Input values.
-  -> SqlExpr (Value s) -- ^ Delimiter.
-  -> SqlExpr (Value (Maybe s)) -- ^ Concatenation.
+  => SqlExpr s -- ^ Input values.
+  -> SqlExpr s -- ^ Delimiter.
+  -> SqlExpr (Maybe s) -- ^ Concatenation.
 stringAgg expr delim = stringAggWith AggModeAll expr delim []
 
 -- | (@chr@) Translate the given integer to a character. (Note the result will
 -- depend on the character set of your database.)
 --
 -- @since 2.2.11
-chr :: SqlString s => SqlExpr (Value Int) -> SqlExpr (Value s)
+chr :: SqlString s => SqlExpr Int -> SqlExpr s
 chr = unsafeSqlFunction "chr"
 
-now_ :: SqlExpr (Value UTCTime)
+now_ :: SqlExpr UTCTime
 now_ = unsafeSqlFunction "NOW" ()
 
 upsert
@@ -182,7 +182,7 @@ upsert
     )
     => record
     -- ^ new record to insert
-    -> [SqlExpr (Update record)]
+    -> [SqlExpr (Entity record) -> SqlExpr Update]
     -- ^ updates to perform if the record already exists
     -> R.ReaderT SqlBackend m (Entity record)
     -- ^ the record in the database after the operation
@@ -200,7 +200,7 @@ upsertBy
     -- ^ uniqueness constraint to find by
     -> record
     -- ^ new record to insert
-    -> [SqlExpr (Update record)]
+    -> [SqlExpr (Entity record) -> SqlExpr Update]
     -- ^ updates to perform if the record already exists
     -> R.ReaderT SqlBackend m (Entity record)
     -- ^ the record in the database after the operation
@@ -276,7 +276,7 @@ insertSelectWithConflict
     -- a unique "MyUnique 0", "MyUnique undefined" would work as well.
     -> SqlQuery (SqlExpr (Insertion val))
     -- ^ Insert query.
-    -> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Update val)])
+    -> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Entity val) -> SqlExpr Update])
     -- ^ A list of updates to be applied in case of the constraint being
     -- violated. The expression takes the current and excluded value to produce
     -- the updates.
@@ -292,22 +292,22 @@ insertSelectWithConflictCount
      . (FinalResult a, KnowResult a ~ Unique val, MonadIO m, PersistEntity val)
     => a
     -> SqlQuery (SqlExpr (Insertion val))
-    -> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Update val)])
+    -> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Entity val) -> SqlExpr Update])
     -> SqlWriteT m Int64
 insertSelectWithConflictCount unique query conflictQuery = do
     conn <- R.ask
     uncurry rawExecuteCount $
         combine
-            (toRawSql INSERT_INTO (conn, initialIdentState) (fmap EInsertFinal query))
+            (toRawSql INSERT_INTO (conn, initialIdentState) query)
             (conflict conn)
   where
     proxy :: Proxy val
     proxy = Proxy
     updates = conflictQuery entCurrent entExcluded
     combine (tlb1,vals1) (tlb2,vals2) = (builderToText (tlb1 `mappend` tlb2), vals1 ++ vals2)
-    entExcluded = EEntity $ I "excluded"
+    entExcluded = unsafeSqlEntity (I "excluded")
     tableName = unDBName . entityDB . entityDef
-    entCurrent = EEntity $ I (tableName proxy)
+    entCurrent = unsafeSqlEntity (I (tableName proxy))
     uniqueDef = toUniqueDef unique
     constraint = TLB.fromText . unDBName . uniqueDBName $ uniqueDef
     renderedUpdates :: (BackendCompatible SqlBackend backend) => backend -> (TLB.Builder, [PersistValue])
@@ -350,18 +350,16 @@ insertSelectWithConflictCount unique query conflictQuery = do
 --
 -- @since 3.3.3.3
 filterWhere
-    :: SqlExpr (Value a)
+    :: SqlExpr a
     -- ^ Aggregate function
-    -> SqlExpr (Value Bool)
+    -> SqlExpr Bool
     -- ^ Filter clause
-    -> SqlExpr (Value a)
-filterWhere aggExpr clauseExpr = ERaw Never $ \info ->
+    -> SqlExpr a
+filterWhere aggExpr clauseExpr = ERaw noMeta $ \_ info ->
     let (aggBuilder, aggValues) = case aggExpr of
-            ERaw _ aggF     -> aggF info
-            ECompositeKey _ -> throw $ CompositeKeyErr FilterWhereAggError
+            ERaw _ aggF     -> aggF Never info
         (clauseBuilder, clauseValues) = case clauseExpr of
-            ERaw _ clauseF  -> clauseF info
-            ECompositeKey _ -> throw $ CompositeKeyErr FilterWhereClauseError
+            ERaw _ clauseF  -> clauseF Never info
     in ( aggBuilder <> " FILTER (WHERE " <> clauseBuilder <> ")"
        , aggValues <> clauseValues
        )

src/Database/Esqueleto/PostgreSQL/JSON.hs

@@ -189,7 +189,7 @@ infixl 6 ||., -., --., #-.
 -- @
 --
 -- @since 3.1.0
-(->>.) :: JSONBExpr a -> JSONAccessor -> SqlExpr (Value (Maybe Text))
+(->>.) :: JSONBExpr a -> JSONAccessor -> SqlExpr (Maybe Text)
 (->>.) value (JSONKey txt) = unsafeSqlBinOp " ->> " value $ val txt
 (->>.) value (JSONIndex i) = unsafeSqlBinOp " ->> " value $ val i
 
@@ -253,7 +253,7 @@ infixl 6 ||., -., --., #-.
 -- @
 --
 -- @since 3.1.0
-(#>>.) :: JSONBExpr a -> [Text] -> SqlExpr (Value (Maybe Text))
+(#>>.) :: JSONBExpr a -> [Text] -> SqlExpr (Maybe Text)
 (#>>.)  value = unsafeSqlBinOp " #>> " value . mkTextArray
 
 -- | /Requires PostgreSQL version >= 9.4/
@@ -275,7 +275,7 @@ infixl 6 ||., -., --., #-.
 -- @
 --
 -- @since 3.1.0
-(@>.) :: JSONBExpr a -> JSONBExpr b -> SqlExpr (Value Bool)
+(@>.) :: JSONBExpr a -> JSONBExpr b -> SqlExpr Bool
 (@>.) = unsafeSqlBinOp " @> "
 
 -- | /Requires PostgreSQL version >= 9.4/
@@ -297,7 +297,7 @@ infixl 6 ||., -., --., #-.
 -- @
 --
 -- @since 3.1.0
-(<@.) :: JSONBExpr a -> JSONBExpr b -> SqlExpr (Value Bool)
+(<@.) :: JSONBExpr a -> JSONBExpr b -> SqlExpr Bool
 (<@.) = unsafeSqlBinOp " <@ "
 
 -- | /Requires PostgreSQL version >= 9.4/
@@ -320,7 +320,7 @@ infixl 6 ||., -., --., #-.
 -- @
 --
 -- @since 3.1.0
-(?.) :: JSONBExpr a -> Text -> SqlExpr (Value Bool)
+(?.) :: JSONBExpr a -> Text -> SqlExpr Bool
 (?.) value = unsafeSqlBinOp " ?? " value . val
 
 -- | /Requires PostgreSQL version >= 9.4/
@@ -343,7 +343,7 @@ infixl 6 ||., -., --., #-.
 -- @
 --
 -- @since 3.1.0
-(?|.) :: JSONBExpr a -> [Text] -> SqlExpr (Value Bool)
+(?|.) :: JSONBExpr a -> [Text] -> SqlExpr Bool
 (?|.) value = unsafeSqlBinOp " ??| " value . mkTextArray
 
 -- | /Requires PostgreSQL version >= 9.4/
@@ -366,7 +366,7 @@ infixl 6 ||., -., --., #-.
 -- @
 --
 -- @since 3.1.0
-(?&.) :: JSONBExpr a -> [Text] -> SqlExpr (Value Bool)
+(?&.) :: JSONBExpr a -> [Text] -> SqlExpr Bool
 (?&.) value = unsafeSqlBinOp " ??& " value . mkTextArray
 
 -- | /Requires PostgreSQL version >= 9.5/
@@ -579,5 +579,5 @@ infixl 6 ||., -., --., #-.
 (#-.) :: JSONBExpr a -> [Text] -> JSONBExpr b
 (#-.) value = unsafeSqlBinOp " #- " value . mkTextArray
 
-mkTextArray :: [Text] -> SqlExpr (Value PersistValue)
+mkTextArray :: [Text] -> SqlExpr PersistValue
 mkTextArray = val . PersistArray . fmap toPersistValue

src/Database/Esqueleto/PostgreSQL/JSON/Instances.hs

@@ -2,13 +2,13 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# language DerivingStrategies #-}
 
 module Database.Esqueleto.PostgreSQL.JSON.Instances where
 
-import Data.Aeson (FromJSON(..), ToJSON(..), encode, eitherDecodeStrict)
+import Data.Aeson (FromJSON(..), ToJSON(..), eitherDecodeStrict, encode)
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Lazy as BSL (toStrict)
 import Data.String (IsString(..))
@@ -42,7 +42,7 @@ newtype JSONB a = JSONB { unJSONB :: a }
 -- | 'SqlExpr' of a NULL-able 'JSONB' value. Hence the 'Maybe'.
 --
 -- Note: NULL here is a PostgreSQL NULL, not a JSON 'null'
-type JSONBExpr a = SqlExpr (Value (Maybe (JSONB a)))
+type JSONBExpr a = SqlExpr (Maybe (JSONB a))
 
 -- | Convenience function to lift a regular value into
 -- a 'JSONB' expression.

src/Database/Esqueleto/SQLite.hs

@@ -14,5 +14,5 @@ import Database.Esqueleto.Internal.PersistentImport
 -- because MySQL uses `rand()`.
 --
 -- /Since: 2.6.0/
-random_ :: (PersistField a, Num a) => SqlExpr (Value a)
+random_ :: (PersistField a, Num a) => SqlExpr a
 random_ = unsafeSqlValue "RANDOM()"

test/Common/Test.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE EmptyDataDecls #-}
@@ -22,6 +22,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 {-# OPTIONS_GHC -fno-warn-unused-binds #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 module Common.Test
     ( tests
@@ -77,8 +78,9 @@ import qualified Data.Attoparsec.Text as AP
 import Data.Char (toLower, toUpper)
 import Data.Monoid ((<>))
 import Database.Esqueleto
-import Database.Esqueleto.Experimental hiding (from, on)
-import qualified Database.Esqueleto.Experimental as Experimental
+import Database.Esqueleto.Experimental hiding
+       (countRows_, from, groupBy, on, sum_, (?.), (^.))
+import qualified Database.Esqueleto.Experimental as EX
 import Database.Persist.TH
 import Test.Hspec
 import UnliftIO
@@ -385,7 +387,7 @@ testSubSelect run = do
                     v `shouldBe` [Value 1]
 
     describe "subSelectList" $ do
-        it "is safe on empty databases as well as good databases" $ do
+        it "is safe on empty databases as well as good databases" $ run $ do
             let query =
                     from $ \n -> do
                     where_ $ n ^. NumbersInt `in_` do
@@ -394,16 +396,15 @@ testSubSelect run = do
                             where_ $ n' ^. NumbersInt >=. val 3
                             pure (n' ^. NumbersInt)
                     pure n
+            empty <- select query
 
-            empty <- run $ do
-                select query
-
-            full <- run $ do
+            full <- do
                 setup
                 select query
 
-            empty `shouldBe` []
-            full `shouldSatisfy` (not . null)
+            liftIO $ do
+                empty `shouldBe` []
+                full `shouldSatisfy` (not . null)
 
     describe "subSelectMaybe" $ do
         it "is equivalent to joinV . subSelect" $ do
@@ -455,10 +456,10 @@ testSubSelect run = do
             eres <- try $ run $ do
                 setup
                 bad <- select $
-                    from $ \n -> do
+                    from $ \(n :: SqlExpr (Entity Numbers)) -> do
                     pure $ (,) (n ^. NumbersInt) $
                         subSelectUnsafe $
-                        from $ \n' -> do
+                        from $ \(n' :: SqlExpr (Entity Numbers)) -> do
                         pure (just (n' ^. NumbersDouble))
                 good <- select $
                     from $ \n -> do
@@ -481,10 +482,10 @@ testSubSelect run = do
             eres <- try $ run $ do
                 setup
                 select $
-                    from $ \n -> do
+                    from $ \(n :: SqlExpr (Entity Numbers)) -> do
                     pure $ (,) (n ^. NumbersInt) $
                         subSelectUnsafe $
-                        from $ \n' -> do
+                        from $ \(n' :: SqlExpr (Entity Numbers)) -> do
                         where_ $ val False
                         pure (n' ^. NumbersDouble)
             case eres of
@@ -498,16 +499,14 @@ testSelectSource run = do
     describe "selectSource" $ do
         it "works for a simple example" $ run $ do
             let query = selectSource $
-                        from $ \person ->
-                        return person
+                        EX.from $ Table @Person
             p1e <- insert' p1
             ret <- runConduit $ query .| CL.consume
             liftIO $ ret `shouldBe` [ p1e ]
 
         it "can run a query many times" $ run $ do
             let query = selectSource $
-                        from $ \person ->
-                        return person
+                        EX.from $ Table @Person
             p1e <- insert' p1
             ret0 <- runConduit $ query .| CL.consume
             ret1 <- runConduit $ query .| CL.consume
@@ -536,17 +535,16 @@ testSelectFrom run = do
     describe "select/from" $ do
         it "works for a simple example" $ run $ do
             p1e <- insert' p1
-            ret <-
-                select $
-                from $ \person ->
-                return person
+            ret <- select $ EX.from $ Table @Person
             liftIO $ ret `shouldBe` [ p1e ]
 
         it "works for a simple self-join (one entity)" $ run $ do
             p1e <- insert' p1
             ret <-
-                select $
-                from $ \(person1, person2) ->
+                select $ do
+                person1 :& person2 <-
+                    EX.from $ Table @Person
+                    `crossJoin` Table @Person
                 return (person1, person2)
             liftIO $ ret `shouldBe` [ (p1e, p1e) ]
 
@@ -554,8 +552,10 @@ testSelectFrom run = do
             p1e <- insert' p1
             p2e <- insert' p2
             ret <-
-                select $
-                from $ \(person1, person2) ->
+                select $ do
+                person1 :& person2 <-
+                    EX.from $ Table @Person
+                    `crossJoin` Table @Person
                 return (person1, person2)
             liftIO $
                 ret
@@ -670,7 +670,7 @@ testSelectFrom run = do
                 number = 101
                 Right thePk = keyFromValues [toPersistValue number]
             fcPk <- insert fc
-            [Entity _ ret] <- select $ from return
+            [Entity _ ret] <- select $ EX.from $ Table @Frontcover
             liftIO $ do
                 ret `shouldBe` fc
                 fcPk `shouldBe` thePk
@@ -877,9 +877,9 @@ testSelectSubQuery run = describe "select subquery" $ do
     it "works" $ run $ do
         _ <- insert' p1
         let q = do
-                p <- Experimental.from $ Table @Person
+                p <- EX.from $ Table @Person
                 return ( p ^. PersonName, p ^. PersonAge)
-        ret <- select $ Experimental.from q
+        ret <- select $ EX.from q
         liftIO $ ret `shouldBe` [ (Value $ personName p1, Value $ personAge p1) ]
 
     it "supports sub-selecting Maybe entities" $ run $ do
@@ -888,12 +888,14 @@ 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 $ do
-          (lords :& deeds) <-
-              Experimental.from $ Table @Lord
-              `LeftOuterJoin` Table @Deed
-              `Experimental.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId)
-          pure (lords, deeds)
+        let q = EX.from $ do
+                  (lords :& deeds) <-
+                      EX.from $ Table @Lord
+                      `LeftOuterJoin` Table @Deed
+                      `EX.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId)
+                  pure (lords, deeds)
+
+        ret <- select q
         liftIO $ ret `shouldMatchList` ((l3e, Nothing) : l1WithDeeds)
 
     it "lets you order by alias" $ run $ do
@@ -901,8 +903,8 @@ testSelectSubQuery run = describe "select subquery" $ do
         _ <- insert' p3
         let q = do
                 (name, age) <-
-                  Experimental.from $ SubQuery $ do
-                      p <- Experimental.from $ Table @Person
+                  EX.from $ SubQuery $ do
+                      p <- EX.from $ Table @Person
                       return ( p ^. PersonName, p ^. PersonAge)
                 orderBy [ asc age ]
                 pure name
@@ -916,13 +918,13 @@ 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
+                (lord :& deed) <- EX.from $ Table @Lord
                                         `InnerJoin` Table @Deed
-                                  `Experimental.on` (\(lord :& deed) ->
+                                  `EX.on` (\(lord :& deed) ->
                                                        lord ^. LordId ==. deed ^. DeedOwnerId)
                 return (lord ^. LordId, deed ^. DeedId)
             q' = do
-                 (lordId, deedId) <- Experimental.from $ SubQuery q
+                 (lordId, deedId) <- EX.from $ SubQuery q
                  groupBy (lordId)
                  return (lordId, count deedId)
         (ret :: [(Value (Key Lord), Value Int)]) <- select q'
@@ -937,15 +939,15 @@ 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
+                (lord :& deed) <- EX.from $ Table @Lord
                                         `InnerJoin` Table @Deed
-                                  `Experimental.on` (\(lord :& deed) ->
+                                  `EX.on` (\(lord :& deed) ->
                                                       lord ^. LordId ==. deed ^. DeedOwnerId)
-                groupBy (lord ^. LordId)
+                groupBy (lord)
                 return (lord ^. LordId, count (deed ^. DeedId))
 
         (ret :: [(Value Int)]) <- select $ do
-                 (lordId, deedCount) <- Experimental.from $ SubQuery q
+                 (lordId, deedCount) <- EX.from $ SubQuery q
                  where_ $ deedCount >. val (3 :: Int)
                  return (count lordId)
 
@@ -958,9 +960,9 @@ 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` (Experimental.from $ Table @Deed)
-                        `Experimental.on` (\(lord :& deed) ->
+                (lord :& deed) <- EX.from $ Table @Lord
+                        `InnerJoin` (EX.from $ Table @Deed)
+                        `EX.on` (\(lord :& deed) ->
                                              lord ^. LordId ==. deed ^. DeedOwnerId)
                 groupBy (lord ^. LordId)
                 return (lord ^. LordId, count (deed ^. DeedId))
@@ -972,11 +974,11 @@ testSelectSubQuery run = describe "select subquery" $ do
         l1k <- insert l1
         l3k <- insert l3
         let q = do
-                (lord :& (_, dogCounts)) <- Experimental.from $ Table @Lord
+                (lord :& (_, dogCounts)) <- EX.from $ Table @Lord
                         `LeftOuterJoin` do
-                            lord <- Experimental.from $ Table @Lord
+                            lord <- EX.from $ Table @Lord
                             pure (lord ^. LordId, lord ^. LordDogs)
-                        `Experimental.on` (\(lord :& (lordId, _)) ->
+                        `EX.on` (\(lord :& (lordId, _)) ->
                                              just (lord ^. LordId) ==. lordId)
                 groupBy (lord ^. LordId, dogCounts)
                 return (lord ^. LordId, dogCounts)
@@ -986,19 +988,19 @@ testSelectSubQuery run = describe "select subquery" $ do
     it "unions" $ run $ do
           _ <- insert p1
           _ <- insert p2
-          let q = Experimental.from $
+          let q = EX.from $
                   (do
-                    p <- Experimental.from $ Table @Person
+                    p <- EX.from $ Table @Person
                     where_ $ not_ $ isNothing $ p ^. PersonAge
                     return (p ^. PersonName))
                   `union_`
                   (do
-                    p <- Experimental.from $ Table @Person
+                    p <- EX.from $ Table @Person
                     where_ $ isNothing $ p ^. PersonAge
                     return (p ^. PersonName))
                   `union_`
                   (do
-                    p <- Experimental.from $ Table @Person
+                    p <- EX.from $ Table @Person
                     where_ $ isNothing $ p ^. PersonAge
                     return (p ^. PersonName))
           names <- select q
@@ -1078,17 +1080,6 @@ testSelectWhere run = describe "select where_" $ do
                         ( val $ PointKey 1 2
                         , val $ PointKey 5 6 )
                 liftIO $ ret `shouldBe` [()]
-            it "works when using ECompositeKey constructor" $ run $ do
-                insert_ $ Point 1 2 ""
-                ret <-
-                  select $
-                  from $ \p -> do
-                  where_ $
-                    p ^. PointId
-                      `between`
-                        ( EI.ECompositeKey $ const ["3", "4"]
-                        , EI.ECompositeKey $ const ["5", "6"] )
-                liftIO $ ret `shouldBe` []
 
     it "works with avg_" $ run $ do
         _ <- insert' p1
@@ -1851,9 +1842,10 @@ testRenderSql run = do
       (c, expr) <- run $ do
         conn <- ask
         let Right c = P.mkEscapeChar conn
+        let user = EI.unsafeSqlEntity (EI.I "user")
+            blogPost = EI.unsafeSqlEntity (EI.I "blog_post")
         pure $ (,) c $ EI.renderExpr conn $
-          EI.EEntity (EI.I "user") ^. PersonId
-          ==. EI.EEntity (EI.I "blog_post") ^. BlogPostAuthorId
+          user ^. PersonId ==. blogPost ^. BlogPostAuthorId
       expr
         `shouldBe`
           Text.intercalate (Text.singleton c) ["", "user", ".", "id", ""]
@@ -1865,23 +1857,6 @@ testRenderSql run = do
       expr <- run $ ask >>= \c -> pure $ EI.renderExpr c (val (PersonKey 0) ==. val (PersonKey 1))
       expr `shouldBe` "? = ?"
 
-  describe "EEntity Ident behavior" $ do
-      let render :: SqlExpr (Entity val) -> Text.Text
-          render (EI.EEntity (EI.I ident)) = ident
-          render _ = error "guess we gotta handle this in the test suite now"
-      it "renders sensibly" $ run $ do
-          _ <- insert $ Foo 2
-          _ <- insert $ Foo 3
-          _ <- insert $ Person "hello" Nothing Nothing 3
-          results <- select $
-              from $ \(a `LeftOuterJoin` b) -> do
-              on $ a ^. FooName ==. b ^. PersonFavNum
-              pure (val (render a), val (render b))
-          liftIO $
-              head results
-              `shouldBe`
-              (Value "Foo", Value "Person")
-
   describe "ExprParser" $ do
     let parse parser = AP.parseOnly (parser '#')
     describe "parseEscapedChars" $ do
@@ -2373,7 +2348,7 @@ testExperimentalFrom run = do
         _   <- insert' p2
         p3e <- insert' p3
         peopleWithAges <- select $ do
-          people <- Experimental.from $ Table @Person
+          people <- EX.from $ Table @Person
           where_ $ not_ $ isNothing $ people ^. PersonAge
           return people
         liftIO $ peopleWithAges `shouldMatchList` [p1e, p3e]
@@ -2386,9 +2361,9 @@ testExperimentalFrom run = do
         d2e <- insert' $ Deed "2" (entityKey l1e)
         lordDeeds <- select $ do
           (lords :& deeds) <-
-            Experimental.from $ Table @Lord
+            EX.from $ Table @Lord
                     `InnerJoin` Table @Deed
-              `Experimental.on` (\(l :& d) -> l ^. LordId ==. d ^. DeedOwnerId)
+              `EX.on` (\(l :& d) -> l ^. LordId ==. d ^. DeedOwnerId)
           pure (lords, deeds)
         liftIO $ lordDeeds `shouldMatchList` [ (l1e, d1e)
                                              , (l1e, d2e)
@@ -2402,9 +2377,9 @@ testExperimentalFrom run = do
         d2e <- insert' $ Deed "2" (entityKey l1e)
         lordDeeds <- select $ do
           (lords :& deeds) <-
-            Experimental.from $ Table @Lord
+            EX.from $ Table @Lord
                 `LeftOuterJoin` Table @Deed
-                  `Experimental.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId)
+                  `EX.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId)
 
           pure (lords, deeds)
         liftIO $ lordDeeds `shouldMatchList` [ (l1e, Just d1e)
@@ -2416,8 +2391,8 @@ testExperimentalFrom run = do
         insert_ l1
         insert_ l2
         insert_ l3
-        delete $ void $ Experimental.from $ Table @Lord
-        lords <- select $ Experimental.from $ Table @Lord
+        delete $ void $ EX.from $ Table @Lord
+        lords <- select $ EX.from $ Table @Lord
         liftIO $ lords `shouldMatchList` []
 
     it "supports implicit cross joins" $ do
@@ -2425,11 +2400,11 @@ testExperimentalFrom run = do
         l1e <- insert' l1
         l2e <- insert' l2
         ret <- select $ do
-          lords1 <- Experimental.from $ Table @Lord
-          lords2 <- Experimental.from $ Table @Lord
+          lords1 <- EX.from $ Table @Lord
+          lords2 <- EX.from $ Table @Lord
           pure (lords1, lords2)
         ret2 <- select $ do
-          (lords1 :& lords2) <- Experimental.from $ Table @Lord `CrossJoin` Table @Lord
+          (lords1 :& lords2) <- EX.from $ Table @Lord `CrossJoin` Table @Lord
           pure (lords1,lords2)
         liftIO $ ret `shouldMatchList` ret2
         liftIO $ ret `shouldMatchList` [ (l1e, l1e)
@@ -2443,12 +2418,12 @@ testExperimentalFrom run = do
       run $ void $ do
         let q = do
               (persons :& profiles :& posts) <-
-                Experimental.from $  Table @Person
+                EX.from $  Table @Person
                          `InnerJoin` Table @Profile
-                   `Experimental.on` (\(people :& profiles) ->
+                   `EX.on` (\(people :& profiles) ->
                                         people ^. PersonId ==. profiles ^. ProfilePerson)
                      `LeftOuterJoin` Table @BlogPost
-                   `Experimental.on` (\(people :& _ :& posts) ->
+                   `EX.on` (\(people :& _ :& posts) ->
                                         just (people ^. PersonId) ==. posts ?. BlogPostAuthorId)
               pure (persons, posts, profiles)
         --error . show =<< renderQuerySelect q
@@ -2460,7 +2435,7 @@ testExperimentalFrom run = do
         insert_ p3
         -- Pretend this isnt all posts
         upperNames <- select $ do
-          author <- Experimental.from $ SelectQuery $ Experimental.from $ Table @Person
+          author <- EX.from $ SelectQuery $ EX.from $ Table @Person
           pure $ upper_ $ author ^. PersonName
 
         liftIO $ upperNames `shouldMatchList` [ Value "JOHN"

test/MySQL/Test.hs

@@ -1,27 +1,28 @@
-{-# LANGUAGE ScopedTypeVariables
-           , FlexibleContexts
-           , RankNTypes
-           , TypeFamilies
-           , TypeApplications
-#-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Main (main) where
 
 import Control.Monad (void)
 import Control.Monad.IO.Class (MonadIO(liftIO))
-import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT)
+import Control.Monad.Logger (runNoLoggingT, runStderrLoggingT)
 import Control.Monad.Trans.Reader (ReaderT)
-import Database.Persist.MySQL ( withMySQLConn
-                              , connectHost
-                              , connectDatabase
-                              , connectUser
-                              , connectPassword
-                              , connectPort
-                              , defaultConnectInfo)
+import qualified Control.Monad.Trans.Resource as R
 import Database.Esqueleto
 import Database.Esqueleto.Experimental hiding (from, on)
 import qualified Database.Esqueleto.Experimental as Experimental
-import qualified Control.Monad.Trans.Resource as R
+import Database.Persist.MySQL
+       ( connectDatabase
+       , connectHost
+       , connectPassword
+       , connectPort
+       , connectUser
+       , defaultConnectInfo
+       , withMySQLConn
+       )
 import Test.Hspec
 
 import Common.Test
@@ -187,7 +188,7 @@ testMysqlUnionWithLimits = do
               pure $ foo ^. FooName
 
 
-        ret <- select $ Experimental.from $ SelectQuery q1 `Union` SelectQuery q2
+        ret <- select $ Experimental.from $ q1 `union_` q2
         liftIO $ ret `shouldMatchList` [Value 1, Value 2, Value 4, Value 5]
 
 

test/PostgreSQL/Test.hs

@@ -1,53 +1,55 @@
 {-# OPTIONS_GHC -fno-warn-unused-binds  #-}
-{-# LANGUAGE FlexibleContexts
-           , LambdaCase
-           , NamedFieldPuns
-           , OverloadedStrings
-           , RankNTypes
-           , ScopedTypeVariables
-           , TypeApplications
-           , TypeFamilies
-           , PartialTypeSignatures
- #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE NamedFieldPuns        #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeFamilies          #-}
 module Main (main) where
 
-import Data.Coerce
-import Data.Foldable
-import qualified Data.Map.Strict as Map
-import Data.Map (Map)
-import Data.Time
-import Control.Arrow ((&&&))
-import Control.Monad (void, when)
-import Control.Monad.Catch (MonadCatch, catch)
-import Control.Monad.IO.Class (MonadIO(liftIO))
-import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT)
-import Control.Monad.Trans.Reader (ReaderT, ask)
-import qualified Control.Monad.Trans.Resource as R
-import Data.Aeson hiding (Value)
-import qualified Data.Aeson as A (Value)
-import Data.ByteString (ByteString)
-import qualified Data.Char as Char
-import qualified Data.List as L
-import Data.Ord (comparing)
-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
-import Database.Esqueleto.PostgreSQL.JSON hiding ((?.), (-.), (||.))
+import           Control.Arrow                      ((&&&))
+import           Control.Monad                      (void, when)
+import           Control.Monad.Catch                (MonadCatch, catch)
+import           Control.Monad.IO.Class             (MonadIO (liftIO))
+import           Control.Monad.Logger               (runNoLoggingT,
+                                                     runStderrLoggingT)
+import           Control.Monad.Trans.Reader         (ReaderT, ask)
+import qualified Control.Monad.Trans.Resource       as R
+import           Data.Aeson                         hiding (Value)
+import qualified Data.Aeson                         as A (Value)
+import           Data.ByteString                    (ByteString)
+import qualified Data.Char                          as Char
+import           Data.Coerce
+import           Data.Foldable
+import qualified Data.List                          as L
+import           Data.Map                           (Map)
+import qualified Data.Map.Strict                    as Map
+import           Data.Ord                           (comparing)
+import qualified Data.Text                          as T
+import qualified Data.Text.Encoding                 as TE
+import           Data.Time
+import           Data.Time.Clock                    (UTCTime, diffUTCTime,
+                                                     getCurrentTime)
+import           Database.Esqueleto                 hiding (random_)
+import           Database.Esqueleto.Experimental    hiding (from, on, random_)
+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
+import           Database.Esqueleto.PostgreSQL.JSON hiding ((-.), (?.), (||.))
 import qualified Database.Esqueleto.PostgreSQL.JSON as JSON
-import Database.Persist.Postgresql (withPostgresqlConn)
-import Database.PostgreSQL.Simple (SqlError(..), ExecStatus(..))
-import System.Environment
-import Test.Hspec
-import Test.Hspec.QuickCheck
+import           Database.Persist.Postgresql        (withPostgresqlConn)
+import           Database.PostgreSQL.Simple         (ExecStatus (..),
+                                                     SqlError (..))
+import           System.Environment
+import           Test.Hspec
+import           Test.Hspec.QuickCheck
 
-import Common.Test
-import PostgreSQL.MigrateJSON
+import           Common.Test
+import           PostgreSQL.MigrateJSON
 
 
 
@@ -1051,12 +1053,12 @@ testInsertSelectWithConflict =
           from $ \p -> return $ OneUnique <# val "test" <&> (p ^. PersonFavNum)
         )
         (\current excluded -> [])
-      uniques1 <- select $ from $ \u -> return u
+      uniques1 <- select $ Experimental.from $ table @OneUnique
       n2 <- EP.insertSelectWithConflictCount UniqueValue (
           from $ \p -> return $ OneUnique <# val "test" <&> (p ^. PersonFavNum)
         )
         (\current excluded -> [])
-      uniques2 <- select $ from $ \u -> return u
+      uniques2 <- select $ Experimental.from $ table @OneUnique
       liftIO $ n1 `shouldBe` 3
       liftIO $ n2 `shouldBe` 0
       let test = map (OneUnique "test" . personFavNum) [p1,p2,p3]
@@ -1071,12 +1073,12 @@ testInsertSelectWithConflict =
             from $ \p -> return $ OneUnique <# val "test" <&> (p ^. PersonFavNum)
           )
           (\current excluded -> [OneUniqueValue =. val 4 +. (current ^. OneUniqueValue) +. (excluded ^. OneUniqueValue)])
-        uniques1 <- select $ from $ \u -> return u
+        uniques1 <- select $ Experimental.from $ table @OneUnique
         n2 <- EP.insertSelectWithConflictCount UniqueValue (
             from $ \p -> return $ OneUnique <# val "test" <&> (p ^. PersonFavNum)
           )
           (\current excluded -> [OneUniqueValue =. val 4 +. (current ^. OneUniqueValue) +. (excluded ^. OneUniqueValue)])
-        uniques2 <- select $ from $ \u -> return u
+        uniques2 <- select $ Experimental.from $ table @OneUnique
         liftIO $ n1 `shouldBe` 3
         liftIO $ n2 `shouldBe` 3
         let test = map (OneUnique "test" . personFavNum) [p1,p2,p3]
@@ -1226,7 +1228,7 @@ testLateralQuery = do
         select $ do
             l :& c <-
               Experimental.from $ Table @Lord
-              `CrossJoin` \lord -> do
+              `crossJoinLateral` \lord -> do
                     deed <- Experimental.from $ Table @Deed
                     where_ $ lord ^. LordId ==. deed ^. DeedOwnerId
                     pure $ countRows @Int
@@ -1241,7 +1243,7 @@ testLateralQuery = do
                             pure $ countRows @Int
         res <- select $ do
           l :& c <- Experimental.from $ Table @Lord
-                          `InnerJoin` subquery
+                          `innerJoinLateral` subquery
                           `Experimental.on` (const $ val True)
           pure (l, c)
 
@@ -1252,9 +1254,9 @@ testLateralQuery = do
     it "supports LEFT JOIN LATERAL" $ do
       run $ do
         res <- select $ do
-          l :& c <- Experimental.from $ Table @Lord
+          l :& c <- Experimental.from $ table @Lord
                           `LeftOuterJoin` (\lord -> do
-                                    deed <- Experimental.from $ Table @Deed
+                                    deed <- Experimental.from $ table @Deed
                                     where_ $ lord ^. LordId ==. deed ^. DeedOwnerId
                                     pure $ countRows @Int)
                           `Experimental.on` (const $ val True)
@@ -1295,7 +1297,7 @@ testLateralQuery = do
 
 type JSONValue = Maybe (JSONB A.Value)
 
-createSaneSQL :: (PersistField a) => SqlExpr (Value a) -> T.Text -> [PersistValue] -> IO ()
+createSaneSQL :: (ES.SqlSelect (SqlExpr a) a, PersistField a) => SqlExpr a -> T.Text -> [PersistValue] -> IO ()
 createSaneSQL act q vals = run $ do
     (query, args) <- showQuery ES.SELECT $ fromValue act
     liftIO $ query `shouldBe` q