diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,10 @@ +3.3.3.0 +======== +- @belevy + - [#177](https://github.com/bitemyapp/esqueleto/pull/172) - Introduce new + experimental module for joins, set operations (eg UNION), and safer queries + from outer joins. + 3.3.2 ======== diff --git a/esqueleto.cabal b/esqueleto.cabal --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,7 +1,7 @@ cabal-version: 1.12 name: esqueleto -version: 3.3.2 +version: 3.3.3.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. . @@ -29,6 +29,7 @@ library exposed-modules: Database.Esqueleto + Database.Esqueleto.Experimental Database.Esqueleto.Internal.Language Database.Esqueleto.Internal.Sql Database.Esqueleto.Internal.Internal diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -77,8 +77,8 @@ , LeftOuterJoin(..) , RightOuterJoin(..) , FullOuterJoin(..) + , JoinKind(..) , OnClauseWithoutMatchingJoinException(..) - -- * SQL backend , SqlQuery , SqlExpr diff --git a/src/Database/Esqueleto/Experimental.hs b/src/Database/Esqueleto/Experimental.hs new file mode 100644 --- /dev/null +++ b/src/Database/Esqueleto/Experimental.hs @@ -0,0 +1,845 @@ +{-# LANGUAGE CPP + , DataKinds + , FlexibleContexts + , FlexibleInstances + , FunctionalDependencies + , GADTs + , MultiParamTypeClasses + , TypeOperators + , TypeFamilies + , UndecidableInstances + , OverloadedStrings + #-} + +module Database.Esqueleto.Experimental + ( -- * Setup + -- $setup + + -- * Introduction + -- $introduction + + -- * A New Syntax + -- $new-syntax + + -- * Documentation + + SqlSetOperation(..) + , From(..) + , on + , from + , (:&)(..) + -- * Internals + , ToFrom(..) + , ToFromT + , ToMaybe(..) + , ToMaybeT + , ToAlias(..) + , ToAliasT + , ToAliasReference(..) + , ToAliasReferenceT + ) + where + +import qualified Control.Monad.Trans.Writer as W +import qualified Control.Monad.Trans.State as S +import Control.Monad.Trans.Class (lift) +#if __GLASGOW_HASKELL__ < 804 +import Data.Semigroup +#endif +import Data.Proxy (Proxy(..)) +import Database.Esqueleto.Internal.PersistentImport +import Database.Esqueleto.Internal.Internal + ( SqlExpr(..) + , InnerJoin(..) + , CrossJoin(..) + , LeftOuterJoin(..) + , RightOuterJoin(..) + , FullOuterJoin(..) + , FromClause(..) + , SqlQuery(..) + , SideData(..) + , Value(..) + , JoinKind(..) + , newIdentFor + , SqlSelect(..) + , Mode(..) + , toRawSql + , Ident(..) + , to3, to4, to5, to6, to7, to8 + , from3, from4, from5, from6, from7, from8 + , veryUnsafeCoerceSqlExprValue + ) +import GHC.TypeLits + +-- $setup +-- +-- If you're already using "Database.Esqueleto", then you can get +-- started using this module just by changing your imports slightly, +-- as well as enabling the [TypeApplications](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-TypeApplications) extension. +-- +-- @ +-- {-\# LANGUAGE TypeApplications \#-} +-- +-- ... +-- +-- import Database.Esqueleto hiding (on, from) +-- import Database.Esqueleto.Experimental +-- @ + +---------------------------------------------------------------------- + +-- $introduction +-- +-- This module is fully backwards-compatible extension to the @esqueleto@ +-- EDSL that expands subquery functionality and enables +-- [SQL set operations](https://en.wikipedia.org/wiki/Set_operations_(SQL\)) +-- to be written directly in Haskell. Specifically, this enables: +-- +-- * Subqueries in 'JOIN' statements +-- * 'UNION' +-- * 'UNION' 'ALL' +-- * 'INTERSECT' +-- * 'EXCEPT' +-- +-- As a consequence of this, several classes of runtime errors are now +-- caught at compile time. This includes missing 'on' clauses and improper +-- handling of @Maybe@ values in outer joins. +-- +-- This module can be used in conjunction with the main "Database.Esqueleto" +-- module, but doing so requires qualified imports to avoid ambiguous +-- definitions of 'on' and 'from', which are defined in both modules. +-- +-- Below we will give an overview of how to use this module and the +-- features it enables. + +---------------------------------------------------------------------- + +-- $new-syntax +-- +-- This module introduces a new syntax that serves to enable the aforementioned +-- features. This new syntax also changes how joins written in the @esqueleto@ +-- EDSL to more closely resemble the underlying SQL. +-- +-- For our examples, we'll use a schema similar to the one in the Getting Started +-- section of "Database.Esqueleto": +-- +-- @ +-- share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist| +-- Person +-- name String +-- age Int Maybe +-- deriving Eq Show +-- BlogPost +-- title String +-- authorId PersonId +-- deriving Eq Show +-- Follow +-- follower PersonId +-- followed PersonId +-- deriving Eq Show +-- |] +-- @ +-- +-- === Example 1: Simple select +-- +-- Let's select all people who are named \"John\". +-- +-- ==== "Database.Esqueleto": +-- +-- @ +-- select $ +-- from $ \\people -> do +-- where_ (people ^. PersonName ==. val \"John\") +-- pure people +-- @ +-- +-- ==== "Database.Esqueleto.Experimental": +-- +-- @ +-- select $ do +-- people <- from $ Table \@Person +-- where_ (people ^. PersonName ==. val \"John\") +-- pure people +-- @ +-- +-- +-- === Example 2: Select with join +-- +-- Let's select all people and their blog posts who are over +-- the age of 18. +-- +-- ==== "Database.Esqueleto": +-- +-- @ +-- select $ +-- from $ \\(people \`LeftOuterJoin\` blogPosts) -> do +-- on (people ^. PersonId ==. blogPosts ?. BlogPostAuthorId) +-- where_ (people ^. PersonAge >. val 18) +-- pure (people, blogPosts) +-- @ +-- +-- ==== "Database.Esqueleto.Experimental": +-- +-- Here we use the ':&' operator to pattern match against the joined tables. +-- +-- @ +-- select $ do +-- (people :& blogPosts) <- +-- from $ Table \@Person +-- \`LeftOuterJoin\` Table \@BlogPost +-- \`on\` (\\(people :& blogPosts) -> +-- people ^. PersonId ==. blogPosts ?. BlogPostAuthorId) +-- where_ (people ^. PersonAge >. val 18) +-- pure (people, blogPosts) +-- @ +-- +-- === Example 3: Select with multi-table join +-- +-- Let's select all people who follow a person named \"John\", including +-- the name of each follower. +-- +-- ==== "Database.Esqueleto": +-- +-- @ +-- select $ +-- from $ \\( +-- people1 +-- \`InnerJoin\` followers +-- \`InnerJoin\` people2 +-- ) -> do +-- on (people1 ^. PersonId ==. followers ^. FollowFollowed) +-- on (followers ^. FollowFollower ==. people2 ^. PersonId) +-- where_ (people1 ^. PersonName ==. val \"John\") +-- pure (followers, people2) +-- @ +-- +-- ==== "Database.Esqueleto.Experimental": +-- +-- In this version, with each successive 'on' clause, only the tables +-- we have already joined into are in scope, so we must pattern match +-- accordingly. In this case, in the second 'InnerJoin', we do not use +-- the first `Person` reference, so we use @_@ as a placeholder to +-- ignore it. This prevents a possible runtime error where a table +-- is referenced before it appears in the sequence of 'JOIN's. +-- +-- @ +-- select $ do +-- (people1 :& followers :& people2) <- +-- from $ Table \@Person +-- \`InnerJoin` Table \@Follow +-- \`on\` (\\(people1 :& followers) -> +-- people1 ^. PersonId ==. followers ^. FollowFollowed) +-- \`InnerJoin` Table \@Person +-- \`on\` (\\(_ :& followers :& people2) -> +-- followers ^. FollowFollower ==. people2 ^. PersonId) +-- where_ (people1 ^. PersonName ==. val \"John\") +-- pure (followers, people2) +-- @ +-- +-- === Example 4: Counting results of a subquery +-- +-- Let's count the number of people who have posted at least 10 posts +-- +-- ==== "Database.Esqueleto": +-- +-- @ +-- select $ pure $ subSelectCount $ +-- from $ \\( +-- people +-- \`InnerJoin\` blogPosts +-- ) -> do +-- on (people ^. PersonId ==. blogPosts ^. BlogPostAuthorId) +-- groupBy (people ^. PersonId) +-- having ((count $ blogPosts ^. BlogPostId) >. val 10) +-- pure people +-- @ +-- +-- ==== "Database.Esqueleto.Experimental": +-- +-- @ +-- select $ do +-- peopleWithPosts <- +-- from $ SelectQuery $ do +-- (people :& blogPosts) <- +-- from $ Table \@Person +-- \`InnerJoin\` Table \@BlogPost +-- \`on\` (\\(p :& bP) -> +-- p ^. PersonId ==. bP ^. BlogPostAuthorId) +-- groupBy (people ^. PersonId) +-- having ((count $ blogPosts ^. BlogPostId) >. val 10) +-- pure people +-- pure $ count (peopleWithPosts ^. PersonId) +-- @ +-- +-- We now have the ability to refactor this +-- +-- === Example 5: Sorting the results of a UNION with limits +-- +-- Out of all of the posts created by a person and the people they follow, +-- generate a list of the first 25 posts, sorted alphabetically. +-- +-- ==== "Database.Esqueleto": +-- +-- Since 'UNION' is not supported, this requires using `Database.Esqueleto.rawSql`. (Not shown) +-- +-- ==== "Database.Esqueleto.Experimental": +-- +-- Since this module supports all set operations (see `SqlSetOperation`), we can use +-- `Union` to write this query. +-- +-- @ +-- select $ do +-- (authors, blogPosts) <- from $ +-- (SelectQuery $ do +-- (author :& blogPost) <- +-- from $ Table \@Person +-- \`InnerJoin\` Table \@BlogPost +-- \`on\` (\\(a :& bP) -> +-- a ^. PersonId ==. bP ^. BlogPostAuthorId) +-- where_ (author ^. PersonId ==. val currentPersonId) +-- pure (author, blogPost) +-- ) +-- \`Union\` +-- (SelectQuery $ do +-- (follow :& blogPost :& author) <- +-- from $ Table \@Follow +-- \`InnerJoin\` Table \@BlogPost +-- \`on\` (\\(f :& bP) -> +-- f ^. FollowFollowed ==. bP ^. BlogPostAuthorId) +-- \`InnerJoin\` Table \@Person +-- \`on\` (\\(_ :& bP :& a) -> +-- bP ^. BlogPostAuthorId ==. a ^. PersonId) +-- where_ (follow ^. FollowFollower ==. val currentPersonId) +-- pure (author, blogPost) +-- ) +-- orderBy [ asc (blogPosts ^. BlogPostTitle) ] +-- limit 25 +-- pure (authors, blogPosts) +-- @ + +-- | 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 +infixl 2 :& + +-- | Data type that represents SQL set operations. This includes +-- 'UNION', 'UNION' 'ALL', 'EXCEPT', and 'INTERSECT'. This data +-- type is defined as a binary tree, with @SelectQuery@ on the leaves. +-- +-- Each constructor corresponding to the aforementioned set operations +-- can be used as an infix function in a @from@ to help with readability +-- and lead to code that closely resembles the underlying SQL. For example, +-- +-- @ +-- select $ from $ +-- (SelectQuery ...) +-- \`Union\` +-- (SelectQuery ...) +-- @ +-- +-- is translated into +-- +-- @ +-- SELECT * FROM ( +-- (SELECT * FROM ...) +-- UNION +-- (SELECT * FROM ...) +-- ) +-- @ +-- +-- @SelectQuery@ can be used without any of the set operations to construct +-- a subquery. This can be used in 'JOIN' trees. For example, +-- +-- @ +-- select $ from $ +-- Table \@SomeTable +-- \`InnerJoin\` (SelectQuery ...) +-- \`on\` ... +-- @ +-- +-- is translated into +-- +-- @ +-- SELECT * +-- FROM SomeTable +-- INNER JOIN (SELECT * FROM ...) +-- ON ... +-- @ +data SqlSetOperation a = + Union (SqlSetOperation a) (SqlSetOperation a) + | UnionAll (SqlSetOperation a) (SqlSetOperation a) + | Except (SqlSetOperation a) (SqlSetOperation a) + | Intersect (SqlSetOperation a) (SqlSetOperation a) + | SelectQuery (SqlQuery a) + +-- | Data type that represents the syntax of a 'JOIN' tree. In practice, +-- only the @Table@ constructor is used directly when writing queries. For example, +-- +-- @ +-- select $ from $ Table \@People +-- @ +data From a where + Table :: PersistEntity ent => From (SqlExpr (Entity ent)) + SubQuery :: (SqlSelect a' r, SqlSelect a'' r', ToAlias a, a' ~ ToAliasT a, ToAliasReference a', ToAliasReferenceT a' ~ a'') + => SqlQuery a + -> From a'' + SqlSetOperation :: (SqlSelect a' r, ToAlias a, a' ~ ToAliasT a, ToAliasReference a', ToAliasReferenceT a' ~ a'') + => SqlSetOperation a + -> From a'' + InnerJoinFrom :: From a + -> (From b, (a :& b) -> SqlExpr (Value Bool)) + -> From (a :& b) + CrossJoinFrom :: From a + -> From b + -> From (a :& b) + LeftJoinFrom :: ToMaybe b + => From a + -> (From b, (a :& ToMaybeT b) -> SqlExpr (Value Bool)) + -> From (a :& ToMaybeT b) + RightJoinFrom :: ToMaybe a + => From a + -> (From b, (ToMaybeT a :& b) -> SqlExpr (Value Bool)) + -> From (ToMaybeT a :& b) + FullJoinFrom :: (ToMaybe a, ToMaybe b ) + => From a + -> (From b, (ToMaybeT a :& ToMaybeT b) -> SqlExpr (Value Bool)) + -> From (ToMaybeT a :& ToMaybeT b) + +-- | 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 :: ToFrom a => a -> (b -> SqlExpr (Value Bool)) -> (a, b -> SqlExpr (Value Bool)) +on = (,) +infix 9 `on` + +type JoinErrorMsg jk = 'Text "Missing on statement for " ':<>: 'Text jk + +type family ToFromT a where + ToFromT (From a) = a + ToFromT (SqlSetOperation a) = ToAliasReferenceT (ToAliasT a) + ToFromT (LeftOuterJoin a (b, c -> SqlExpr (Value Bool))) = c + ToFromT (FullOuterJoin a (b, c -> SqlExpr (Value Bool))) = c + ToFromT (RightOuterJoin a (b, c -> SqlExpr (Value Bool))) = c + ToFromT (InnerJoin a (b, c -> SqlExpr (Value Bool))) = c + ToFromT (CrossJoin a b) = (ToFromT a :& ToFromT b) + ToFromT (InnerJoin a b) = TypeError (JoinErrorMsg "InnerJoin") + ToFromT (LeftOuterJoin a b) = TypeError (JoinErrorMsg "LeftOuterJoin") + ToFromT (RightOuterJoin a b) = TypeError (JoinErrorMsg "RightOuterJoin") + ToFromT (FullOuterJoin a b) = TypeError (JoinErrorMsg "FullOuterJoin") + +{-- Type class magic to allow the use of the `InnerJoin` family of data constructors in from --} +class ToFrom a where + toFrom :: a -> From (ToFromT a) + +instance ToFrom (From a) where + toFrom = id + +instance {-# OVERLAPPABLE #-} ToFrom (InnerJoin a b) where + toFrom = undefined +instance {-# OVERLAPPABLE #-} ToFrom (LeftOuterJoin a b) where + toFrom = undefined +instance {-# OVERLAPPABLE #-} ToFrom (RightOuterJoin a b) where + toFrom = undefined +instance {-# OVERLAPPABLE #-} ToFrom (FullOuterJoin a b) where + toFrom = undefined + +instance (SqlSelect a' r,SqlSelect a'' r', ToAlias a, a' ~ ToAliasT a, ToAliasReference a', ToAliasReferenceT a' ~ a'') => ToFrom (SqlSetOperation a) where + -- If someone uses just a plain SelectQuery it should behave like a normal subquery + toFrom (SelectQuery q) = SubQuery q + -- Otherwise use the SqlSetOperation + toFrom q = SqlSetOperation q + +instance (ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b', ToMaybe b', mb ~ ToMaybeT b') + => ToFrom (LeftOuterJoin a (b, (a' :& mb) -> SqlExpr (Value Bool))) where + toFrom (LeftOuterJoin lhs (rhs, on')) = LeftJoinFrom (toFrom lhs) (toFrom rhs, on') + +instance (ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b', ToMaybe a', ma ~ ToMaybeT a', ToMaybe b', mb ~ ToMaybeT b') + => ToFrom (FullOuterJoin a (b, (ma :& mb) -> SqlExpr (Value Bool))) where + toFrom (FullOuterJoin lhs (rhs, on')) = FullJoinFrom (toFrom lhs) (toFrom rhs, on') + +instance (ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b', ToMaybe a', ma ~ ToMaybeT a') + => ToFrom (RightOuterJoin a (b, (ma :& b') -> SqlExpr (Value Bool))) where + toFrom (RightOuterJoin lhs (rhs, on')) = RightJoinFrom (toFrom lhs) (toFrom rhs, on') + +instance (ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b') => ToFrom (InnerJoin a (b, (a' :& b') -> SqlExpr (Value Bool))) where + toFrom (InnerJoin lhs (rhs, on')) = InnerJoinFrom (toFrom lhs) (toFrom rhs, on') + +instance (ToFrom a, ToFrom b) => ToFrom (CrossJoin a b) where + toFrom (CrossJoin lhs rhs) = CrossJoinFrom (toFrom lhs) (toFrom rhs) + +type family Nullable a where + Nullable (Maybe a) = a + Nullable a = a + +type family ToMaybeT a where + ToMaybeT (SqlExpr (Maybe a)) = SqlExpr (Maybe a) + ToMaybeT (SqlExpr (Entity a)) = SqlExpr (Maybe (Entity a)) + ToMaybeT (SqlExpr (Value a)) = SqlExpr (Value (Maybe (Nullable a))) + ToMaybeT (a :& b) = (ToMaybeT a :& ToMaybeT b) + ToMaybeT (a, b) = (ToMaybeT a, ToMaybeT b) + ToMaybeT (a, b, c) = (ToMaybeT a, ToMaybeT b, ToMaybeT c) + ToMaybeT (a, b, c, d) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d) + ToMaybeT (a, b, c, d, e) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d, ToMaybeT e) + ToMaybeT (a, b, c, d, e, f) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d, ToMaybeT e, ToMaybeT f) + ToMaybeT (a, b, c, d, e, f, g) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d, ToMaybeT e, ToMaybeT f, ToMaybeT g) + 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) + +class ToMaybe a where + toMaybe :: a -> ToMaybeT a + +instance ToMaybe (SqlExpr (Maybe a)) where + toMaybe = id + +instance ToMaybe (SqlExpr (Entity a)) where + toMaybe = EMaybe + +instance ToMaybe (SqlExpr (Value a)) where + toMaybe = veryUnsafeCoerceSqlExprValue + +instance (ToMaybe a, ToMaybe b) => ToMaybe (a :& b) where + toMaybe (a :& b) = (toMaybe a :& toMaybe b) + +instance (ToMaybe a, ToMaybe b) => ToMaybe (a,b) where + toMaybe (a, b) = (toMaybe a, toMaybe b) + +instance ( ToMaybe a + , ToMaybe b + , ToMaybe c + ) => ToMaybe (a,b,c) where + toMaybe = to3 . toMaybe . from3 + +instance ( ToMaybe a + , ToMaybe b + , ToMaybe c + , ToMaybe d + ) => ToMaybe (a,b,c,d) where + toMaybe = to4 . toMaybe . from4 + +instance ( ToMaybe a + , ToMaybe b + , ToMaybe c + , ToMaybe d + , ToMaybe e + ) => ToMaybe (a,b,c,d,e) where + 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 + 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 + 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 + toMaybe = to8 . toMaybe . from8 + +-- | 'FROM' clause, used to bring entities into scope. +-- +-- Internally, this function uses the `From` datatype and the +-- `ToFrom` typeclass. 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 `ToFrom`. This implementation eliminates certain +-- types of runtime errors by preventing the construction of +-- invalid SQL (e.g. illegal nested-@from@). +from :: ToFrom a => a -> SqlQuery (ToFromT a) +from parts = do + (a, clause) <- runFrom $ toFrom parts + Q $ W.tell mempty{sdFromClause=[clause]} + pure a + where + runFrom :: From a -> SqlQuery (a, FromClause) + runFrom e@Table = do + let ed = entityDef $ getVal e + ident <- newIdentFor (entityDB ed) + let entity = EEntity ident + pure $ (entity, FromStart ident ed) + where + getVal :: PersistEntity ent => From (SqlExpr (Entity ent)) -> Proxy ent + getVal = const Proxy + runFrom (SubQuery subquery) = do + -- We want to update the IdentState without writing the query to side data + (ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ subquery + aliasedValue <- toAlias ret + -- Make a fake query with the aliased results, this allows us to ensure that the query is only run once + let aliasedQuery = Q $ W.WriterT $ pure (aliasedValue, sideData) + -- Add the FromQuery that renders the subquery to our side data + subqueryAlias <- newIdentFor (DBName "q") + -- Pass the aliased results of the subquery to the outer query + -- create aliased references from the outer query results (e.g value from subquery will be `subquery`.`value`), + -- this is probably overkill as the aliases should already be unique but seems to be good practice. + ref <- toAliasReference subqueryAlias aliasedValue + pure (ref , FromQuery subqueryAlias (\info -> toRawSql SELECT info aliasedQuery)) + + runFrom (SqlSetOperation operation) = do + (aliasedOperation, ret) <- aliasQueries operation + ident <- newIdentFor (DBName "u") + ref <- toAliasReference ident ret + pure (ref, FromQuery ident $ operationToSql aliasedOperation) + + where + aliasQueries o = + case o of + SelectQuery q -> do + (ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ q + prevState <- Q $ lift S.get + aliasedRet <- toAlias ret + Q $ lift $ S.put prevState + pure (SelectQuery $ Q $ W.WriterT $ pure (aliasedRet, sideData), aliasedRet) + Union o1 o2 -> do + (o1', ret) <- aliasQueries o1 + (o2', _ ) <- aliasQueries o2 + pure (Union o1' o2', ret) + UnionAll o1 o2 -> do + (o1', ret) <- aliasQueries o1 + (o2', _ ) <- aliasQueries o2 + pure (UnionAll o1' o2', ret) + Except o1 o2 -> do + (o1', ret) <- aliasQueries o1 + (o2', _ ) <- aliasQueries o2 + pure (Except o1' o2', ret) + Intersect o1 o2 -> do + (o1', ret) <- aliasQueries o1 + (o2', _ ) <- aliasQueries o2 + pure (Intersect o1' o2', ret) + + operationToSql o info = + case o of + SelectQuery q -> toRawSql SELECT info q + Union o1 o2 -> doSetOperation "UNION" info o1 o2 + UnionAll o1 o2 -> doSetOperation "UNION ALL" info o1 o2 + Except o1 o2 -> doSetOperation "EXCEPT" info o1 o2 + Intersect o1 o2 -> doSetOperation "INTERSECT" info o1 o2 + + doSetOperation operationText info o1 o2 = + let + (q1, v1) = operationToSql o1 info + (q2, v2) = operationToSql o2 info + in (q1 <> " " <> operationText <> " " <> q2, v1 <> v2) + + + runFrom (InnerJoinFrom leftPart (rightPart, on')) = do + (leftVal, leftFrom) <- runFrom leftPart + (rightVal, rightFrom) <- runFrom rightPart + let ret = leftVal :& rightVal + pure $ (ret, FromJoin leftFrom InnerJoinKind rightFrom (Just (on' ret))) + runFrom (CrossJoinFrom leftPart rightPart) = do + (leftVal, leftFrom) <- runFrom leftPart + (rightVal, rightFrom) <- runFrom rightPart + let ret = leftVal :& rightVal + pure $ (ret, FromJoin leftFrom CrossJoinKind rightFrom Nothing) + runFrom (LeftJoinFrom leftPart (rightPart, on')) = do + (leftVal, leftFrom) <- runFrom leftPart + (rightVal, rightFrom) <- runFrom rightPart + let ret = leftVal :& (toMaybe rightVal) + pure $ (ret, FromJoin leftFrom LeftOuterJoinKind rightFrom (Just (on' ret))) + runFrom (RightJoinFrom leftPart (rightPart, on')) = do + (leftVal, leftFrom) <- runFrom leftPart + (rightVal, rightFrom) <- runFrom rightPart + let ret = (toMaybe leftVal) :& rightVal + pure $ (ret, FromJoin leftFrom RightOuterJoinKind rightFrom (Just (on' ret))) + runFrom (FullJoinFrom leftPart (rightPart, on')) = do + (leftVal, leftFrom) <- runFrom leftPart + (rightVal, rightFrom) <- runFrom rightPart + let ret = (toMaybe leftVal) :& (toMaybe rightVal) + pure $ (ret, FromJoin leftFrom FullOuterJoinKind rightFrom (Just (on' ret))) + +type family ToAliasT a where + ToAliasT (SqlExpr (Value a)) = SqlExpr (Value a) + ToAliasT (SqlExpr (Entity a)) = SqlExpr (Entity a) + ToAliasT (a, b) = (ToAliasT a, ToAliasT b) + ToAliasT (a, b, c) = (ToAliasT a, ToAliasT b, ToAliasT c) + ToAliasT (a, b, c, d) = (ToAliasT a, ToAliasT b, ToAliasT c, ToAliasT d) + ToAliasT (a, b, c, d, e) = (ToAliasT a, ToAliasT b, ToAliasT c, ToAliasT d, ToAliasT e) + ToAliasT (a, b, c, d, e, f) = (ToAliasT a, ToAliasT b, ToAliasT c, ToAliasT d, ToAliasT e, ToAliasT f) + ToAliasT (a, b, c, d, e, f, g) = (ToAliasT a, ToAliasT b, ToAliasT c, ToAliasT d, ToAliasT e, ToAliasT f, ToAliasT g) + ToAliasT (a, b, c, d, e, f, g, h) = (ToAliasT a, ToAliasT b, ToAliasT c, ToAliasT d, ToAliasT e, ToAliasT f, ToAliasT g, ToAliasT h) + +-- Tedious tuple magic +class ToAlias a where + toAlias :: a -> SqlQuery (ToAliasT a) + +instance ToAlias (SqlExpr (Value a)) where + toAlias v@(EAliasedValue _ _) = pure v + toAlias v = do + ident <- newIdentFor (DBName "v") + pure $ EAliasedValue ident v + +instance ToAlias (SqlExpr (Entity a)) where + toAlias v@(EAliasedEntityReference _ _) = pure v + toAlias v@(EAliasedEntity _ _) = pure v + toAlias (EEntity tableIdent) = do + ident <- newIdentFor (DBName "v") + pure $ EAliasedEntity ident tableIdent + +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) + + +type family ToAliasReferenceT a where + ToAliasReferenceT (SqlExpr (Value a)) = SqlExpr (Value a) + ToAliasReferenceT (SqlExpr (Entity a)) = SqlExpr (Entity a) + ToAliasReferenceT (a,b) = (ToAliasReferenceT a, ToAliasReferenceT b) + ToAliasReferenceT (a,b,c) = (ToAliasReferenceT a, ToAliasReferenceT b, ToAliasReferenceT c) + ToAliasReferenceT (a, b, c, d) = (ToAliasReferenceT a, ToAliasReferenceT b, ToAliasReferenceT c, ToAliasReferenceT d) + ToAliasReferenceT (a, b, c, d, e) = (ToAliasReferenceT a, ToAliasReferenceT b, ToAliasReferenceT c, ToAliasReferenceT d, ToAliasReferenceT e) + ToAliasReferenceT (a, b, c, d, e, f) = (ToAliasReferenceT a, ToAliasReferenceT b, ToAliasReferenceT c, ToAliasReferenceT d, ToAliasReferenceT e, ToAliasReferenceT f) + ToAliasReferenceT (a, b, c, d, e, f, g) = (ToAliasReferenceT a, ToAliasReferenceT b, ToAliasReferenceT c, ToAliasReferenceT d, ToAliasReferenceT e, ToAliasReferenceT f, ToAliasReferenceT g) + ToAliasReferenceT (a, b, c, d, e, f, g, h) = (ToAliasReferenceT a, ToAliasReferenceT b, ToAliasReferenceT c, ToAliasReferenceT d, ToAliasReferenceT e, ToAliasReferenceT f, ToAliasReferenceT g, ToAliasReferenceT h) + +-- more tedious tuple magic +class ToAliasReference a where + toAliasReference :: Ident -> a -> SqlQuery (ToAliasReferenceT a) + +instance ToAliasReference (SqlExpr (Value a)) where + toAliasReference aliasSource (EAliasedValue aliasIdent _) = pure $ EValueReference aliasSource (\_ -> aliasIdent) + toAliasReference _ v@(ERaw _ _) = toAlias v + toAliasReference _ v@(ECompositeKey _) = toAlias v + toAliasReference _ v@(EValueReference _ _) = pure v + +instance ToAliasReference (SqlExpr (Entity a)) where + toAliasReference aliasSource (EAliasedEntity ident _) = pure $ EAliasedEntityReference aliasSource ident + toAliasReference _ e@(EEntity _) = toAlias e + toAliasReference _ e@(EAliasedEntityReference _ _) = pure e + +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) diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -521,9 +521,21 @@ => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ) -EEntity ident ^. field +(EAliasedEntityReference source base) ^. field = + EValueReference source (aliasedEntityColumnIdent base fieldDef) + where + fieldDef = + if isIdField field then + -- TODO what about composite natural keys in a join this will ignore them + head $ entityKeyFields ed + else + persistFieldDef field + + ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val))) + +e ^. field | isIdField field = idFieldValue - | otherwise = ERaw Never $ \info -> (dot info $ persistFieldDef field, []) + | otherwise = ERaw Never $ \info -> (dot info $ persistFieldDef field, []) where idFieldValue = case entityKeyFields ed of @@ -533,10 +545,21 @@ idFields -> ECompositeKey $ \info -> dot info <$> idFields - dot info x = useIdent info ident <> "." <> fromDBName info (fieldDB x) - ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val))) - Just pdef = entityPrimary ed + ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val))) + + dot info fieldDef = + useIdent info sourceIdent <> "." <> fieldIdent + where + sourceIdent = + case e of + EEntity ident -> ident + EAliasedEntity baseI _ -> baseI + fieldIdent = + case e of + EEntity _ -> fromDBName info (fieldDB fieldDef) + EAliasedEntity baseI _ -> useIdent info $ aliasedEntityColumnIdent baseI fieldDef info + -- | Project an SqlExpression that may be null, guarding against null cases. withNonNull :: PersistField typ => SqlExpr (Value (Maybe typ)) @@ -557,15 +580,24 @@ -- | @IS NULL@ comparison. isNothing :: PersistField typ => SqlExpr (Value (Maybe typ)) -> SqlExpr (Value Bool) -isNothing (ERaw p f) = ERaw Parens $ first ((<> " IS NULL") . parensM p) . f -isNothing (ECompositeKey f) = ERaw Parens $ flip (,) [] . (intersperseB " AND " . map (<> " IS NULL")) . f +isNothing v = + case v of + ERaw p f -> isNullExpr $ first (parensM p) . f + EAliasedValue i _ -> isNullExpr $ aliasedValueIdentToRawSql i + EValueReference i i' -> isNullExpr $ valueReferenceToRawSql i i' + ECompositeKey f -> ERaw Parens $ flip (,) [] . (intersperseB " AND " . map (<> " IS NULL")) . f + where + isNullExpr :: (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value Bool) + isNullExpr g = ERaw Parens $ first ((<> " IS NULL")) . g -- | Analogous to 'Just', promotes a value of type @typ@ into -- one of type @Maybe typ@. It should hold that @'val' . Just -- === just . 'val'@. just :: SqlExpr (Value typ) -> SqlExpr (Value (Maybe typ)) -just (ERaw p f) = ERaw p f -just (ECompositeKey f) = ECompositeKey f +just (ERaw p f) = ERaw p f +just (ECompositeKey f) = ECompositeKey f +just (EAliasedValue i v) = EAliasedValue i (just v) +just (EValueReference i i') = EValueReference i i' -- | @NULL@ value. nothing :: SqlExpr (Value (Maybe typ)) @@ -574,9 +606,23 @@ -- | Join nested 'Maybe's in a 'Value' into one. This is useful when -- calling aggregate functions on nullable fields. joinV :: SqlExpr (Value (Maybe (Maybe typ))) -> SqlExpr (Value (Maybe typ)) -joinV (ERaw p f) = ERaw p f -joinV (ECompositeKey f) = ECompositeKey f +joinV (ERaw p f) = ERaw p f +joinV (ECompositeKey f) = ECompositeKey f +joinV (EAliasedValue i v) = EAliasedValue i (joinV v) +joinV (EValueReference i i') = EValueReference i i' + +countHelper :: Num a => TLB.Builder -> TLB.Builder -> SqlExpr (Value typ) -> SqlExpr (Value a) +countHelper open close v = + case v of + ERaw _ f -> countRawSql f + EAliasedValue i _ -> countRawSql $ aliasedValueIdentToRawSql i + EValueReference i i' -> countRawSql $ valueReferenceToRawSql i i' + ECompositeKey _ -> countRows + where + countRawSql :: (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a) + countRawSql x = ERaw Never $ first (\b -> "COUNT" <> open <> parens b <> close) . x + -- | @COUNT(*)@ value. countRows :: Num a => SqlExpr (Value a) countRows = unsafeSqlValue "COUNT(*)" @@ -592,10 +638,16 @@ countDistinct = countHelper "(DISTINCT " ")" not_ :: SqlExpr (Value Bool) -> SqlExpr (Value Bool) -not_ (ERaw p f) = ERaw Never $ \info -> let (b, vals) = f info - in ("NOT " <> parensM p b, vals) -not_ (ECompositeKey _) = throw (CompositeKeyErr NotError) - +not_ v = ERaw Never (\info -> first ("NOT " <>) $ x info) + where + x info = + case v of + ERaw p f -> + let (b, vals) = f info + in (parensM p b, vals) + ECompositeKey _ -> throw (CompositeKeyErr NotError) + EAliasedValue i _ -> aliasedValueIdentToRawSql i info + EValueReference i i' -> valueReferenceToRawSql i i' info (==.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) (==.) = unsafeSqlBinOpComposite " = " " AND " @@ -879,15 +931,23 @@ (<#) :: (a -> b) -> SqlExpr (Value a) -> SqlExpr (Insertion b) (<#) _ (ERaw _ f) = EInsert Proxy f (<#) _ (ECompositeKey _) = throw (CompositeKeyErr ToInsertionError) +(<#) _ (EAliasedValue i _) = EInsert Proxy $ aliasedValueIdentToRawSql i +(<#) _ (EValueReference i i') = EInsert Proxy $ valueReferenceToRawSql i i' -- | Apply extra @SqlExpr Value@ arguments to a 'PersistField' constructor (<&>) :: SqlExpr (Insertion (a -> b)) -> SqlExpr (Value a) -> SqlExpr (Insertion b) -(EInsert _ f) <&> (ERaw _ g) = EInsert Proxy $ \x -> +(EInsert _ f) <&> v = EInsert Proxy $ \x -> let (fb, fv) = f x (gb, gv) = g x in (fb <> ", " <> gb, fv ++ gv) -(EInsert _ _) <&> (ECompositeKey _) = throw (CompositeKeyErr CombineInsertionError) + where + g = + case v of + ERaw _ f' -> f' + EAliasedValue i _ -> aliasedValueIdentToRawSql i + EValueReference i i' -> valueReferenceToRawSql i i' + ECompositeKey _ -> throw (CompositeKeyErr CombineInsertionError) -- | @CASE@ statement. For example: -- @@ -1003,6 +1063,7 @@ else_ :: expr a -> expr a else_ = id + -- | A single value (as opposed to a whole entity). You may use -- @('^.')@ or @('?.')@ to get a 'Value' from an 'Entity'. newtype Value a = Value { unValue :: a } deriving (Eq, Ord, Show, Typeable) @@ -1142,8 +1203,11 @@ renderUpdates conn = uncommas' . concatMap renderUpdate where mk :: SqlExpr (Value ()) -> [(TLB.Builder, [PersistValue])] - mk (ERaw _ f) = [f info] - mk (ECompositeKey _) = throw (CompositeKeyErr MakeSetError) -- FIXME + mk (ERaw _ f) = [f info] + mk (ECompositeKey _) = throw (CompositeKeyErr MakeSetError) -- FIXME + mk (EAliasedValue i _) = [aliasedValueIdentToRawSql i info] + mk (EValueReference i i') = [valueReferenceToRawSql i i' info] + renderUpdate :: SqlExpr (Update val) -> [(TLB.Builder, [PersistValue])] renderUpdate (ESet f) = mk (f undefined) -- second parameter of f is always unused info = (projectBackend conn, initialIdentState) @@ -1198,6 +1262,7 @@ -- | (Internal) Reify a @JoinKind@ from a @JOIN@. This -- function is non-strict. reifyJoinKind :: join a b -> JoinKind + instance IsJoinKind InnerJoin where smartJoin a b = a `InnerJoin` b reifyJoinKind _ = InnerJoinKind @@ -1222,11 +1287,12 @@ deriving (Eq, Ord, Show, Typeable) instance Exception OnClauseWithoutMatchingJoinException where - -- | (Internal) Phantom type used to process 'from' (see 'fromStart'). data PreprocessedFrom a + + -- | Phantom type used by 'orderBy', 'asc' and 'desc'. data OrderBy @@ -1496,13 +1562,14 @@ -- | Exception data type for @esqueleto@ internal errors data EsqueletoError = CompositeKeyErr CompositeKeyError + | AliasedValueErr UnexpectedValueError | UnexpectedCaseErr UnexpectedCaseError | SqlBinOpCompositeErr SqlBinOpCompositeError deriving (Show) instance Exception EsqueletoError -data CompositeKeyError = +data UnexpectedValueError = NotError | ToInsertionError | CombineInsertionError @@ -1516,6 +1583,8 @@ | MakeHavingError deriving (Show) +type CompositeKeyError = UnexpectedValueError + data UnexpectedCaseError = EmptySqlExprValueList | MakeFromError @@ -1524,6 +1593,7 @@ | NewIdentForError | UnsafeSqlCaseError | OperationNotSupported + | NotImplemented deriving (Show) data SqlBinOpCompositeError = @@ -1599,12 +1669,14 @@ FromStart Ident EntityDef | FromJoin FromClause JoinKind FromClause (Maybe (SqlExpr (Value Bool))) | OnClause (SqlExpr (Value Bool)) + | FromQuery Ident (IdentInfo -> (TLB.Builder, [PersistValue])) collectIdents :: FromClause -> Set Ident collectIdents fc = case fc of FromStart i _ -> Set.singleton i FromJoin lhs _ rhs _ -> collectIdents lhs <> collectIdents rhs OnClause _ -> mempty + FromQuery _ _ -> mempty instance Show FromClause where show fc = case fc of @@ -1626,6 +1698,8 @@ ] OnClause expr -> "(OnClause " <> render' expr <> ")" + FromQuery ident _-> + "(FromQuery " <> show ident <> ")" where @@ -1684,10 +1758,12 @@ findRightmostIdent (FromStart i _) = Just i findRightmostIdent (FromJoin _ _ r _) = findRightmostIdent r findRightmostIdent (OnClause {}) = Nothing + findRightmostIdent (FromQuery _ _) = Nothing findLeftmostIdent (FromStart i _) = Just i findLeftmostIdent (FromJoin l _ _ _) = findLeftmostIdent l findLeftmostIdent (OnClause {}) = Nothing + findLeftmostIdent (FromQuery _ _) = Nothing tryMatch :: Set Ident @@ -1853,6 +1929,10 @@ data SqlExpr a where -- An entity, created by 'from' (cf. 'fromStart'). EEntity :: Ident -> SqlExpr (Entity val) + -- Base Table + EAliasedEntity :: Ident -> Ident -> SqlExpr (Entity val) + -- Source Base + EAliasedEntityReference :: Ident -> Ident -> SqlExpr (Entity val) -- Just a tag stating that something is nullable. EMaybe :: SqlExpr a -> SqlExpr (Maybe a) @@ -1864,6 +1944,13 @@ -- interpolated by the SQL backend. ERaw :: NeedParens -> (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a) + + -- A raw expression with an alias + EAliasedValue :: Ident -> SqlExpr (Value a) -> SqlExpr (Value a) + + -- A reference to an aliased field in a table or subquery + EValueReference :: Ident -> (IdentInfo -> Ident) -> SqlExpr (Value a) + -- A composite key. -- -- Persistent uses the same 'PersistList' constructor for both @@ -1912,6 +1999,7 @@ -- A 'SqlExpr' accepted only by 'orderBy'. EOrderBy :: OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy + EOrderRandom :: SqlExpr OrderBy -- A 'SqlExpr' accepted only by 'distinctOn'. @@ -1970,9 +2058,6 @@ ifNotEmptyList EEmptyList b _ = val b ifNotEmptyList (EList _) _ x = x -countHelper :: Num a => TLB.Builder -> TLB.Builder -> SqlExpr (Value typ) -> SqlExpr (Value a) -countHelper open close (ERaw _ f) = ERaw Never $ first (\b -> "COUNT" <> open <> parens b <> close) . f -countHelper _ _ (ECompositeKey _) = countRows -- Assumes no NULLs on a PK ---------------------------------------------------------------------- @@ -1982,26 +2067,31 @@ -- -- Since: 2.1.1 unsafeSqlCase :: PersistField a => [(SqlExpr (Value Bool), SqlExpr (Value a))] -> SqlExpr (Value a) -> SqlExpr (Value a) -unsafeSqlCase when (ERaw p1 f1) = ERaw Never buildCase +unsafeSqlCase when v = ERaw Never buildCase where buildCase :: IdentInfo -> (TLB.Builder, [PersistValue]) buildCase info = - let (b1, vals1) = f1 info - (b2, vals2) = mapWhen when info - in ( "CASE" <> b2 <> " ELSE " <> parensM p1 b1 <> " END", vals2 <> vals1) + let (elseText, elseVals) = valueToSql v info + (whenText, whenVals) = mapWhen when info + in ( "CASE" <> whenText <> " ELSE " <> elseText <> " END", whenVals <> elseVals) mapWhen :: [(SqlExpr (Value Bool), SqlExpr (Value a))] -> IdentInfo -> (TLB.Builder, [PersistValue]) mapWhen [] _ = throw (UnexpectedCaseErr UnsafeSqlCaseError) mapWhen when' info = foldl (foldHelp info) (mempty, mempty) when' foldHelp :: IdentInfo -> (TLB.Builder, [PersistValue]) -> (SqlExpr (Value Bool), SqlExpr (Value a)) -> (TLB.Builder, [PersistValue]) - foldHelp info (b0, vals0) (ERaw p1' f1', ERaw p2 f2) = - let (b1, vals1) = f1' info - (b2, vals2) = f2 info - in ( b0 <> " WHEN " <> parensM p1' b1 <> " THEN " <> parensM p2 b2, vals0 <> vals1 <> vals2 ) - foldHelp _ _ _ = throw (CompositeKeyErr FoldHelpError) -unsafeSqlCase _ (ECompositeKey _) = throw (CompositeKeyErr SqlCaseError) + foldHelp _ _ (ECompositeKey _, _) = throw (CompositeKeyErr FoldHelpError) + foldHelp _ _ (_, ECompositeKey _) = throw (CompositeKeyErr FoldHelpError) + foldHelp info (b0, vals0) (v1, v2) = + let (b1, vals1) = valueToSql v1 info + (b2, vals2) = valueToSql v2 info + in ( b0 <> " WHEN " <> b1 <> " THEN " <> b2, vals0 <> vals1 <> vals2 ) + valueToSql :: SqlExpr (Value a) -> IdentInfo -> (TLB.Builder, [PersistValue]) + valueToSql (ERaw p f) = (first (parensM p)) . f + valueToSql (ECompositeKey _) = throw (CompositeKeyErr SqlCaseError) + valueToSql (EAliasedValue i _) = aliasedValueIdentToRawSql i + valueToSql (EValueReference i i') = valueReferenceToRawSql i i' -- | (Internal) Create a custom binary operator. You /should/ -- /not/ use this function directly since its type is very @@ -2032,9 +2122,15 @@ in build (parensM p b1, vals) construct (ECompositeKey f) = ERaw Parens $ \info -> (uncommas $ f info, mempty) + construct (EAliasedValue i _) = + ERaw Never $ aliasedValueIdentToRawSql i + construct (EValueReference i i') = + ERaw Never $ valueReferenceToRawSql i i' {-# INLINE unsafeSqlBinOp #-} + + -- | Similar to 'unsafeSqlBinOp', but may also be applied to -- composite keys. Uses the operator given as the second -- argument whenever applied to composite keys. @@ -2063,8 +2159,10 @@ unsafeSqlBinOpComposite op sep a b = ERaw Parens $ compose (listify a) (listify b) where listify :: SqlExpr (Value x) -> IdentInfo -> ([TLB.Builder], [PersistValue]) - listify (ECompositeKey f) = flip (,) [] . f - listify (ERaw _ f) = deconstruct . f + listify (ECompositeKey f) = flip (,) [] . f + listify (ERaw _ f) = deconstruct . f + listify (EAliasedValue i _) = deconstruct . (aliasedValueIdentToRawSql i) + listify (EValueReference i i') = deconstruct . (valueReferenceToRawSql i i') deconstruct :: (TLB.Builder, [PersistValue]) -> ([TLB.Builder], [PersistValue]) deconstruct ("?", [PersistList vals]) = (replicate (length vals) "?", vals) @@ -2123,12 +2221,16 @@ -- | (Internal) An explicit SQL type cast using CAST(value as type). -- See 'unsafeSqlBinOp' for warnings. unsafeSqlCastAs :: T.Text -> SqlExpr (Value a) -> SqlExpr (Value b) -unsafeSqlCastAs t (ERaw p f) = - ERaw Never $ \info -> - let (b, v) = f info - in ("CAST" <> parens ( parensM p b <> " AS " <> TLB.fromText t), v ) -unsafeSqlCastAs _ (ECompositeKey _) = throw (CompositeKeyErr SqlCastAsError) - +unsafeSqlCastAs t v = ERaw Never ((first (\value -> "CAST" <> parens (value <> " AS " <> TLB.fromText t))) . valueToText) + where + valueToText info = + case v of + (ERaw p f) -> + let (b, vals) = f info + in (parensM p b, vals) + EAliasedValue i _ -> aliasedValueIdentToRawSql i info + EValueReference i i' -> valueReferenceToRawSql i i' info + ECompositeKey _ -> throw (CompositeKeyErr SqlCastAsError) -- | (Internal) This class allows 'unsafeSqlFunction' to work with different -- numbers of arguments; specifically it allows providing arguments to a sql -- function via an n-tuple of @SqlExpr (Value _)@ values, which are not all @@ -2234,8 +2336,10 @@ -- 'SqlExpr (Value b)'. You should /not/ use this function -- unless you know what you're doing! veryUnsafeCoerceSqlExprValue :: SqlExpr (Value a) -> SqlExpr (Value b) -veryUnsafeCoerceSqlExprValue (ERaw p f) = ERaw p f -veryUnsafeCoerceSqlExprValue (ECompositeKey f) = ECompositeKey f +veryUnsafeCoerceSqlExprValue (ERaw p f) = ERaw p f +veryUnsafeCoerceSqlExprValue (ECompositeKey f) = ECompositeKey f +veryUnsafeCoerceSqlExprValue (EAliasedValue i v) = EAliasedValue i (veryUnsafeCoerceSqlExprValue v) +veryUnsafeCoerceSqlExprValue (EValueReference i i') = EValueReference i i' -- | (Internal) Coerce a value's type from 'SqlExpr (ValueList @@ -2636,6 +2740,9 @@ , maybe mempty makeOnClause monClause ] mk _ (OnClause _) = throw (UnexpectedCaseErr MakeFromError) + mk _ (FromQuery ident f) = + let (queryText, queryVals) = f info + in ((parens queryText) <> " AS " <> useIdent info ident, queryVals) base ident@(I identText) def = let db@(DBName dbText) = entityDB def @@ -2652,25 +2759,36 @@ makeOnClause (ERaw _ f) = first (" ON " <>) (f info) makeOnClause (ECompositeKey _) = throw (CompositeKeyErr MakeOnClauseError) + makeOnClause (EAliasedValue _ _) = throw (AliasedValueErr MakeOnClauseError) + makeOnClause (EValueReference _ _) = throw (AliasedValueErr MakeOnClauseError) mkExc :: SqlExpr (Value Bool) -> OnClauseWithoutMatchingJoinException mkExc (ERaw _ f) = OnClauseWithoutMatchingJoinException $ TL.unpack $ TLB.toLazyText $ fst (f info) mkExc (ECompositeKey _) = throw (CompositeKeyErr MakeExcError) + mkExc (EAliasedValue _ _) = throw (AliasedValueErr MakeExcError) + mkExc (EValueReference _ _) = throw (AliasedValueErr MakeExcError) makeSet :: IdentInfo -> [SetClause] -> (TLB.Builder, [PersistValue]) makeSet _ [] = mempty makeSet info os = first ("\nSET " <>) . uncommas' $ concatMap mk os where - mk (SetClause (ERaw _ f)) = [f info] - mk (SetClause (ECompositeKey _)) = throw (CompositeKeyErr MakeSetError) -- FIXME + mk (SetClause (ERaw _ f)) = [f info] + mk (SetClause (ECompositeKey _)) = throw (CompositeKeyErr MakeSetError) -- FIXME + mk (SetClause (EAliasedValue i _)) = [aliasedValueIdentToRawSql i info] + mk (SetClause (EValueReference i i')) = [valueReferenceToRawSql i i' info] makeWhere :: IdentInfo -> WhereClause -> (TLB.Builder, [PersistValue]) -makeWhere _ NoWhere = mempty -makeWhere info (Where (ERaw _ f)) = first ("\nWHERE " <>) (f info) -makeWhere _ (Where (ECompositeKey _)) = throw (CompositeKeyErr MakeWhereError) - +makeWhere _ NoWhere = mempty +makeWhere info (Where v) = first ("\nWHERE " <>) $ x info + where + x = + case v of + ERaw _ f -> f + EAliasedValue i _ -> aliasedValueIdentToRawSql i + EValueReference i i' -> valueReferenceToRawSql i i' + ECompositeKey _ -> throw (CompositeKeyErr MakeWhereError) makeGroupBy :: IdentInfo -> GroupByClause -> (TLB.Builder, [PersistValue]) makeGroupBy _ (GroupBy []) = (mempty, []) @@ -2682,11 +2800,19 @@ match :: SomeValue -> (TLB.Builder, [PersistValue]) match (SomeValue (ERaw _ f)) = f info match (SomeValue (ECompositeKey f)) = (mconcat $ f info, mempty) + match (SomeValue (EAliasedValue i _)) = aliasedValueIdentToRawSql i info + match (SomeValue (EValueReference i i')) = valueReferenceToRawSql i i' info makeHaving :: IdentInfo -> WhereClause -> (TLB.Builder, [PersistValue]) -makeHaving _ NoWhere = mempty -makeHaving info (Where (ERaw _ f)) = first ("\nHAVING " <>) (f info) -makeHaving _ (Where (ECompositeKey _)) = throw (CompositeKeyErr MakeHavingError) +makeHaving _ NoWhere = mempty +makeHaving info (Where v) = first ("\nHAVING " <>) $ x info + where + x = + case v of + ERaw _ f -> f + EAliasedValue i _ -> aliasedValueIdentToRawSql i + EValueReference i i' -> valueReferenceToRawSql i i' + ECompositeKey _ -> throw (CompositeKeyErr MakeHavingError) -- makeHaving, makeWhere and makeOrderBy makeOrderByNoNewline :: @@ -2695,12 +2821,19 @@ makeOrderByNoNewline info os = first ("ORDER BY " <>) . uncommas' $ concatMap mk os where mk :: OrderByClause -> [(TLB.Builder, [PersistValue])] - mk (EOrderBy t (ERaw p f)) = [first ((<> orderByType t) . parensM p) (f info)] mk (EOrderBy t (ECompositeKey f)) = let fs = f info vals = repeat [] in zip (map (<> orderByType t) fs) vals + mk (EOrderBy t v) = + let x = case v of + ERaw p f -> (first (parensM p)) . f + EAliasedValue i _ -> aliasedValueIdentToRawSql i + EValueReference i i' -> valueReferenceToRawSql i i' + ECompositeKey _ -> undefined -- defined above + in [ first (<> orderByType t) $ x info ] mk EOrderRandom = [first (<> "RANDOM()") mempty] + orderByType ASC = " ASC" orderByType DESC = " DESC" @@ -2733,7 +2866,22 @@ parens :: TLB.Builder -> TLB.Builder parens b = "(" <> (b <> ")") +aliasedValueIdentToRawSql :: Ident -> IdentInfo -> (TLB.Builder, [PersistValue]) +aliasedValueIdentToRawSql i info = + (useIdent info i, mempty) +valueReferenceToRawSql :: Ident -> (IdentInfo -> Ident) -> IdentInfo -> (TLB.Builder, [PersistValue]) +valueReferenceToRawSql sourceIdent columnIdentF info = + (useIdent info sourceIdent <> "." <> useIdent info (columnIdentF info), mempty) + +aliasedEntityColumnIdent :: Ident -> FieldDef -> IdentInfo -> Ident +aliasedEntityColumnIdent (I baseIdent) field info = + I (baseIdent <> "_" <> (builderToText $ fromDBName info $ fieldDB field)) + +aliasedColumnName :: Ident -> IdentInfo -> T.Text -> TLB.Builder +aliasedColumnName (I baseIdent) info columnName = + useIdent info (I (baseIdent <> "_" <> columnName)) + ---------------------------------------------------------------------- @@ -2798,10 +2946,28 @@ name = useIdent info ident <> "." ret = let ed = entityDef $ getEntityVal $ return expr in (process ed, mempty) + sqlSelectCols info expr@(EAliasedEntity aliasIdent tableIdent) = ret + where + process ed = uncommas $ + map ((name <>) . aliasName) $ + entityColumnNames ed (fst info) + aliasName columnName = (TLB.fromText columnName) <> " AS " <> aliasedColumnName aliasIdent info columnName + name = useIdent info tableIdent <> "." + ret = let ed = entityDef $ getEntityVal $ return expr + in (process ed, mempty) + sqlSelectCols info expr@(EAliasedEntityReference sourceIdent baseIdent) = ret + where + process ed = uncommas $ + map ((name <>) . aliasedColumnName baseIdent info) $ + entityColumnNames ed (fst info) + name = useIdent info sourceIdent <> "." + ret = let ed = entityDef $ getEntityVal $ return expr + in (process ed, mempty) sqlSelectColCount = entityColumnCount . entityDef . getEntityVal sqlSelectProcessRow = parseEntityValues ed where ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity a))) + getEntityVal :: Proxy (SqlExpr (Entity a)) -> Proxy a getEntityVal = const Proxy @@ -2826,7 +2992,6 @@ sqlSelectProcessRow [pv] = Value <$> fromPersistValue pv sqlSelectProcessRow pvs = Value <$> fromPersistValue (PersistList pvs) - -- | Materialize a @SqlExpr (Value a)@. materializeExpr :: IdentInfo -> SqlExpr (Value a) -> (TLB.Builder, [PersistValue]) materializeExpr info (ERaw p f) = @@ -2835,7 +3000,11 @@ materializeExpr info (ECompositeKey f) = let bs = f info in (uncommas $ map (parensM Parens) bs, []) - +materializeExpr info (EAliasedValue ident x) = + let (b, vals) = materializeExpr info x + in (b <> " AS " <> (useIdent info ident), vals) +materializeExpr info (EValueReference sourceIdent columnIdent) = + valueReferenceToRawSql sourceIdent columnIdent info -- | You may return tuples (up to 16-tuples) and tuples of tuples -- from a 'select' query. @@ -3375,7 +3544,11 @@ . mconcat . mkInfo $ (sqlBackend, initialIdentState) - + EAliasedValue i _ -> + builderToText $ useIdent (sqlBackend, initialIdentState) i + EValueReference i i' -> + let (builder, _) = valueReferenceToRawSql i i' (sqlBackend, initialIdentState) + in (builderToText builder) -- | An exception thrown by 'RenderExpr' - it's not designed to handle composite -- keys, and will blow up if you give it one. -- diff --git a/test/Common/Test.hs b/test/Common/Test.hs --- a/test/Common/Test.hs +++ b/test/Common/Test.hs @@ -70,6 +70,8 @@ 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.Persist.TH import Test.Hspec import UnliftIO @@ -139,13 +141,13 @@ county String maxlen=100 dogs Int Maybe Primary county - deriving Show + deriving Eq Show Deed contract String maxlen=100 ownerId LordId maxlen=100 Primary contract - deriving Show + deriving Eq Show Follow follower PersonId @@ -854,6 +856,133 @@ return p liftIO $ (entityVal <$> ps) `shouldBe` [p1] +testSelectSubQuery :: Run -> Spec +testSelectSubQuery run = do + describe "select subquery" $ do + it "works" $ do + run $ do + _ <- insert' p1 + let q = do + p <- Experimental.from $ Table @Person + return ( p ^. PersonName, p ^. PersonAge) + ret <- select $ Experimental.from $ SelectQuery q + liftIO $ ret `shouldBe` [ (Value $ personName p1, Value $ personAge p1) ] + + it "lets you order by alias" $ do + run $ do + _ <- insert' p1 + _ <- insert' p3 + let q = do + (name, age) <- + Experimental.from $ SubQuery $ do + p <- Experimental.from $ Table @Person + return ( p ^. PersonName, p ^. PersonAge) + orderBy [ asc age ] + pure name + ret <- select q + liftIO $ ret `shouldBe` [ Value $ personName p3, Value $ personName p1 ] + + it "supports groupBy" $ do + run $ do + l1k <- insert l1 + l3k <- insert l3 + mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int]) + + mapM_ (\k -> insert $ Deed k l3k) (map show [4..10 :: Int]) + let q = do + (lord :& deed) <- Experimental.from $ Table @Lord + `InnerJoin` Table @Deed + `Experimental.on` (\(lord :& deed) -> + lord ^. LordId ==. deed ^. DeedOwnerId) + return (lord ^. LordId, deed ^. DeedId) + q' = do + (lordId, deedId) <- Experimental.from $ SubQuery q + groupBy (lordId) + return (lordId, count deedId) + (ret :: [(Value (Key Lord), Value Int)]) <- select q' + + liftIO $ ret `shouldMatchList` [ (Value l3k, Value 7) + , (Value l1k, Value 3) ] + + it "Can count results of aggregate query" $ do + run $ do + l1k <- insert l1 + l3k <- insert l3 + mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int]) + + mapM_ (\k -> insert $ Deed k l3k) (map show [4..10 :: Int]) + let q = do + (lord :& deed) <- Experimental.from $ Table @Lord + `InnerJoin` Table @Deed + `Experimental.on` (\(lord :& deed) -> + lord ^. LordId ==. deed ^. DeedOwnerId) + groupBy (lord ^. LordId) + return (lord ^. LordId, count (deed ^. DeedId)) + + (ret :: [(Value Int)]) <- select $ do + (lordId, deedCount) <- Experimental.from $ SubQuery q + where_ $ deedCount >. val (3 :: Int) + return (count lordId) + + liftIO $ ret `shouldMatchList` [ (Value 1) ] + + it "joins on subqueries" $ do + run $ do + l1k <- insert l1 + l3k <- insert l3 + mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int]) + + mapM_ (\k -> insert $ Deed k l3k) (map show [4..10 :: Int]) + let q = do + (lord :& deed) <- Experimental.from $ Table @Lord + `InnerJoin` (SelectQuery $ Experimental.from $ Table @Deed) + `Experimental.on` (\(lord :& deed) -> + lord ^. LordId ==. deed ^. DeedOwnerId) + groupBy (lord ^. LordId) + return (lord ^. LordId, count (deed ^. DeedId)) + (ret :: [(Value (Key Lord), Value Int)]) <- select q + liftIO $ ret `shouldMatchList` [ (Value l3k, Value 7) + , (Value l1k, Value 3) ] + + it "flattens maybe values" $ do + run $ do + l1k <- insert l1 + l3k <- insert l3 + let q = do + (lord :& (_, dogCounts)) <- Experimental.from $ Table @Lord + `LeftOuterJoin` (SelectQuery $ do + lord <- Experimental.from $ Table @Lord + pure (lord ^. LordId, lord ^. LordDogs) + ) + `Experimental.on` (\(lord :& (lordId, _)) -> + just (lord ^. LordId) ==. lordId) + groupBy (lord ^. LordId, dogCounts) + return (lord ^. LordId, dogCounts) + (ret :: [(Value (Key Lord), Value (Maybe Int))]) <- select q + liftIO $ ret `shouldMatchList` [ (Value l3k, Value (lordDogs l3)) + , (Value l1k, Value (lordDogs l1)) ] + it "unions" $ do + run $ do + _ <- insert p1 + _ <- insert p2 + let q = Experimental.from $ + (SelectQuery $ do + p <- Experimental.from $ Table @Person + where_ $ not_ $ isNothing $ p ^. PersonAge + return (p ^. PersonName)) + `Union` + (SelectQuery $ do + p <- Experimental.from $ Table @Person + where_ $ isNothing $ p ^. PersonAge + return (p ^. PersonName)) + `Union` + (SelectQuery $ do + p <- Experimental.from $ Table @Person + where_ $ isNothing $ p ^. PersonAge + return (p ^. PersonName)) + names <- select q + liftIO $ names `shouldMatchList` [ (Value $ personName p1) + , (Value $ personName p2) ] testSelectWhere :: Run -> Spec testSelectWhere run = do describe "select where_" $ do @@ -2272,6 +2401,97 @@ on $ baz ^. BazId ==. shoop ^. ShoopBaz pure (f ^. FooName) +testExperimentalFrom :: Run -> Spec +testExperimentalFrom run = do + describe "Experimental From" $ do + it "supports basic table queries" $ do + run $ do + p1e <- insert' p1 + _ <- insert' p2 + p3e <- insert' p3 + peopleWithAges <- select $ do + people <- Experimental.from $ Table @Person + where_ $ not_ $ isNothing $ people ^. PersonAge + return people + liftIO $ peopleWithAges `shouldMatchList` [p1e, p3e] + + it "supports inner joins" $ do + run $ do + l1e <- insert' l1 + _ <- insert l2 + d1e <- insert' $ Deed "1" (entityKey l1e) + d2e <- insert' $ Deed "2" (entityKey l1e) + lordDeeds <- select $ do + (lords :& deeds) <- + Experimental.from $ Table @Lord + `InnerJoin` Table @Deed + `Experimental.on` (\(l :& d) -> l ^. LordId ==. d ^. DeedOwnerId) + pure (lords, deeds) + liftIO $ lordDeeds `shouldMatchList` [ (l1e, d1e) + , (l1e, d2e) + ] + + it "supports outer joins" $ do + run $ do + l1e <- insert' l1 + l2e <- insert' l2 + d1e <- insert' $ Deed "1" (entityKey l1e) + d2e <- insert' $ Deed "2" (entityKey l1e) + lordDeeds <- select $ do + (lords :& deeds) <- + Experimental.from $ Table @Lord + `LeftOuterJoin` Table @Deed + `Experimental.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId) + + pure (lords, deeds) + liftIO $ lordDeeds `shouldMatchList` [ (l1e, Just d1e) + , (l1e, Just d2e) + , (l2e, Nothing) + ] + it "supports delete" $ do + run $ do + insert_ l1 + insert_ l2 + insert_ l3 + delete $ void $ Experimental.from $ Table @Lord + lords <- select $ Experimental.from $ Table @Lord + liftIO $ lords `shouldMatchList` [] + + it "supports implicit cross joins" $ do + run $ do + l1e <- insert' l1 + l2e <- insert' l2 + ret <- select $ do + lords1 <- Experimental.from $ Table @Lord + lords2 <- Experimental.from $ Table @Lord + pure (lords1, lords2) + ret2 <- select $ do + (lords1 :& lords2) <- Experimental.from $ Table @Lord `CrossJoin` Table @Lord + pure (lords1,lords2) + liftIO $ ret `shouldMatchList` ret2 + liftIO $ ret `shouldMatchList` [ (l1e, l1e) + , (l1e, l2e) + , (l2e, l1e) + , (l2e, l2e) + ] + + + it "compiles" $ do + run $ void $ do + let q = do + (persons :& profiles :& posts) <- + Experimental.from $ Table @Person + `InnerJoin` Table @Profile + `Experimental.on` (\(people :& profiles) -> + people ^. PersonId ==. profiles ^. ProfilePerson) + `LeftOuterJoin` Table @BlogPost + `Experimental.on` (\(people :& _ :& posts) -> + just (people ^. PersonId) ==. posts ?. BlogPostAuthorId) + pure (persons, posts, profiles) + --error . show =<< renderQuerySelect q + pure () + + listsEqualOn :: (Show a1, Eq a1) => [a2] -> [a2] -> (a2 -> a1) -> Expectation listsEqualOn a b f = map f a `shouldBe` map f b @@ -2283,6 +2503,7 @@ testSelectSource run testSelectFrom run testSelectJoin run + testSelectSubQuery run testSelectWhere run testSelectOrderBy run testSelectDistinct run @@ -2297,6 +2518,7 @@ testCountingRows run testRenderSql run testOnClauseOrder run + testExperimentalFrom run insert' :: ( Functor m