    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE FunctionalDependencies #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE PatternSynonyms #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE UndecidableInstances #-}

    module Database.Esqueleto.Experimental.From.SqlSetOperation
            where

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

    -- | Data type used to implement the SqlSetOperation language
    -- this type is implemented in the same way as a @From@
    --
    -- Semantically a @SqlSetOperation@ is always a @From@ but not vice versa
    --
    -- @since 3.5.0.0
    newtype SqlSetOperation a = SqlSetOperation
        { forall a.
    SqlSetOperation a
    -> NeedParens
    -> SqlQuery (a, IdentInfo -> (Builder, [PersistValue]))
    unSqlSetOperation :: NeedParens -> SqlQuery (a, IdentInfo -> (TLB.Builder, [PersistValue]))}

    instance ToAliasReference a => ToFrom (SqlSetOperation a) a where
        toFrom :: SqlSetOperation a -> From a
    toFrom SqlSetOperation a
    setOperation = SqlQuery (a, RawFn) -> From a
    forall a. SqlQuery (a, RawFn) -> From a
    From (SqlQuery (a, RawFn) -> From a) -> SqlQuery (a, RawFn) -> From a
    forall a b. (a -> b) -> a -> b
    $ do
            ident <- DBName -> SqlQuery Ident
    newIdentFor (Text -> DBName
    DBName Text
    "u")
            (a, fromClause) <- unSqlSetOperation setOperation Never
            ref <- toAliasReference ident a
            pure (ref, \NeedParens
    _ IdentInfo
    info -> ((Builder -> Builder)
    -> (Builder, [PersistValue]) -> (Builder, [PersistValue])
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first Builder -> Builder
    parens ((Builder, [PersistValue]) -> (Builder, [PersistValue]))
    -> (Builder, [PersistValue]) -> (Builder, [PersistValue])
    forall a b. (a -> b) -> a -> b
    $ IdentInfo -> (Builder, [PersistValue])
    fromClause IdentInfo
    info) (Builder, [PersistValue])
    -> (Builder, [PersistValue]) -> (Builder, [PersistValue])
    forall a. Semigroup a => a -> a -> a
    <> (Builder
    " AS " Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> IdentInfo -> Ident -> Builder
    useIdent IdentInfo
    info Ident
    ident, [PersistValue]
    forall a. Monoid a => a
    mempty))

    -- | Type class to support direct use of @SqlQuery@ in a set operation tree
    --
    -- @since 3.5.0.0
    class ToSqlSetOperation a r | a -> r where
        toSqlSetOperation :: a -> SqlSetOperation r
    instance ToSqlSetOperation (SqlSetOperation a) a where
        toSqlSetOperation :: SqlSetOperation a -> SqlSetOperation a
    toSqlSetOperation = SqlSetOperation a -> SqlSetOperation a
    forall a. a -> a
    id
    instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToSqlSetOperation (SqlQuery a) a where
        toSqlSetOperation :: SqlQuery a -> SqlSetOperation a
    toSqlSetOperation SqlQuery a
    subquery =
            (NeedParens
     -> SqlQuery (a, IdentInfo -> (Builder, [PersistValue])))
    -> SqlSetOperation a
    forall a.
    (NeedParens
     -> SqlQuery (a, IdentInfo -> (Builder, [PersistValue])))
    -> SqlSetOperation a
    SqlSetOperation ((NeedParens
      -> SqlQuery (a, IdentInfo -> (Builder, [PersistValue])))
     -> SqlSetOperation a)
    -> (NeedParens
        -> SqlQuery (a, IdentInfo -> (Builder, [PersistValue])))
    -> SqlSetOperation a
    forall a b. (a -> b) -> a -> b
    $ \NeedParens
    p -> do
                (ret, sideData) <- WriterT SideData (State IdentState) (a, SideData)
    -> SqlQuery (a, SideData)
    forall a. WriterT SideData (State IdentState) a -> SqlQuery a
    Q (WriterT SideData (State IdentState) (a, SideData)
     -> SqlQuery (a, SideData))
    -> WriterT SideData (State IdentState) (a, SideData)
    -> SqlQuery (a, SideData)
    forall a b. (a -> b) -> a -> b
    $ (SideData -> SideData)
    -> WriterT SideData (State IdentState) (a, SideData)
    -> WriterT SideData (State IdentState) (a, SideData)
    forall (m :: * -> *) w a.
    Monad m =>
    (w -> w) -> WriterT w m a -> WriterT w m a
    W.censor (\SideData
    _ -> SideData
    forall a. Monoid a => a
    mempty) (WriterT SideData (State IdentState) (a, SideData)
     -> WriterT SideData (State IdentState) (a, SideData))
    -> WriterT SideData (State IdentState) (a, SideData)
    -> WriterT SideData (State IdentState) (a, SideData)
    forall a b. (a -> b) -> a -> b
    $ WriterT SideData (State IdentState) a
    -> WriterT SideData (State IdentState) (a, SideData)
    forall (m :: * -> *) w a.
    Monad m =>
    WriterT w m a -> WriterT w m (a, w)
    W.listen (WriterT SideData (State IdentState) a
     -> WriterT SideData (State IdentState) (a, SideData))
    -> WriterT SideData (State IdentState) a
    -> WriterT SideData (State IdentState) (a, SideData)
    forall a b. (a -> b) -> a -> b
    $ SqlQuery a -> WriterT SideData (State IdentState) a
    forall a. SqlQuery a -> WriterT SideData (State IdentState) a
    unQ SqlQuery a
    subquery
                aliasedValue <- toAlias ret
                let aliasedQuery = WriterT SideData (State IdentState) a -> SqlQuery a
    forall a. WriterT SideData (State IdentState) a -> SqlQuery a
    Q (WriterT SideData (State IdentState) a -> SqlQuery a)
    -> WriterT SideData (State IdentState) a -> SqlQuery a
    forall a b. (a -> b) -> a -> b
    $ State IdentState (a, SideData)
    -> WriterT SideData (State IdentState) a
    forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
    W.WriterT (State IdentState (a, SideData)
     -> WriterT SideData (State IdentState) a)
    -> State IdentState (a, SideData)
    -> WriterT SideData (State IdentState) a
    forall a b. (a -> b) -> a -> b
    $ (a, SideData) -> State IdentState (a, SideData)
    forall a. a -> StateT IdentState Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (a
    aliasedValue, SideData
    sideData)
                let p' =
                      case NeedParens
    p of
                        NeedParens
    Parens -> NeedParens
    Parens
                        NeedParens
    Never ->
                          if (SideData -> LimitClause
    sdLimitClause SideData
    sideData) LimitClause -> LimitClause -> Bool
    forall a. Eq a => a -> a -> Bool
    /= LimitClause
    forall a. Monoid a => a
    mempty
                              Bool -> Bool -> Bool
    || [OrderByClause] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (SideData -> [OrderByClause]
    sdOrderByClause SideData
    sideData) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then
                            NeedParens
    Parens
                          else
                            NeedParens
    Never
                pure (aliasedValue, \IdentInfo
    info -> (Builder -> Builder)
    -> (Builder, [PersistValue]) -> (Builder, [PersistValue])
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (NeedParens -> Builder -> Builder
    parensM NeedParens
    p') ((Builder, [PersistValue]) -> (Builder, [PersistValue]))
    -> (Builder, [PersistValue]) -> (Builder, [PersistValue])
    forall a b. (a -> b) -> a -> b
    $ Mode -> IdentInfo -> SqlQuery a -> (Builder, [PersistValue])
    forall a r backend.
    (SqlSelect a r, BackendCompatible SqlBackend backend) =>
    Mode
    -> (backend, IdentState) -> SqlQuery a -> (Builder, [PersistValue])
    toRawSql Mode
    SELECT IdentInfo
    info SqlQuery a
    aliasedQuery)

    -- | Helper function for defining set operations
    -- @since 3.5.0.0
    mkSetOperation :: (ToSqlSetOperation a a', ToSqlSetOperation b a')
                   => TLB.Builder -> a -> b -> SqlSetOperation a'
    mkSetOperation :: forall a a' b.
    (ToSqlSetOperation a a', ToSqlSetOperation b a') =>
    Builder -> a -> b -> SqlSetOperation a'
    mkSetOperation Builder
    operation a
    lhs b
    rhs = (NeedParens
     -> SqlQuery (a', IdentInfo -> (Builder, [PersistValue])))
    -> SqlSetOperation a'
    forall a.
    (NeedParens
     -> SqlQuery (a, IdentInfo -> (Builder, [PersistValue])))
    -> SqlSetOperation a
    SqlSetOperation ((NeedParens
      -> SqlQuery (a', IdentInfo -> (Builder, [PersistValue])))
     -> SqlSetOperation a')
    -> (NeedParens
        -> SqlQuery (a', IdentInfo -> (Builder, [PersistValue])))
    -> SqlSetOperation a'
    forall a b. (a -> b) -> a -> b
    $ \NeedParens
    p -> do
        state <- WriterT SideData (State IdentState) IdentState
    -> SqlQuery IdentState
    forall a. WriterT SideData (State IdentState) a -> SqlQuery a
    Q (WriterT SideData (State IdentState) IdentState
     -> SqlQuery IdentState)
    -> WriterT SideData (State IdentState) IdentState
    -> SqlQuery IdentState
    forall a b. (a -> b) -> a -> b
    $ State IdentState IdentState
    -> WriterT SideData (State IdentState) IdentState
    forall (m :: * -> *) a. Monad m => m a -> WriterT SideData m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift State IdentState IdentState
    forall (m :: * -> *) s. Monad m => StateT s m s
    S.get
        (leftValue, leftClause) <- unSqlSetOperation (toSqlSetOperation lhs) p
        Q $ lift $ S.put state
        (_, rightClause) <- unSqlSetOperation (toSqlSetOperation rhs) p
        pure (leftValue, \IdentInfo
    info -> IdentInfo -> (Builder, [PersistValue])
    leftClause IdentInfo
    info (Builder, [PersistValue])
    -> (Builder, [PersistValue]) -> (Builder, [PersistValue])
    forall a. Semigroup a => a -> a -> a
    <> (Builder
    operation, [PersistValue]
    forall a. Monoid a => a
    mempty) (Builder, [PersistValue])
    -> (Builder, [PersistValue]) -> (Builder, [PersistValue])
    forall a. Semigroup a => a -> a -> a
    <> IdentInfo -> (Builder, [PersistValue])
    rightClause IdentInfo
    info)

    -- | Overloaded @union_@ function to support use in both 'SqlSetOperation'
    -- and 'withRecursive'
    --
    -- @since 3.5.0.0
    class Union_ a where
        -- | @UNION@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
        union_ :: a

    instance (ToSqlSetOperation a c, ToSqlSetOperation b c, res ~ SqlSetOperation c)
      => Union_ (a -> b -> res) where
        union_ :: a -> b -> res
    union_ = Builder -> a -> b -> SqlSetOperation c
    forall a a' b.
    (ToSqlSetOperation a a', ToSqlSetOperation b a') =>
    Builder -> a -> b -> SqlSetOperation a'
    mkSetOperation Builder
    " UNION "

    -- | Overloaded @unionAll_@ function to support use in both 'SqlSetOperation'
    -- and 'withRecursive'
    --
    -- @since 3.5.0.0
    class UnionAll_ a where
        -- | @UNION@ @ALL@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
        unionAll_ :: a
    instance (ToSqlSetOperation a c, ToSqlSetOperation b c, res ~ SqlSetOperation c)
      => UnionAll_ (a -> b -> res) where
        unionAll_ :: a -> b -> res
    unionAll_ = Builder -> a -> b -> SqlSetOperation c
    forall a a' b.
    (ToSqlSetOperation a a', ToSqlSetOperation b a') =>
    Builder -> a -> b -> SqlSetOperation a'
    mkSetOperation Builder
    " UNION ALL "

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

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