Convert all of experimental to use new From type instead of From type class. Make the data constructors second class, functions should be used. Introduce *Lateral functions, using the same type for lateral and non lateral queries was probably a mistake.

2021-02-11 11:43:16 -06:00 · 2021-02-11 11:43:16 -06:00 · dd8814e678
commit dd8814e678
parent 7a579e921a
5 changed files with 375 additions and 449 deletions
--- a/src/Database/Esqueleto/Experimental.hs
+++ b/src/Database/Esqueleto/Experimental.hs
@ -47,7 +47,7 @@ module Database.Esqueleto.Experimental
    , ToAliasT
    , ToAliasReference(..)
    , ToAliasReferenceT
-    , ToSetOperation(..)
+    , ToSqlSetOperation(..)
    , ValidOnClauseValue
    -- * The Normal Stuff

--- a/src/Database/Esqueleto/Experimental/From.hs
+++ b/src/Database/Esqueleto/Experimental/From.hs
@ -1,28 +1,32 @@
-{-# LANGUAGE CPP                    #-}
-{-# LANGUAGE DataKinds              #-}
-{-# LANGUAGE FlexibleContexts       #-}
-{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GADTs                  #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE OverloadedStrings      #-}
-{-# LANGUAGE PatternSynonyms        #-}
-{-# LANGUAGE TypeFamilies           #-}
-{-# LANGUAGE TypeOperators          #-}
-{-# LANGUAGE UndecidableInstances   #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}

 module Database.Esqueleto.Experimental.From
    where

-import qualified Control.Monad.Trans.Writer                       as W
-import           Data.Proxy
-import qualified Data.Text.Lazy.Builder                           as TLB
-import           Database.Esqueleto.Experimental.ToAlias
-import           Database.Esqueleto.Experimental.ToAliasReference
-import           Database.Esqueleto.Internal.Internal             hiding
-                                                                  (From (..),
-                                                                   from, on)
-import           Database.Esqueleto.Internal.PersistentImport
+import Control.Arrow (first)
+import Control.Monad (ap)
+import qualified Control.Monad.Trans.Writer as W
+import Data.Proxy
+import qualified Data.Text.Lazy.Builder as TLB
+import Database.Esqueleto.Experimental.ToAlias
+import Database.Esqueleto.Experimental.ToAliasReference
+import Database.Esqueleto.Internal.Internal hiding (From(..), from, on)
+import Database.Esqueleto.Internal.PersistentImport

 -- | 'FROM' clause, used to bring entities into scope.
 --
@ -33,16 +37,20 @@ import           Database.Esqueleto.Internal.PersistentImport
 -- instances of `From`. This implementation eliminates certain
 -- types of runtime errors by preventing the construction of
 -- invalid SQL (e.g. illegal nested-@from@).
-from :: From a  => a -> SqlQuery (FromT a)
-from parts = do
-    (a, clause) <- runFrom parts
-    Q $ W.tell mempty{sdFromClause=[FromRaw clause]}
+from :: ToFrom a a' => a -> SqlQuery a'
+from f = do
+    (a, clause) <- unFrom (toFrom f)
+    Q $ W.tell mempty{sdFromClause=[FromRaw $ clause]}
    pure a

 type RawFn = NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])
-class From a where
-    type FromT a
-    runFrom :: a -> SqlQuery (FromT a, RawFn)
+newtype From a = From
+    { unFrom :: SqlQuery (a, RawFn)}
+
+class ToFrom a r | a -> r where
+    toFrom :: a -> From r
+instance ToFrom (From a) a where
+    toFrom = id

 -- | Data type for bringing a Table into scope in a JOIN tree
 --
@ -50,63 +58,35 @@ class From a where
 -- select $ from $ Table \@People
 -- @
 data Table a = Table
+instance PersistEntity ent => ToFrom (Table ent) (SqlExpr (Entity ent)) where
+    toFrom _ = table

-instance PersistEntity a => From (Table a) where
-    type FromT (Table a) = SqlExpr (Entity a)
-    runFrom e@Table = do
-        let ed = entityDef $ getVal e
-        ident <- newIdentFor (entityDB ed)
-        let entity = unsafeSqlEntity ident
-        pure $ ( entity, \p -> base p ident ed )
-          where
-            getVal ::  Table ent -> Proxy ent
-            getVal = const Proxy
-
-            base _ ident@(I identText) def info =
-                let db@(DBName dbText) = entityDB def
-                in ( fromDBName info db <>
-                         if dbText == identText
-                         then mempty
-                         else " AS " <> useIdent info ident
-                   , mempty
-                   )
+table :: forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
+table = From $ do
+    let ed = entityDef (Proxy @ent)
+    ident <- newIdentFor (entityDB ed)
+    let entity = unsafeSqlEntity ident
+    pure $ ( entity, const $ base ident ed )
+      where
+        base ident@(I identText) def info =
+            let db@(DBName dbText) = entityDB def
+            in ( fromDBName info db <>
+                     if dbText == identText
+                     then mempty
+                     else " AS " <> useIdent info ident
+               , mempty
+               )


 {-# DEPRECATED SubQuery "/Since: 3.4.0.0/ - It is no longer necessary to tag 'SqlQuery' values with @SubQuery@" #-}
 newtype SubQuery a = SubQuery a
+instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToFrom (SubQuery (SqlQuery a)) a where
+    toFrom (SubQuery q) = selectQuery q
+instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToFrom (SqlQuery a) a where
+    toFrom = selectQuery

-instance
-    ( ToAlias a
-    , ToAliasReference a
-    , SqlSelect a r
-    )
-  =>
-    From (SqlQuery a)
-  where
-    type FromT (SqlQuery a) = a
-    runFrom subquery =
-        fromSubQuery NormalSubQuery subquery
-
-instance
-    ( ToAlias a
-    , ToAliasReference a
-    , SqlSelect a r
-    )
-  =>
-    From (SubQuery (SqlQuery a))
-  where
-    type FromT (SubQuery (SqlQuery a)) = a
-    runFrom (SubQuery subquery) =
-        fromSubQuery NormalSubQuery subquery
-
-fromSubQuery
-    ::
-    ( SqlSelect a r
-    , ToAlias a
-    , ToAliasReference a
-    )
-    => SubQueryType -> SqlQuery a -> SqlQuery (a, RawFn)
-fromSubQuery subqueryType subquery = do
+selectQuery :: (SqlSelect a r, ToAlias a, ToAliasReference a) => SqlQuery a -> From a
+selectQuery subquery = From $ do
    -- We want to update the IdentState without writing the query to side data
    (ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ subquery
    aliasedValue <- toAlias ret
@ -121,13 +101,8 @@ fromSubQuery subqueryType subquery = do

    pure (ref, \_ info ->
            let (queryText,queryVals) = toRawSql SELECT info aliasedQuery
-                lateralKeyword =
-                    case subqueryType of
-                      NormalSubQuery  -> ""
-                      LateralSubQuery -> "LATERAL "
            in
-            ( lateralKeyword <> (parens queryText) <> " AS " <> useIdent info subqueryAlias
+            ( (parens queryText) <> " AS " <> useIdent info subqueryAlias
            , queryVals
            )
         )
-
--- a/src/Database/Esqueleto/Experimental/From/CommonTableExpression.hs
+++ b/src/Database/Esqueleto/Experimental/From/CommonTableExpression.hs
@ -1,26 +1,18 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies      #-}
+{-# LANGUAGE TypeFamilies #-}

 module Database.Esqueleto.Experimental.From.CommonTableExpression
    where

-import qualified Control.Monad.Trans.Writer                           as W
-import qualified Data.Text.Lazy.Builder                               as TLB
-import           Database.Esqueleto.Experimental.From
-import           Database.Esqueleto.Experimental.From.SqlSetOperation
-import           Database.Esqueleto.Experimental.ToAlias
-import           Database.Esqueleto.Experimental.ToAliasReference
-import           Database.Esqueleto.Internal.Internal                 hiding
-                                                                      (From (..),
-                                                                       from, on)
-import           Database.Esqueleto.Internal.PersistentImport         (DBName (..))
-
-data CommonTableExpression ref = CommonTableExpression Ident ref
-instance From (CommonTableExpression ref) where
-    type FromT (CommonTableExpression ref) = ref
-    runFrom (CommonTableExpression ident ref) =
-        pure (ref, (\_ info -> (useIdent info ident, mempty)))
+import qualified Control.Monad.Trans.Writer as W
+import qualified Data.Text.Lazy.Builder as TLB
+import Database.Esqueleto.Experimental.From
+import Database.Esqueleto.Experimental.From.SqlSetOperation
+import Database.Esqueleto.Experimental.ToAlias
+import Database.Esqueleto.Experimental.ToAliasReference
+import Database.Esqueleto.Internal.Internal hiding (From(..), from, on)
+import Database.Esqueleto.Internal.PersistentImport (DBName(..))

 -- | @WITH@ clause used to introduce a [Common Table Expression (CTE)](https://en.wikipedia.org/wiki/Hierarchical_and_recursive_queries_in_SQL#Common_table_expression).
 -- CTEs are supported in most modern SQL engines and can be useful
@ -46,7 +38,7 @@ instance From (CommonTableExpression ref) where
 with :: ( ToAlias a
        , ToAliasReference a
        , SqlSelect a r
-        ) => SqlQuery a -> SqlQuery (CommonTableExpression a)
+        ) => SqlQuery a -> SqlQuery (From a)
 with query = do
    (ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ query
    aliasedValue <- toAlias ret
@ -55,7 +47,7 @@ with query = do
    let clause = CommonTableExpressionClause NormalCommonTableExpression ident (\info -> toRawSql SELECT info aliasedQuery)
    Q $ W.tell mempty{sdCteClause = [clause]}
    ref <- toAliasReference ident aliasedValue
-    pure $ CommonTableExpression ident ref
+    pure $ From $ pure (ref, (\_ info -> (useIdent info ident, mempty)))

 -- | @WITH@ @RECURSIVE@ allows one to make a recursive subquery, which can
 -- reference itself. Like @WITH@, this is supported in most modern SQL engines.
@ -92,33 +84,29 @@ with query = do
 withRecursive :: ( ToAlias a
                 , ToAliasReference a
                 , SqlSelect a r
-                 , RecursiveCteUnion unionKind
                 )
              => SqlQuery a
-              -> unionKind
-              -> (CommonTableExpression a -> SqlQuery a)
-              -> SqlQuery (CommonTableExpression 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 = CommonTableExpression ident ref
+    let refFrom = From (pure (ref, (\_ info -> (useIdent info ident, mempty))))
    let recursiveQuery = recursiveCase refFrom
    let clause = CommonTableExpressionClause RecursiveCommonTableExpression ident
                 (\info -> (toRawSql SELECT info aliasedQuery)
-                        <> (unionKeyword unionKind, mempty)
+                        <> ("\n" <> (unUnionKind unionKind)  <> "\n", mempty)
                        <> (toRawSql SELECT info recursiveQuery)
                 )
    Q $ W.tell mempty{sdCteClause = [clause]}
    pure refFrom

-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"
+newtype UnionKind = UnionKind { unUnionKind :: TLB.Builder }
+instance Union_ UnionKind where
+    union_ = UnionKind "UNION"
+instance UnionAll_ UnionKind where
+    unionAll_ = UnionKind "UNION ALL"
--- a/src/Database/Esqueleto/Experimental/From/Join.hs
+++ b/src/Database/Esqueleto/Experimental/From/Join.hs
@ -1,7 +1,11 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
@ -12,13 +16,16 @@ module Database.Esqueleto.Experimental.From.Join
 import Data.Bifunctor (first)
 import Data.Kind (Constraint)
 import Data.Proxy
+import qualified Data.Text.Lazy.Builder as TLB
 import Database.Esqueleto.Experimental.From
 import Database.Esqueleto.Experimental.From.SqlSetOperation
 import Database.Esqueleto.Experimental.ToAlias
 import Database.Esqueleto.Experimental.ToAliasReference
 import Database.Esqueleto.Experimental.ToMaybe
-import Database.Esqueleto.Internal.Internal hiding (From(..), from, on)
-import Database.Esqueleto.Internal.PersistentImport (Entity(..))
+import Database.Esqueleto.Internal.Internal hiding
+       (From(..), from, fromJoin, on)
+import Database.Esqueleto.Internal.PersistentImport
+       (Entity(..), EntityField, PersistEntity, PersistField)
 import GHC.TypeLits

 -- | A left-precedence pair. Pronounced \"and\". Used to represent expressions
@ -35,6 +42,10 @@ import GHC.TypeLits
 data (:&) a b = a :& b
 infixl 2 :&

+instance (ToMaybe a, ToMaybe b) => ToMaybe (a :& b) where
+    type ToMaybeT (a :& b) = (ToMaybeT a :& ToMaybeT b)
+    toMaybe (a :& b) = (toMaybe a :& toMaybe b)
+
 -- | Constraint for `on`. Ensures that only types that require an `on` can be used on
 -- the left hand side. This was previously reusing the From class which was actually
 -- a bit too lenient as it allowed to much.
@ -46,6 +57,7 @@ type family ValidOnClauseValue a :: Constraint where
  ValidOnClauseValue (SqlQuery a) = ()
  ValidOnClauseValue (SqlSetOperation a) = ()
  ValidOnClauseValue (a -> SqlQuery b) = ()
+  ValidOnClauseValue (From a) = ()
  ValidOnClauseValue _ = TypeError ('Text "Illegal use of ON")

 -- | An @ON@ clause that describes how two tables are related. This should be
@ -62,183 +74,233 @@ on :: ValidOnClauseValue a => a -> (b -> SqlExpr (Value Bool)) -> (a, b -> SqlEx
 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
-type family FromOnClause a where
-    FromOnClause (a, b -> SqlExpr (Value Bool)) = b
-    FromOnClause a = TypeError ('Text "Missing ON clause")
-
-instance {-# OVERLAPPABLE #-} From (InnerJoin a b) where
-    type FromT (InnerJoin a b) = FromOnClause b
-    runFrom = undefined
-instance {-# OVERLAPPABLE #-} From (LeftOuterJoin a b) where
-    type FromT (LeftOuterJoin a b) = FromOnClause b
-    runFrom = undefined
-instance {-# OVERLAPPABLE #-} From (RightOuterJoin a b) where
-    type FromT (RightOuterJoin a b) = FromOnClause b
-    runFrom = undefined
-instance {-# OVERLAPPABLE #-} From (FullOuterJoin a b) where
-    type FromT (FullOuterJoin a b) = FromOnClause b
-    runFrom = undefined
-
-class FromInnerJoin lateral lhs rhs res where
-    runFromInnerJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> SqlQuery (res, RawFn)
-
-fromJoin_ :: RawFn -> JoinKind -> RawFn -> Maybe (SqlExpr (Value Bool)) -> RawFn
-fromJoin_ lhs kind rhs monClause =
+fromJoin :: TLB.Builder -> RawFn -> RawFn -> Maybe (SqlExpr (Value Bool)) -> RawFn
+fromJoin joinKind lhs rhs monClause =
    \paren info ->
        first (parensM paren) $
        mconcat [ lhs Never info
-                , (fromKind kind, mempty)
+                , (joinKind, mempty)
                , rhs Parens info
                , maybe mempty (makeOnClause info) monClause
                ]
    where
-        fromKind InnerJoinKind      = " INNER JOIN "
-        fromKind CrossJoinKind      = " CROSS JOIN "
-        fromKind LeftOuterJoinKind  = " LEFT OUTER JOIN "
-        fromKind RightOuterJoinKind = " RIGHT OUTER JOIN "
-        fromKind FullOuterJoinKind  = " FULL OUTER JOIN "
-
        makeOnClause info (ERaw _ f)        = first (" ON " <>) (f Never info)

-instance ( SqlSelect b r
-         , ToAlias b
-         , ToAliasReference b
-         , From a
-         , FromT a ~ a'
-         ) => FromInnerJoin Lateral a (a' -> SqlQuery b) (a' :& b) where
-             runFromInnerJoin _ 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)))
+type family HasOnClause actual expected :: Constraint where
+    HasOnClause (a, b -> SqlExpr (Value Bool)) c = () -- Let the compiler handle the type mismatch
+    HasOnClause a expected =
+        TypeError ( 'Text "Missing ON clause for join with"
+                    ':$$: 'ShowType a
+                    ':$$: 'Text ""
+                    ':$$: 'Text "Expected: "
+                    ':$$: 'ShowType a
+                    ':$$: 'Text "`on` " ':<>: 'ShowType (expected -> SqlExpr (Value Bool))
+                    ':$$: 'Text ""
+                  )

-instance (From a, FromT a ~ a', From b, FromT b ~ b')
-  => FromInnerJoin NotLateral a b (a' :& b') where
-      runFromInnerJoin _ 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)))

-instance (FromInnerJoin (IsLateral b) a b b') => From (InnerJoin a (b, b' -> SqlExpr (Value Bool))) where
-    type FromT (InnerJoin a (b, b' -> SqlExpr (Value Bool))) = FromOnClause (b, b' -> SqlExpr(Value Bool))
-    runFrom (InnerJoin lhs (rhs, on')) = runFromInnerJoin (toProxy rhs) lhs rhs on'
-        where
-            toProxy :: b -> Proxy (IsLateral b)
-            toProxy _ = Proxy
+innerJoin :: ( ToFrom a a'
+             , ToFrom b b'
+             , HasOnClause rhs (a' :& b')
+             , rhs ~ (b, (a' :& b') -> SqlExpr (Value Bool))
+             ) => a -> rhs -> From (a' :& b')
+innerJoin lhs (rhs, on') = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (toFrom rhs)
+     let ret = leftVal :& rightVal
+     pure $ (ret, fromJoin " INNER JOIN " leftFrom rightFrom (Just $ on' ret))

-type family FromCrossJoin a b where
-    FromCrossJoin a (b -> SqlQuery c) = FromT a :& c
-    FromCrossJoin a b = FromT a :& FromT b

-instance ( From a
-         , From b
-         , FromT (CrossJoin a b) ~ (FromT a :& FromT b)
-         ) => From (CrossJoin a b) where
-    type FromT (CrossJoin a b) = FromCrossJoin a b
-    runFrom (CrossJoin leftPart rightPart) = do
-        (leftVal, leftFrom) <- runFrom leftPart
-        (rightVal, rightFrom) <- runFrom rightPart
-        let ret = leftVal :& rightVal
-        pure $ (ret, fromJoin_ leftFrom CrossJoinKind rightFrom Nothing)
+innerJoinLateral :: ( ToFrom a a'
+                    , HasOnClause rhs (a' :& b)
+                    , SqlSelect b r
+                    , ToAlias b
+                    , ToAliasReference b
+                    , rhs ~ (a' -> SqlQuery b, (a' :& b) -> SqlExpr (Value Bool))
+                    )
+                 => a -> rhs -> From (a' :& b)
+innerJoinLateral lhs (rhsFn, on') = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (selectQuery (rhsFn leftVal))
+     let ret = leftVal :& rightVal
+     pure $ (ret, fromJoin " INNER JOIN LATERAL " leftFrom rightFrom (Just $ on' ret))

-instance {-# OVERLAPPING #-}
-         ( From a
-         , FromT a ~ a'
+crossJoin :: ( ToFrom a a'
+             , ToFrom b b'
+             ) => a -> b -> From (a' :& b')
+crossJoin lhs rhs = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (toFrom rhs)
+     let ret = leftVal :& rightVal
+     pure $ (ret, fromJoin " CROSS JOIN " leftFrom rightFrom Nothing)
+
+crossJoinLateral :: ( ToFrom a a'
+                    , SqlSelect b r
+                    , ToAlias b
+                    , ToAliasReference b
+                    )
+                 => a -> (a' -> SqlQuery b) -> From (a' :& b)
+crossJoinLateral lhs rhsFn = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (selectQuery (rhsFn leftVal))
+     let ret = leftVal :& rightVal
+     pure $ (ret, fromJoin " CROSS JOIN LATERAL " leftFrom rightFrom Nothing)
+
+leftJoin :: ( ToFrom a a'
+            , ToFrom b b'
+            , ToMaybe b'
+            , HasOnClause rhs (a' :& ToMaybeT b')
+            , rhs ~ (b, (a' :& ToMaybeT b') -> SqlExpr (Value Bool))
+            ) => a -> rhs -> From (a' :& ToMaybeT b')
+leftJoin lhs (rhs, on') = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (toFrom rhs)
+     let ret = leftVal :& toMaybe rightVal
+     pure $ (ret, fromJoin " LEFT OUTER JOIN " leftFrom rightFrom (Just $ on' ret))
+
+leftJoinLateral :: ( ToFrom a a'
+                   , SqlSelect b r
+                   , HasOnClause rhs (a' :& ToMaybeT b)
+                   , ToAlias b
+                   , ToAliasReference b
+                   , ToMaybe b
+                   , rhs ~ (a' -> SqlQuery b, (a' :& ToMaybeT b) -> SqlExpr (Value Bool))
+                   )
+                 => a -> rhs -> From (a' :& ToMaybeT b)
+leftJoinLateral lhs (rhsFn, on') = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (selectQuery (rhsFn leftVal))
+     let ret = leftVal :& toMaybe rightVal
+     pure $ (ret, fromJoin " LEFT OUTER JOIN LATERAL " leftFrom rightFrom (Just $ on' ret))
+
+rightJoin :: ( ToFrom a a'
+             , ToFrom b b'
+             , ToMaybe a'
+             , HasOnClause rhs (ToMaybeT a' :& b')
+             , rhs ~ (b, (ToMaybeT a' :& b') -> SqlExpr (Value Bool))
+             ) => a -> rhs -> From (ToMaybeT a' :& b')
+rightJoin lhs (rhs, on') = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (toFrom rhs)
+     let ret = toMaybe leftVal :& rightVal
+     pure $ (ret, fromJoin " RIGHT OUTER JOIN " leftFrom rightFrom (Just $ on' ret))
+
+fullOuterJoin :: ( ToFrom a a'
+                 , ToFrom b b'
+                 , ToMaybe a'
+                 , ToMaybe b'
+                 , HasOnClause rhs (ToMaybeT a' :& ToMaybeT b')
+                 , rhs ~ (b, (ToMaybeT a' :& ToMaybeT b') -> SqlExpr (Value Bool))
+                 ) => a -> rhs -> From (ToMaybeT a' :& ToMaybeT b')
+fullOuterJoin lhs (rhs, on') = From $ do
+     (leftVal, leftFrom) <- unFrom (toFrom lhs)
+     (rightVal, rightFrom) <- unFrom (toFrom rhs)
+     let ret = toMaybe leftVal :& toMaybe rightVal
+     pure $ (ret, fromJoin " FULL OUTER JOIN " leftFrom rightFrom (Just $ on' ret))
+
+infixl 2 `innerJoin`,
+         `innerJoinLateral`,
+         `leftJoin`,
+         `leftJoinLateral`,
+         `crossJoin`,
+         `crossJoinLateral`,
+         `rightJoin`,
+         `fullOuterJoin`
+
+
+------ Compatibility for old syntax
+
+data Lateral
+data NotLateral
+
+type family IsLateral a where
+    IsLateral (a -> SqlQuery b, c) = Lateral
+    IsLateral (a -> SqlQuery b) = Lateral
+    IsLateral a = NotLateral
+
+class DoInnerJoin lateral lhs rhs res | lateral rhs lhs -> res where
+    doInnerJoin :: Proxy lateral -> lhs -> rhs -> From res
+
+instance ( ToFrom a a'
+         , ToFrom b b'
+         , HasOnClause rhs (a' :& b')
+         , rhs ~ (b, (a' :& b') -> SqlExpr (Value Bool))
+         ) => DoInnerJoin NotLateral a rhs (a' :& b') where
+    doInnerJoin _ = innerJoin
+
+instance ( ToFrom a a'
         , SqlSelect b r
         , ToAlias b
         , ToAliasReference b
-         ) => From (CrossJoin a (a' -> SqlQuery b)) where
-    type FromT (CrossJoin a (a' -> SqlQuery b)) = FromCrossJoin a (a' -> SqlQuery b)
-    runFrom (CrossJoin leftPart q) = do
-        (leftVal, leftFrom) <- runFrom leftPart
-        (rightVal, rightFrom) <- fromSubQuery LateralSubQuery (q leftVal)
-        let ret = leftVal :& rightVal
-        pure $ (ret, fromJoin_ leftFrom CrossJoinKind rightFrom Nothing)
+         , d ~ (a' :& b)
+         ) => DoInnerJoin Lateral a (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) d where
+    doInnerJoin _ = innerJoinLateral

-class FromLeftJoin lateral lhs rhs res where
-    runFromLeftJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> SqlQuery (res, RawFn)
+instance ( DoInnerJoin lateral lhs rhs r, lateral ~ IsLateral rhs )
+           => ToFrom (InnerJoin lhs rhs) r where
+     toFrom (InnerJoin a b) = doInnerJoin (Proxy @lateral) a b

-instance ( From a
-         , FromT a ~ a'
-         , SqlSelect b r
-         , ToAlias b
-         , ToAliasReference b
+class DoLeftJoin lateral lhs rhs res | lateral rhs lhs -> res where
+    doLeftJoin :: Proxy lateral -> lhs -> rhs -> From res
+
+instance ( ToFrom a a'
+         , ToFrom b b'
+         , ToMaybe b'
+         , ToMaybeT b' ~ mb
+         , HasOnClause rhs (a' :& mb)
+         , rhs ~ (b, (a' :& mb) -> SqlExpr (Value Bool))
+         ) => DoLeftJoin NotLateral a rhs (a' :& mb) where
+    doLeftJoin _ = leftJoin
+
+instance ( ToFrom a a'
         , ToMaybe b
-         , mb ~ ToMaybeT b
-         ) => FromLeftJoin Lateral a (a' -> SqlQuery b) (a' :& mb) where
-            runFromLeftJoin _ 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)))
+         , d ~ (a' :& ToMaybeT b)
+         , SqlSelect b r
+         , ToAlias b
+         , ToAliasReference b
+         ) => DoLeftJoin Lateral a (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) d where
+    doLeftJoin _ = leftJoinLateral

-instance ( From a
-         , FromT a ~ a'
-         , From b
-         , FromT b ~ b'
-         , ToMaybe b'
-         , mb ~ ToMaybeT b'
-         ) => FromLeftJoin NotLateral a b (a' :& mb) where
-            runFromLeftJoin _ 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)))
+instance ( DoLeftJoin lateral lhs rhs r, lateral ~ IsLateral rhs )
+           => ToFrom (LeftOuterJoin lhs rhs) r where
+     toFrom (LeftOuterJoin a b) = doLeftJoin (Proxy @lateral) a b

-instance ( FromLeftJoin (IsLateral b) a b b'
-         ) => From (LeftOuterJoin a (b, b' -> SqlExpr (Value Bool))) where
-            type FromT (LeftOuterJoin a (b, b' -> SqlExpr (Value Bool))) = FromOnClause (b, b' -> SqlExpr(Value Bool))
-            runFrom (LeftOuterJoin lhs (rhs, on')) =
-                runFromLeftJoin (toProxy rhs) lhs rhs on'
-              where
-                toProxy :: b -> Proxy (IsLateral b)
-                toProxy _ = Proxy
+class DoCrossJoin lateral lhs rhs res | lateral lhs rhs -> res where
+    doCrossJoin :: Proxy lateral -> lhs -> rhs -> From res

-instance ( From a
-         , FromT a ~ a'
-         , From b
-         , FromT b ~ b'
+instance (ToFrom a a', ToFrom b b') => DoCrossJoin NotLateral a b (a' :& b') where
+    doCrossJoin _ = crossJoin
+instance (ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b)
+  => DoCrossJoin Lateral a (a' -> SqlQuery b) (a' :& b) where
+    doCrossJoin _ = crossJoinLateral
+
+instance (DoCrossJoin lateral lhs rhs r, IsLateral rhs ~ lateral)
+  => ToFrom (CrossJoin lhs rhs) r where
+    toFrom (CrossJoin a b) = doCrossJoin (Proxy @lateral) a b
+
+instance ( ToFrom a a'
+         , ToFrom b b'
         , ToMaybe a'
-         , ma ~ ToMaybeT a'
-         , ToMaybe b'
-         , mb ~ ToMaybeT b'
+         , ToMaybeT a' ~ ma
+         , HasOnClause rhs (ma :& b')
         , ErrorOnLateral b
-         ) => From (FullOuterJoin a (b, (ma :& mb) -> SqlExpr (Value Bool))) where
-            type FromT (FullOuterJoin a (b, (ma :& mb) -> SqlExpr (Value Bool))) = FromOnClause (b, (ma :& mb) -> SqlExpr(Value Bool))
-            runFrom (FullOuterJoin 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)))
+         , rhs ~ (b, (ma :& b') -> SqlExpr (Value Bool))
+         ) => ToFrom (RightOuterJoin a rhs) (ma :& b') where
+    toFrom (RightOuterJoin a b) = rightJoin a b

-instance ( From a
-         , FromT a ~ a'
+instance ( ToFrom a a'
+         , ToFrom b b'
         , ToMaybe a'
-         , ma ~ ToMaybeT a'
-         , From b
-         , FromT b ~ b'
+         , ToMaybeT a' ~ ma
+         , ToMaybe b'
+         , ToMaybeT b' ~ mb
+         , HasOnClause rhs (ma :& mb)
         , ErrorOnLateral b
-         ) => From (RightOuterJoin a (b, (ma :& b') -> SqlExpr (Value Bool))) where
-            type FromT (RightOuterJoin a (b, (ma :& b') -> SqlExpr (Value Bool))) = FromOnClause (b, (ma :& b') -> SqlExpr(Value Bool))
-            runFrom (RightOuterJoin 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)))
+         , rhs ~ (b, (ma :& mb) -> SqlExpr (Value Bool))
+         ) => ToFrom (FullOuterJoin a rhs) (ma :& mb) where
+    toFrom (FullOuterJoin a b) = fullOuterJoin a 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)
--- a/src/Database/Esqueleto/Experimental/From/SqlSetOperation.hs
+++ b/src/Database/Esqueleto/Experimental/From/SqlSetOperation.hs
@ -1,211 +1,112 @@
-{-# LANGUAGE FlexibleContexts       #-}
-{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE OverloadedStrings      #-}
-{-# LANGUAGE PatternSynonyms        #-}
-{-# LANGUAGE TypeFamilies           #-}
-{-# LANGUAGE UndecidableInstances   #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}

 module Database.Esqueleto.Experimental.From.SqlSetOperation
        where

-import           Control.Monad.Trans.Class                        (lift)
-import qualified Control.Monad.Trans.State                        as S
-import qualified Control.Monad.Trans.Writer                       as W
-import qualified Data.Text.Lazy.Builder                           as TLB
-import           Database.Esqueleto.Experimental.From
-import           Database.Esqueleto.Experimental.ToAlias
-import           Database.Esqueleto.Experimental.ToAliasReference
-import           Database.Esqueleto.Internal.Internal             hiding
-                                                                  (From (..),
-                                                                   from, on)
-import           Database.Esqueleto.Internal.PersistentImport     (DBName (..),
-                                                                   PersistValue)
+import Control.Arrow (first)
+import Control.Monad.Trans.Class (lift)
+import qualified Control.Monad.Trans.State as S
+import qualified Control.Monad.Trans.Writer as W
+import qualified Data.Text.Lazy.Builder as TLB
+import Database.Esqueleto.Experimental.From
+import Database.Esqueleto.Experimental.ToAlias
+import Database.Esqueleto.Experimental.ToAliasReference
+import Database.Esqueleto.Internal.Internal hiding (From(..), from, on)
+import Database.Esqueleto.Internal.PersistentImport
+       (DBName(..), Entity, PersistEntity, PersistValue)

-data 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)
+newtype SqlSetOperation a = SqlSetOperation
+    { unSqlSetOperation :: NeedParens -> SqlQuery (a, IdentInfo -> (TLB.Builder, [PersistValue]))}

-runSetOperation :: (SqlSelect a r, ToAlias a, ToAliasReference a)
-                => SqlSetOperation a -> SqlQuery (a, NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue]))
-runSetOperation operation = do
-    (aliasedOperation, ret) <- aliasQueries operation
-    ident <- newIdentFor (DBName "u")
-    ref <- toAliasReference ident ret
-    pure ( ref
-         , \_ info ->
-            let (queryText, queryVals) = operationToSql aliasedOperation info
-            in (parens queryText <> " AS " <> useIdent info ident, queryVals)
-         )
+instance ToAliasReference a => ToFrom (SqlSetOperation a) a where
+    toFrom setOperation = From $ do
+        ident <- newIdentFor (DBName "u")
+        (a, fromClause) <- unSqlSetOperation setOperation Never
+        ref <- toAliasReference ident a
+        pure (ref, \_ info -> (first parens $ fromClause info) <> (" AS " <> useIdent info ident, mempty))

-  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)
+class ToSqlSetOperation a r | a -> r where
+    toSqlSetOperation :: a -> SqlSetOperation r
+instance ToSqlSetOperation (SqlSetOperation a) a where
+    toSqlSetOperation = id
+instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToSqlSetOperation (SqlQuery a) a where
+    toSqlSetOperation subquery =
+        SqlSetOperation $ \p -> do
+            (ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ subquery
+            state <- Q $ lift S.get
+            aliasedValue <- toAlias ret
+            Q $ lift $ S.put state
+            let aliasedQuery = Q $ W.WriterT $ pure (aliasedValue, sideData)
+            let p' =
+                  case p of
+                    Parens -> Parens
+                    Never ->
+                      if (sdLimitClause sideData) /= mempty
+                          || length (sdOrderByClause sideData) > 0 then
+                        Parens
+                      else
+                        Never
+            pure (aliasedValue, \info -> first (parensM p') $ toRawSql SELECT info aliasedQuery)

+mkSetOperation :: (ToSqlSetOperation a a', ToSqlSetOperation b a') => TLB.Builder -> a -> b -> SqlSetOperation a'
+mkSetOperation operation lhs rhs = SqlSetOperation $ \p -> do
+    (leftValue, leftClause) <- unSqlSetOperation (toSqlSetOperation lhs) p
+    (_, rightClause) <- unSqlSetOperation (toSqlSetOperation rhs) p
+    pure (leftValue, \info -> leftClause info <> (operation, mempty) <> rightClause info)

 {-# DEPRECATED Union "/Since: 3.4.0.0/ - Use the 'union_' function instead of the 'Union' data constructor" #-}
 data Union a b = a `Union` b
+instance ToSqlSetOperation a a' => ToSqlSetOperation (Union a a) a' where
+    toSqlSetOperation (Union a b) = union_ a b

-- | @UNION@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
-union_ :: a -> b -> Union a b
-union_ = Union
+
+class Union_ a where
+    -- | @UNION@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
+    union_ :: a
+
+instance (ToSqlSetOperation a c, ToSqlSetOperation b c, res ~ SqlSetOperation c)
+  => Union_ (a -> b -> res) where
+    union_ = mkSetOperation " UNION "
+
+class UnionAll_ a where
+    -- | @UNION@ @ALL@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
+    unionAll_ :: a
+instance (ToSqlSetOperation a c, ToSqlSetOperation b c, res ~ SqlSetOperation c)
+  => UnionAll_ (a -> b -> res) where
+    unionAll_ = mkSetOperation " UNION ALL "

 {-# DEPRECATED UnionAll "/Since: 3.4.0.0/ - Use the 'unionAll_' function instead of the 'UnionAll' data constructor" #-}
 data UnionAll a b = a `UnionAll` b
-
-- | @UNION@ @ALL@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
-unionAll_ :: a -> b -> UnionAll a b
-unionAll_ = UnionAll
+instance ToSqlSetOperation a a' => ToSqlSetOperation (UnionAll a a) a' where
+    toSqlSetOperation (UnionAll a b) = unionAll_ a b

 {-# DEPRECATED Except "/Since: 3.4.0.0/ - Use the 'except_' function instead of the 'Except' data constructor" #-}
 data Except a b = a `Except` b
+instance ToSqlSetOperation a a' => ToSqlSetOperation (Except a a) a' where
+    toSqlSetOperation (Except a b) = except_ a b

 -- | @EXCEPT@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
-except_ :: a -> b -> Except a b
-except_ = Except
+except_ :: (ToSqlSetOperation a a', ToSqlSetOperation b a') => a -> b -> SqlSetOperation a'
+except_ = mkSetOperation " EXCEPT "

 {-# DEPRECATED Intersect "/Since: 3.4.0.0/ - Use the 'intersect_' function instead of the 'Intersect' data constructor" #-}
 data Intersect a b = a `Intersect` b
+instance ToSqlSetOperation a a' => ToSqlSetOperation (Intersect a a) a' where
+    toSqlSetOperation (Intersect a b) = intersect_ a b

 -- | @INTERSECT@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
-intersect_ :: 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)
+intersect_ :: (ToSqlSetOperation a a', ToSqlSetOperation b a') => a -> b -> SqlSetOperation a'
+intersect_ = mkSetOperation " INTERSECT "

 {-# DEPRECATED SelectQuery "/Since: 3.4.0.0/ - It is no longer necessary to tag 'SqlQuery' values with @SelectQuery@" #-}
-pattern SelectQuery :: SqlQuery a -> SqlSetOperation a
-pattern SelectQuery q = SelectQueryP Never q
+pattern SelectQuery a = a

-instance
-    ( SqlSelect c r
-    , ToAlias c
-    , ToAliasReference c
-    , ToSetOperation a c
-    , ToSetOperation b c
-    , c ~ SetOperationT a
-    )
-  =>
-    From (Union a b)
-  where
-    type FromT (Union a b) = SetOperationT a
-    runFrom u = runSetOperation $ toSetOperation u
-
-instance
-    ( SqlSelect c r
-    , ToAlias c
-    , ToAliasReference c
-    , ToSetOperation a c
-    , ToSetOperation b c
-    , c ~ SetOperationT a
-    )
-  =>
-    From (UnionAll a b)
-  where
-    type FromT (UnionAll a b) = SetOperationT a
-    runFrom u = runSetOperation $ toSetOperation u
-
-instance
-    ( SqlSelect c r
-    , ToAlias c
-    , ToAliasReference c
-    , ToSetOperation a c
-    , ToSetOperation b c
-    , c ~ SetOperationT a
-    )
-  =>
-    From (Intersect a b)
-  where
-    type FromT (Intersect a b) = SetOperationT a
-    runFrom u = runSetOperation $ toSetOperation u
-
-instance
-    ( SqlSelect c r
-    , ToAlias c
-    , ToAliasReference c
-    , ToSetOperation a c
-    , ToSetOperation b c
-    , c ~ SetOperationT a
-    )
-  =>
-    From (Except a b)
-  where
-    type FromT (Except a b) = SetOperationT a
-    runFrom u = runSetOperation $ toSetOperation u
-
-instance (SqlSelect a r, ToAlias a, ToAliasReference a) => From (SqlSetOperation a) where
-    type FromT (SqlSetOperation a) = a
-    -- If someone uses just a plain SelectQuery it should behave like a normal subquery
-    runFrom (SelectQueryP _ subquery) = fromSubQuery NormalSubQuery subquery
-    -- Otherwise use the SqlSetOperation
-    runFrom u                         = runSetOperation $ toSetOperation u