{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

module Database.Esqueleto.Experimental.From.CommonTableExpression
    where

import qualified Control.Monad.Trans.Writer as W
import qualified Data.Text.Lazy.Builder as TLB
import Database.Esqueleto.Experimental.From
import Database.Esqueleto.Experimental.From.SqlSetOperation
import Database.Esqueleto.Experimental.ToAlias
import Database.Esqueleto.Experimental.ToAliasReference
import Database.Esqueleto.Internal.Internal hiding (From(..), from, on)

-- | @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 :: SqlQuery a -> SqlQuery (From a)
with SqlQuery a
query = do
    (a
ret, SideData
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
query
    a
aliasedValue <- a -> SqlQuery a
forall a. ToAlias a => a -> SqlQuery a
toAlias a
ret
    let aliasedQuery :: SqlQuery a
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 (f :: * -> *) a. Applicative f => a -> f a
pure (a
aliasedValue, SideData
sideData)
    Ident
ident <- DBName -> SqlQuery Ident
newIdentFor (Text -> DBName
DBName Text
"cte")
    let clause :: CommonTableExpressionClause
clause = CommonTableExpressionKind
-> Ident
-> (IdentInfo -> (Builder, [PersistValue]))
-> CommonTableExpressionClause
CommonTableExpressionClause CommonTableExpressionKind
NormalCommonTableExpression Ident
ident (\IdentInfo
info -> 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)
    WriterT SideData (State IdentState) () -> SqlQuery ()
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (WriterT SideData (State IdentState) () -> SqlQuery ())
-> WriterT SideData (State IdentState) () -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ SideData -> WriterT SideData (State IdentState) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
W.tell SideData
forall a. Monoid a => a
mempty{sdCteClause :: [CommonTableExpressionClause]
sdCteClause = [CommonTableExpressionClause
clause]}
    a
ref <- Ident -> a -> SqlQuery a
forall a. ToAliasReference a => Ident -> a -> SqlQuery a
toAliasReference Ident
ident a
aliasedValue
    From a -> SqlQuery (From a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (From a -> SqlQuery (From a)) -> From a -> SqlQuery (From a)
forall a b. (a -> b) -> a -> b
$ 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
$ (a, RawFn) -> SqlQuery (a, RawFn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
ref, (\NeedParens
_ IdentInfo
info -> (IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
ident, [PersistValue]
forall a. Monoid a => a
mempty)))

-- | @WITH@ @RECURSIVE@ allows one to make a recursive subquery, which can
-- reference itself. Like @WITH@, this is supported in most modern SQL engines.
-- Useful for hierarchical, self-referential data, like a tree of data.
--
-- @
-- select $ do
-- cte <- withRecursive
--          (do
--              person <- from $ table \@Person
--              where_ $ person ^. PersonId ==. val personId
--              pure person
--          )
--          unionAll_
--          (\\self -> do
--              (p :& f :& p2 :& pSelf) <- from self
--                       \`innerJoin\` $ table \@Follow
--                       \`on\` (\\(p :& f) ->
--                               p ^. PersonId ==. f ^. FollowFollower)
--                       \`innerJoin\` $ table \@Person
--                       \`on\` (\\(p :& f :& p2) ->
--                               f ^. FollowFollowed ==. p2 ^. PersonId)
--                       \`leftJoin\` self
--                       \`on\` (\\(_ :& _ :& p2 :& pSelf) ->
--                               just (p2 ^. PersonId) ==. pSelf ?. PersonId)
--              where_ $ isNothing (pSelf ?. PersonId)
--              groupBy (p2 ^. PersonId)
--              pure p2
--          )
-- from cte
-- @
--
-- /Since: 3.4.0.0/
withRecursive :: ( ToAlias a
                 , ToAliasReference a
                 , SqlSelect a r
                 )
              => SqlQuery a
              -> UnionKind
              -> (From a -> SqlQuery a)
              -> SqlQuery (From a)
withRecursive :: SqlQuery a
-> UnionKind -> (From a -> SqlQuery a) -> SqlQuery (From a)
withRecursive SqlQuery a
baseCase UnionKind
unionKind From a -> SqlQuery a
recursiveCase = do
    (a
ret, SideData
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
baseCase
    a
aliasedValue <- a -> SqlQuery a
forall a. ToAlias a => a -> SqlQuery a
toAlias a
ret
    let aliasedQuery :: SqlQuery a
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 (f :: * -> *) a. Applicative f => a -> f a
pure (a
aliasedValue, SideData
sideData)
    Ident
ident <- DBName -> SqlQuery Ident
newIdentFor (Text -> DBName
DBName Text
"cte")
    a
ref <- Ident -> a -> SqlQuery a
forall a. ToAliasReference a => Ident -> a -> SqlQuery a
toAliasReference Ident
ident a
aliasedValue
    let refFrom :: From a
refFrom = SqlQuery (a, RawFn) -> From a
forall a. SqlQuery (a, RawFn) -> From a
From ((a, RawFn) -> SqlQuery (a, RawFn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
ref, (\NeedParens
_ IdentInfo
info -> (IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
ident, [PersistValue]
forall a. Monoid a => a
mempty))))
    let recursiveQuery :: SqlQuery a
recursiveQuery = From a -> SqlQuery a
recursiveCase From a
refFrom
    let clause :: CommonTableExpressionClause
clause = CommonTableExpressionKind
-> Ident
-> (IdentInfo -> (Builder, [PersistValue]))
-> CommonTableExpressionClause
CommonTableExpressionClause CommonTableExpressionKind
RecursiveCommonTableExpression Ident
ident
                 (\IdentInfo
info -> (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)
                        (Builder, [PersistValue])
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall a. Semigroup a => a -> a -> a
<> (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (UnionKind -> Builder
unUnionKind UnionKind
unionKind)  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n", [PersistValue]
forall a. Monoid a => a
mempty)
                        (Builder, [PersistValue])
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall a. Semigroup a => a -> a -> a
<> (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
recursiveQuery)
                 )
    WriterT SideData (State IdentState) () -> SqlQuery ()
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (WriterT SideData (State IdentState) () -> SqlQuery ())
-> WriterT SideData (State IdentState) () -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ SideData -> WriterT SideData (State IdentState) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
W.tell SideData
forall a. Monoid a => a
mempty{sdCteClause :: [CommonTableExpressionClause]
sdCteClause = [CommonTableExpressionClause
clause]}
    From a -> SqlQuery (From a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure From a
refFrom

newtype UnionKind = UnionKind { UnionKind -> Builder
unUnionKind :: TLB.Builder }
instance Union_ UnionKind where
    union_ :: UnionKind
union_ = Builder -> UnionKind
UnionKind Builder
"UNION"
instance UnionAll_ UnionKind where
    unionAll_ :: UnionKind
unionAll_ = Builder -> UnionKind
UnionKind Builder
"UNION ALL"