{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -- | This module contains a new way (introduced in 3.3.3.0) of using @FROM@ in -- Haskell. The old method was a bit finicky and could permit runtime errors, -- and this new way is both significantly safer and much more powerful. -- -- Esqueleto users are encouraged to migrate to this module, as it will become -- the default in a new major version @4.0.0.0@. module Database.Esqueleto.Experimental ( -- * Setup -- $setup -- * Introduction -- $introduction -- * A New Syntax -- $new-syntax -- * Documentation From(..) , on , from , (:&)(..) -- ** Set Operations -- $sql-set-operations , union_ , Union(..) , unionAll_ , UnionAll(..) , except_ , Except(..) , intersect_ , Intersect(..) , pattern SelectQuery -- ** Common Table Expressions , with , withRecursive -- * Internals , ToFrom(..) , ToMaybe(..) , ToAlias(..) , ToAliasT , ToAliasReference(..) , ToAliasReferenceT , ValidOnClauseValue -- * The Normal Stuff , where_ , groupBy , orderBy , rand , asc , desc , limit , offset , distinct , distinctOn , don , distinctOnOrderBy , having , locking , sub_select , (^.) , (?.) , val , isNothing , just , nothing , joinV , withNonNull , countRows , count , countDistinct , not_ , (==.) , (>=.) , (>.) , (<=.) , (<.) , (!=.) , (&&.) , (||.) , between , (+.) , (-.) , (/.) , (*.) , random_ , round_ , ceiling_ , floor_ , min_ , max_ , sum_ , avg_ , castNum , castNumM , coalesce , coalesceDefault , lower_ , upper_ , trim_ , ltrim_ , rtrim_ , length_ , left_ , right_ , like , ilike , (%) , concat_ , (++.) , castString , subList_select , valList , justList , in_ , notIn , exists , notExists , set , (=.) , (+=.) , (-=.) , (*=.) , (/=.) , case_ , toBaseId , subSelect , subSelectMaybe , subSelectCount , subSelectForeign , subSelectList , subSelectUnsafe , ToBaseId(..) , when_ , then_ , else_ , Value(..) , ValueList(..) , OrderBy , DistinctOn , LockingKind(..) , SqlString -- ** Joins , InnerJoin(..) , CrossJoin(..) , LeftOuterJoin(..) , RightOuterJoin(..) , FullOuterJoin(..) , JoinKind(..) , OnClauseWithoutMatchingJoinException(..) -- * SQL backend , SqlQuery , SqlExpr , SqlEntity , select , selectSource , delete , deleteCount , update , updateCount , insertSelect , insertSelectCount , (<#) , (<&>) -- ** Rendering Queries , renderQueryToText , renderQuerySelect , renderQueryUpdate , renderQueryDelete , renderQueryInsertInto -- * Internal.Language -- * RDBMS-specific modules -- $rdbmsSpecificModules -- * Helpers , valkey , valJ , associateJoin -- * Re-exports -- $reexports , deleteKey , module Database.Esqueleto.Internal.PersistentImport ) where import Control.Monad.Trans.Class (lift) import qualified Control.Monad.Trans.State as S import qualified Control.Monad.Trans.Writer as W #if __GLASGOW_HASKELL__ < 804 import Data.Semigroup #endif import Data.Kind (Constraint) import Data.Proxy (Proxy(..)) import qualified Data.Text.Lazy.Builder as TLB import Database.Esqueleto.Internal.Internal hiding (From, from, on) import Database.Esqueleto.Internal.PersistentImport import GHC.TypeLits import Database.Persist (EntityNameDB(..)) -- $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.Experimental -- @ -- -- Note: Prior to @esqueleto-3.3.4.0@, the @Database.Esqueleto.Experimental@ -- module did not reexport @Data.Esqueleto@. ---------------------------------------------------------------------- -- $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 $ 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 $ -- (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_\` -- (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) -- @ -- -- === Example 6: LATERAL JOIN -- -- As of version @3.4.0.0@, lateral subquery joins are supported. -- -- -- @ -- select $ do -- (salesPerson :& maxSaleAmount :& maxSaleCustomerName) <- -- from $ Table \@SalesPerson -- \`CrossJoin\` (\\salesPerson -> do -- sales <- from $ Table \@Sale -- where_ $ sales ^. SaleSalesPersonId ==. salesPerson ^. SalesPersonId -- pure $ max_ (sales ^. SaleAmount) -- ) -- \`CrossJoin\` (\\(salesPerson :& maxSaleAmount) -> do -- sales <- from $ Table \@Sale -- where_ $ sales ^. SaleSalesPersonId ==. salesPerson ^. SalesPersonId -- &&. sales ^. SaleAmount ==. maxSaleAmount -- pure $ sales ^. SaleCustomerName) -- ) -- pure (salesPerson ^. SalesPersonName, maxSaleAmount, maxSaleCustomerName) -- @ -- -- This is the equivalent to the following SQL (example taken from the -- [MySQL Lateral Derived Table](https://dev.mysql.com/doc/refman/8.0/en/lateral-derived-tables.html) -- documentation): -- -- @ -- SELECT -- salesperson.name, -- max_sale.amount, -- max_sale_customer.customer_name -- FROM -- salesperson, -- -- calculate maximum size, cache it in transient derived table max_sale -- LATERAL -- (SELECT MAX(amount) AS amount -- FROM all_sales -- WHERE all_sales.salesperson_id = salesperson.id) -- AS max_sale, -- LATERAL -- (SELECT customer_name -- FROM all_sales -- WHERE all_sales.salesperson_id = salesperson.id -- AND all_sales.amount = -- -- the cached maximum size -- max_sale.amount) -- AS max_sale_customer; -- @ -- | A left-precedence pair. Pronounced \"and\". Used to represent expressions -- that have been joined together. -- -- 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 SqlSetOperation a = SqlSetUnion (SqlSetOperation a) (SqlSetOperation a) | SqlSetUnionAll (SqlSetOperation a) (SqlSetOperation a) | SqlSetExcept (SqlSetOperation a) (SqlSetOperation a) | SqlSetIntersect (SqlSetOperation a) (SqlSetOperation a) | SelectQueryP NeedParens (SqlQuery a) -- $sql-set-operations -- -- Data type that represents SQL set operations. This includes -- 'UNION', 'UNION' 'ALL', 'EXCEPT', and 'INTERSECT'. These types form -- a binary tree, with @SqlQuery@ values on the leaves. -- -- Each function corresponding to the aforementioned set operations -- can be used as an infix in a @from@ to help with readability -- and lead to code that closely resembles the underlying SQL. For example, -- -- @ -- select $ from $ -- (do -- a <- from Table @A -- pure $ a ^. ASomeCol -- ) -- \`union_\` -- (do -- b <- from Table @B -- pure $ b ^. BSomeCol -- ) -- @ -- -- is translated into -- -- @ -- SELECT * FROM ( -- (SELECT a.some_col FROM a) -- UNION -- (SELECT b.some_col FROM b) -- ) -- @ -- {-# DEPRECATED Union "/Since: 3.4.0.0/ - Use the 'union_' function instead of the 'Union' data constructor" #-} data Union a b = a `Union` b -- | @UNION@ SQL set operation. Can be used as an infix function between 'SqlQuery' values. union_ :: a -> b -> Union a b union_ = Union {-# DEPRECATED UnionAll "/Since: 3.4.0.0/ - Use the 'unionAll_' function instead of the 'UnionAll' data constructor" #-} data UnionAll a b = a `UnionAll` b -- | @UNION@ @ALL@ SQL set operation. Can be used as an infix function between 'SqlQuery' values. unionAll_ :: a -> b -> UnionAll a b unionAll_ = UnionAll {-# DEPRECATED Except "/Since: 3.4.0.0/ - Use the 'except_' function instead of the 'Except' data constructor" #-} data Except a b = a `Except` b -- | @EXCEPT@ SQL set operation. Can be used as an infix function between 'SqlQuery' values. except_ :: a -> b -> Except a b except_ = Except {-# DEPRECATED Intersect "/Since: 3.4.0.0/ - Use the 'intersect_' function instead of the 'Intersect' data constructor" #-} data Intersect a b = a `Intersect` b -- | @INTERSECT@ SQL set operation. Can be used as an infix function between 'SqlQuery' values. intersect_ :: a -> b -> Intersect a b intersect_ = Intersect class SetOperationT a ~ b => ToSetOperation a b | a -> b where type SetOperationT a toSetOperation :: a -> SqlSetOperation b instance ToSetOperation (SqlSetOperation a) a where type SetOperationT (SqlSetOperation a) = a toSetOperation = id instance ToSetOperation (SqlQuery a) a where type SetOperationT (SqlQuery a) = a toSetOperation = SelectQueryP Never instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (Union a b) c where type SetOperationT (Union a b) = SetOperationT a toSetOperation (Union a b) = SqlSetUnion (toSetOperation a) (toSetOperation b) instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (UnionAll a b) c where type SetOperationT (UnionAll a b) = SetOperationT a toSetOperation (UnionAll a b) = SqlSetUnionAll (toSetOperation a) (toSetOperation b) instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (Except a b) c where type SetOperationT (Except a b) = SetOperationT a toSetOperation (Except a b) = SqlSetExcept (toSetOperation a) (toSetOperation b) instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (Intersect a b) c where type SetOperationT (Intersect a b) = SetOperationT a toSetOperation (Intersect a b) = SqlSetIntersect (toSetOperation a) (toSetOperation b) {-# DEPRECATED SelectQuery "/Since: 3.4.0.0/ - It is no longer necessary to tag 'SqlQuery' values with @SelectQuery@" #-} pattern SelectQuery :: SqlQuery a -> SqlSetOperation a pattern SelectQuery q = SelectQueryP Never q -- | Data type that represents the syntax of a 'JOIN' tree. In practice, -- only the @Table@ constructor is used directly when writing queries. For example, -- -- @ -- select $ from $ Table \@People -- @ data From a where Table :: PersistEntity ent => From (SqlExpr (Entity ent)) SubQuery :: ( SqlSelect a r , ToAlias a , ToAliasReference a ) => SqlQuery a -> From a FromCte :: Ident -> a -> From a SqlSetOperation :: ( SqlSelect a r , ToAlias a , ToAliasReference a ) => SqlSetOperation a -> From a InnerJoinFrom :: From a -> (From b, (a :& b) -> SqlExpr (Value Bool)) -> From (a :& b) InnerJoinFromLateral :: ( SqlSelect b r , ToAlias b , ToAliasReference b ) => From a -> ((a -> SqlQuery b), (a :& b) -> SqlExpr (Value Bool)) -> From (a :& b) CrossJoinFrom :: From a -> From b -> From (a :& b) CrossJoinFromLateral :: ( SqlSelect b r , ToAlias b , ToAliasReference b ) => From a -> (a -> SqlQuery b) -> From (a :& b) LeftJoinFrom :: ToMaybe b => From a -> (From b, (a :& ToMaybeT b) -> SqlExpr (Value Bool)) -> From (a :& ToMaybeT b) LeftJoinFromLateral :: ( SqlSelect b r , ToAlias b , ToAliasReference b , ToMaybe b ) => From a -> ((a -> SqlQuery b), (a :& ToMaybeT b) -> SqlExpr (Value Bool)) -> From (a :& ToMaybeT b) RightJoinFrom :: ToMaybe a => From a -> (From b, (ToMaybeT a :& b) -> SqlExpr (Value Bool)) -> From (ToMaybeT a :& b) FullJoinFrom :: (ToMaybe a, ToMaybe b ) => From a -> (From b, (ToMaybeT a :& ToMaybeT b) -> SqlExpr (Value Bool)) -> From (ToMaybeT a :& ToMaybeT b) -- | Constraint for `on`. Ensures that only types that require an `on` can be used on -- the left hand side. This was previously reusing the ToFrom class which was actually -- a bit too lenient as it allowed to much. -- -- @since 3.4.0.0 type family ValidOnClauseValue a :: Constraint where ValidOnClauseValue (From a) = () ValidOnClauseValue (SqlQuery a) = () ValidOnClauseValue (SqlSetOperation a) = () ValidOnClauseValue (a -> SqlQuery b) = () ValidOnClauseValue _ = TypeError ('Text "Illegal use of ON") -- | 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 :: ValidOnClauseValue a => a -> (b -> SqlExpr (Value Bool)) -> (a, b -> SqlExpr (Value Bool)) on = (,) infix 9 `on` data Lateral data NotLateral type family IsLateral a where IsLateral (a -> SqlQuery b) = Lateral IsLateral a = NotLateral 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 _ = () {-- Type class magic to allow the use of the `InnerJoin` family of data constructors in from --} class ToFrom a where type ToFromT a toFrom :: a -> From (ToFromT a) -- @since 3.4.0.1 type family FromOnClause a where FromOnClause (a, b -> SqlExpr (Value Bool)) = b FromOnClause a = TypeError ('Text "Missing ON clause") instance {-# OVERLAPPABLE #-} ToFrom (InnerJoin a b) where type ToFromT (InnerJoin a b) = FromOnClause b toFrom = undefined instance {-# OVERLAPPABLE #-} ToFrom (LeftOuterJoin a b) where type ToFromT (LeftOuterJoin a b) = FromOnClause b toFrom = undefined instance {-# OVERLAPPABLE #-} ToFrom (FullOuterJoin a b) where type ToFromT (FullOuterJoin a b) = FromOnClause b toFrom = undefined instance {-# OVERLAPPABLE #-} ToFrom (RightOuterJoin a b) where type ToFromT (RightOuterJoin a b) = FromOnClause b toFrom = undefined instance ToFrom (From a) where type ToFromT (From a) = a toFrom = id instance ( ToAlias a , ToAliasReference a , SqlSelect a r ) => ToFrom (SqlQuery a) where type ToFromT (SqlQuery a) = a toFrom = SubQuery instance ( SqlSelect c r , ToAlias c , ToAliasReference c , ToSetOperation a c , ToSetOperation b c , c ~ SetOperationT a ) => ToFrom (Union a b) where type ToFromT (Union a b) = SetOperationT a toFrom u = SqlSetOperation $ toSetOperation u instance ( SqlSelect c r , ToAlias c , ToAliasReference c , ToSetOperation a c , ToSetOperation b c , c ~ SetOperationT a ) => ToFrom (UnionAll a b) where type ToFromT (UnionAll a b) = SetOperationT a toFrom u = SqlSetOperation $ toSetOperation u instance ( SqlSelect c r , ToAlias c , ToAliasReference c , ToSetOperation a c , ToSetOperation b c , c ~ SetOperationT a ) => ToFrom (Intersect a b) where type ToFromT (Intersect a b) = SetOperationT a toFrom u = SqlSetOperation $ toSetOperation u instance ( SqlSelect c r , ToAlias c , ToAliasReference c , ToSetOperation a c , ToSetOperation b c , c ~ SetOperationT a ) => ToFrom (Except a b) where type ToFromT (Except a b) = SetOperationT a toFrom u = SqlSetOperation $ toSetOperation u instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToFrom (SqlSetOperation a) where type ToFromT (SqlSetOperation a) = a -- If someone uses just a plain SelectQuery it should behave like a normal subquery toFrom (SelectQueryP _ q) = SubQuery q -- Otherwise use the SqlSetOperation toFrom q = SqlSetOperation q class ToInnerJoin lateral lhs rhs res where toInnerJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> From res instance ( SqlSelect b r , ToAlias b , ToAliasReference b , ToFrom a , ToFromT a ~ a' ) => ToInnerJoin Lateral a (a' -> SqlQuery b) (a' :& b) where toInnerJoin _ lhs q on' = InnerJoinFromLateral (toFrom lhs) (q, on') instance (ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b') => ToInnerJoin NotLateral a b (a' :& b') where toInnerJoin _ lhs rhs on' = InnerJoinFrom (toFrom lhs) (toFrom rhs, on') instance (ToInnerJoin (IsLateral b) a b b') => ToFrom (InnerJoin a (b, b' -> SqlExpr (Value Bool))) where type ToFromT (InnerJoin a (b, b' -> SqlExpr (Value Bool))) = FromOnClause (b, b' -> SqlExpr(Value Bool)) toFrom (InnerJoin lhs (rhs, on')) = toInnerJoin (toProxy rhs) lhs rhs on' where toProxy :: b -> Proxy (IsLateral b) toProxy _ = Proxy -- @since 3.4.0.1 type family FromCrossJoin a b where FromCrossJoin a (b -> SqlQuery c) = ToFromT a :& c FromCrossJoin a b = ToFromT a :& ToFromT b instance ( ToFrom a , ToFrom b , ToFromT (CrossJoin a b) ~ (ToFromT a :& ToFromT b) ) => ToFrom (CrossJoin a b) where type ToFromT (CrossJoin a b) = FromCrossJoin a b toFrom (CrossJoin lhs rhs) = CrossJoinFrom (toFrom lhs) (toFrom rhs) instance {-# OVERLAPPING #-} ( ToFrom a , ToFromT a ~ a' , SqlSelect b r , ToAlias b , ToAliasReference b ) => ToFrom (CrossJoin a (a' -> SqlQuery b)) where type ToFromT (CrossJoin a (a' -> SqlQuery b)) = FromCrossJoin a (a' -> SqlQuery b) toFrom (CrossJoin lhs q) = CrossJoinFromLateral (toFrom lhs) q class ToLeftJoin lateral lhs rhs res where toLeftJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> From res instance ( ToFrom a , ToFromT a ~ a' , SqlSelect b r , ToAlias b , ToAliasReference b , ToMaybe b , mb ~ ToMaybeT b ) => ToLeftJoin Lateral a (a' -> SqlQuery b) (a' :& mb) where toLeftJoin _ lhs q on' = LeftJoinFromLateral (toFrom lhs) (q, on') instance ( ToFrom a , ToFromT a ~ a' , ToFrom b , ToFromT b ~ b' , ToMaybe b' , mb ~ ToMaybeT b' ) => ToLeftJoin NotLateral a b (a' :& mb) where toLeftJoin _ lhs rhs on' = LeftJoinFrom (toFrom lhs) (toFrom rhs, on') instance ( ToLeftJoin (IsLateral b) a b b' ) => ToFrom (LeftOuterJoin a (b, b' -> SqlExpr (Value Bool))) where type ToFromT (LeftOuterJoin a (b, b' -> SqlExpr (Value Bool))) = FromOnClause (b, b' -> SqlExpr(Value Bool)) toFrom (LeftOuterJoin lhs (rhs, on')) = toLeftJoin (toProxy rhs) lhs rhs on' where toProxy :: b -> Proxy (IsLateral b) toProxy _ = Proxy instance ( ToFrom a , ToFromT a ~ a' , ToFrom b , ToFromT b ~ b' , ToMaybe a' , ma ~ ToMaybeT a' , ToMaybe b' , mb ~ ToMaybeT b' , ErrorOnLateral b ) => ToFrom (FullOuterJoin a (b, (ma :& mb) -> SqlExpr (Value Bool))) where type ToFromT (FullOuterJoin a (b, (ma :& mb) -> SqlExpr (Value Bool))) = FromOnClause (b, (ma :& mb) -> SqlExpr(Value Bool)) toFrom (FullOuterJoin lhs (rhs, on')) = FullJoinFrom (toFrom lhs) (toFrom rhs, on') instance ( ToFrom a , ToFromT a ~ a' , ToMaybe a' , ma ~ ToMaybeT a' , ToFrom b , ToFromT b ~ b' , ErrorOnLateral b ) => ToFrom (RightOuterJoin a (b, (ma :& b') -> SqlExpr (Value Bool))) where type ToFromT (RightOuterJoin a (b, (ma :& b') -> SqlExpr (Value Bool))) = FromOnClause (b, (ma :& b') -> SqlExpr(Value Bool)) toFrom (RightOuterJoin lhs (rhs, on')) = RightJoinFrom (toFrom lhs) (toFrom rhs, on') 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 (Maybe a)) where type ToMaybeT (SqlExpr (Maybe a)) = SqlExpr (Maybe a) toMaybe = id instance ToMaybe (SqlExpr (Entity a)) where type ToMaybeT (SqlExpr (Entity a)) = SqlExpr (Maybe (Entity a)) toMaybe = EMaybe instance ToMaybe (SqlExpr (Value a)) where type ToMaybeT (SqlExpr (Value a)) = SqlExpr (Value (Maybe (Nullable a))) toMaybe = veryUnsafeCoerceSqlExprValue 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 (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 -- | '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 . DBName . unEntityNameDB $ getEntityDBName ed let entity = EEntity ident pure $ (entity, FromStart ident ed) where getVal :: From (SqlExpr (Entity ent)) -> Proxy ent getVal = const Proxy runFrom (SubQuery subquery) = fromSubQuery NormalSubQuery subquery runFrom (FromCte ident ref) = pure (ref, FromIdent ident) runFrom (SqlSetOperation operation) = do (aliasedOperation, ret) <- aliasQueries operation ident <- newIdentFor (DBName "u") ref <- toAliasReference ident ret pure (ref, FromQuery ident (operationToSql aliasedOperation) NormalSubQuery) where aliasQueries o = case o of SelectQueryP p 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 let p' = case p of Parens -> Parens Never -> if (sdLimitClause sideData) /= mempty || length (sdOrderByClause sideData) > 0 then Parens else Never pure (SelectQueryP p' $ Q $ W.WriterT $ pure (aliasedRet, sideData), aliasedRet) SqlSetUnion o1 o2 -> do (o1', ret) <- aliasQueries o1 (o2', _ ) <- aliasQueries o2 pure (SqlSetUnion o1' o2', ret) SqlSetUnionAll o1 o2 -> do (o1', ret) <- aliasQueries o1 (o2', _ ) <- aliasQueries o2 pure (SqlSetUnionAll o1' o2', ret) SqlSetExcept o1 o2 -> do (o1', ret) <- aliasQueries o1 (o2', _ ) <- aliasQueries o2 pure (SqlSetExcept o1' o2', ret) SqlSetIntersect o1 o2 -> do (o1', ret) <- aliasQueries o1 (o2', _ ) <- aliasQueries o2 pure (SqlSetIntersect o1' o2', ret) operationToSql o info = case o of SelectQueryP p q -> let (builder, values) = toRawSql SELECT info q in (parensM p builder, values) SqlSetUnion o1 o2 -> doSetOperation "UNION" info o1 o2 SqlSetUnionAll o1 o2 -> doSetOperation "UNION ALL" info o1 o2 SqlSetExcept o1 o2 -> doSetOperation "EXCEPT" info o1 o2 SqlSetIntersect o1 o2 -> doSetOperation "INTERSECT" info o1 o2 doSetOperation operationText info o1 o2 = let (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 (InnerJoinFromLateral leftPart (q, on')) = do (leftVal, leftFrom) <- runFrom leftPart (rightVal, rightFrom) <- fromSubQuery LateralSubQuery (q leftVal) let ret = leftVal :& rightVal pure $ (ret, FromJoin leftFrom InnerJoinKind rightFrom (Just (on' ret))) runFrom (CrossJoinFrom leftPart rightPart) = do (leftVal, leftFrom) <- runFrom leftPart (rightVal, rightFrom) <- runFrom rightPart let ret = leftVal :& rightVal pure $ (ret, FromJoin leftFrom CrossJoinKind rightFrom Nothing) runFrom (CrossJoinFromLateral leftPart q) = do (leftVal, leftFrom) <- runFrom leftPart (rightVal, rightFrom) <- fromSubQuery LateralSubQuery (q leftVal) let ret = leftVal :& rightVal pure $ (ret, FromJoin leftFrom CrossJoinKind rightFrom Nothing) runFrom (LeftJoinFrom leftPart (rightPart, on')) = do (leftVal, leftFrom) <- runFrom leftPart (rightVal, rightFrom) <- runFrom rightPart let ret = leftVal :& (toMaybe rightVal) pure $ (ret, FromJoin leftFrom LeftOuterJoinKind rightFrom (Just (on' ret))) runFrom (LeftJoinFromLateral leftPart (q, on')) = do (leftVal, leftFrom) <- runFrom leftPart (rightVal, rightFrom) <- fromSubQuery LateralSubQuery (q leftVal) let ret = leftVal :& (toMaybe rightVal) pure $ (ret, FromJoin leftFrom LeftOuterJoinKind rightFrom (Just (on' ret))) runFrom (RightJoinFrom leftPart (rightPart, on')) = do (leftVal, leftFrom) <- runFrom leftPart (rightVal, rightFrom) <- runFrom rightPart 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))) fromSubQuery :: ( SqlSelect a r , ToAlias a , ToAliasReference a ) => SubQueryType -> SqlQuery a -> SqlQuery (a, FromClause) fromSubQuery subqueryType subquery = do -- We want to update the IdentState without writing the query to side data (ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ subquery aliasedValue <- toAlias ret -- Make a fake query with the aliased results, this allows us to ensure that the query is only run once let aliasedQuery = Q $ W.WriterT $ pure (aliasedValue, sideData) -- Add the FromQuery that renders the subquery to our side data subqueryAlias <- newIdentFor (DBName "q") -- Pass the aliased results of the subquery to the outer query -- create aliased references from the outer query results (e.g value from subquery will be `subquery`.`value`), -- this is probably overkill as the aliases should already be unique but seems to be good practice. ref <- toAliasReference subqueryAlias aliasedValue pure (ref , FromQuery subqueryAlias (\info -> toRawSql SELECT info aliasedQuery) subqueryType) -- | @WITH@ clause used to introduce a [Common Table Expression (CTE)](https://en.wikipedia.org/wiki/Hierarchical_and_recursive_queries_in_SQL#Common_table_expression). -- CTEs are supported in most modern SQL engines and can be useful -- in performance tuning. In Esqueleto, CTEs should be used as a -- subquery memoization tactic. 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 $ FromCte ident ref -- | @WITH@ @RECURSIVE@ allows one to make a recursive subquery, which can -- reference itself. Like @WITH@, this is supported in most modern SQL engines. -- Useful for hierarchical, self-referential data, like a tree of data. -- -- @ -- select $ do -- cte <- withRecursive -- (do $ -- person <- from $ Table \@Person -- where_ $ person ^. PersonId ==. val personId -- pure person -- ) -- unionAll_ -- (\\self -> do $ -- (p :& f :& p2 :& pSelf) <- from self -- \`InnerJoin\` $ Table \@Follow -- \`on\` (\\(p :& f) -> -- p ^. PersonId ==. f ^. FollowFollower) -- \`InnerJoin\` $ Table \@Person -- \`on\` (\\(p :& f :& p2) -> -- f ^. FollowFollowed ==. p2 ^. PersonId) -- \`LeftOuterJoin\` self -- \`on\` (\\(_ :& _ :& p2 :& pSelf) -> -- just (p2 ^. PersonId) ==. pSelf ?. PersonId) -- where_ $ isNothing (pSelf ?. PersonId) -- groupBy (p2 ^. PersonId) -- pure p2 -- ) -- from cte -- @ -- -- /Since: 3.4.0.0/ withRecursive :: ( ToAlias a , ToAliasReference a , SqlSelect a r , RecursiveCteUnion unionKind ) => 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 = FromCte ident ref let recursiveQuery = recursiveCase refFrom let clause = CommonTableExpressionClause RecursiveCommonTableExpression ident (\info -> (toRawSql SELECT info aliasedQuery) <> (unionKeyword unionKind, mempty) <> (toRawSql SELECT info recursiveQuery) ) Q $ W.tell mempty{sdCteClause = [clause]} pure refFrom {-# 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 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 (SqlExpr (Maybe (Entity a))) where toAlias (EMaybe e) = EMaybe <$> toAlias e 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) {-# 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 ToAliasReference (SqlExpr (Value a)) where toAliasReference aliasSource (EAliasedValue aliasIdent _) = pure $ EValueReference aliasSource (\_ -> aliasIdent) toAliasReference _ v@(ERaw _ _) = toAlias v toAliasReference _ v@(ECompositeKey _) = toAlias v toAliasReference s (EValueReference _ b) = pure $ EValueReference s b instance ToAliasReference (SqlExpr (Entity a)) where toAliasReference aliasSource (EAliasedEntity ident _) = pure $ EAliasedEntityReference aliasSource ident toAliasReference _ e@(EEntity _) = toAlias e toAliasReference s (EAliasedEntityReference _ b) = pure $ EAliasedEntityReference s b instance ToAliasReference (SqlExpr (Maybe (Entity a))) where toAliasReference s (EMaybe e) = EMaybe <$> toAliasReference s 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) class RecursiveCteUnion a where unionKeyword :: a -> TLB.Builder instance RecursiveCteUnion (a -> b -> Union a b) where unionKeyword _ = "\nUNION\n" instance RecursiveCteUnion (a -> b -> UnionAll a b) where unionKeyword _ = "\nUNION ALL\n"