{-# LANGUAGE CPP #-}
{-# language DerivingStrategies, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | This is an internal module, anything exported by this module
-- may change without a major version bump.  Please use only
-- "Database.Esqueleto" if possible.
--
-- If you use this module, please report what your use case is on the issue
-- tracker so we can safely support it.
module Database.Esqueleto.Internal.Internal where

import Control.Applicative ((<|>))
import Control.Arrow (first, (***))
import Control.Exception (Exception, throw, throwIO)
import Control.Monad (MonadPlus(..), guard, void)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Resource (MonadResource, release)
import Data.Acquire (Acquire, allocateAcquire, with)
import Data.Int (Int64)
import Data.List (intersperse)
import qualified Data.Maybe as Maybe
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup
#endif
import qualified Control.Monad.Trans.Reader as R
import qualified Control.Monad.Trans.State as S
import qualified Control.Monad.Trans.Writer as W
import qualified Data.ByteString as B
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import qualified Data.HashSet as HS
import qualified Data.Map.Strict as Map
import qualified Data.Monoid as Monoid
import Data.Proxy (Proxy(..))
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import Data.Typeable (Typeable)
import Database.Esqueleto.Internal.ExprParser (TableAccess(..), parseOnExpr)
import Database.Esqueleto.Internal.PersistentImport
import qualified Database.Persist
import Database.Persist.Sql.Util
       ( entityColumnCount
       , entityColumnNames
       , hasCompositeKey
       , isIdField
       , parseEntityValues
       )
import Text.Blaze.Html (Html)

-- | (Internal) Start a 'from' query with an entity. 'from'
-- does two kinds of magic using 'fromStart', 'fromJoin' and
-- 'fromFinish':
--
--   1.  The simple but tedious magic of allowing tuples to be
--   used.
--
--   2.  The more advanced magic of creating @JOIN@s.  The
--   @JOIN@ is processed from right to left.  The rightmost
--   entity of the @JOIN@ is created with 'fromStart'.  Each
--   @JOIN@ step is then translated into a call to 'fromJoin'.
--   In the end, 'fromFinish' is called to materialize the
--   @JOIN@.
fromStart
    :: forall a.
    ( PersistEntity a
    , BackendCompatible SqlBackend (PersistEntityBackend a)
    )
    => SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Entity a))))
fromStart :: SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Entity a))))
fromStart = do
    let ed :: EntityDef
ed = Proxy a -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    Ident
ident <- DBName -> SqlQuery Ident
newIdentFor (EntityDef -> DBName
entityDB EntityDef
ed)
    let ret :: SqlExpr (Entity a)
ret = Ident -> SqlExpr (Entity a)
forall val. Ident -> SqlExpr (Entity val)
EEntity Ident
ident
        f' :: FromClause
f' = Ident -> EntityDef -> FromClause
FromStart Ident
ident EntityDef
ed
    SqlExpr (PreprocessedFrom (SqlExpr (Entity a)))
-> SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Entity a))))
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlExpr (Entity a)
-> FromClause -> SqlExpr (PreprocessedFrom (SqlExpr (Entity a)))
forall a. a -> FromClause -> SqlExpr (PreprocessedFrom a)
EPreprocessedFrom SqlExpr (Entity a)
ret FromClause
f')

-- | (Internal) Same as 'fromStart', but entity may be missing.
fromStartMaybe
    :: ( PersistEntity a
       , BackendCompatible SqlBackend (PersistEntityBackend a)
       )
    => SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity a)))))
fromStartMaybe :: SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity a)))))
fromStartMaybe = SqlExpr (PreprocessedFrom (SqlExpr (Entity a)))
-> SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity a))))
forall a.
SqlExpr (PreprocessedFrom (SqlExpr (Entity a)))
-> SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity a))))
maybelize (SqlExpr (PreprocessedFrom (SqlExpr (Entity a)))
 -> SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity a)))))
-> SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Entity a))))
-> SqlQuery
     (SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity a)))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Entity a))))
forall a.
(PersistEntity a,
 BackendCompatible SqlBackend (PersistEntityBackend a)) =>
SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Entity a))))
fromStart
  where
    maybelize
        :: SqlExpr (PreprocessedFrom (SqlExpr (Entity a)))
        -> SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity a))))
    maybelize :: SqlExpr (PreprocessedFrom (SqlExpr (Entity a)))
-> SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity a))))
maybelize (EPreprocessedFrom a
ret FromClause
f') = SqlExpr (Maybe (Entity a))
-> FromClause
-> SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity a))))
forall a. a -> FromClause -> SqlExpr (PreprocessedFrom a)
EPreprocessedFrom (SqlExpr (Entity a) -> SqlExpr (Maybe (Entity a))
forall a. SqlExpr a -> SqlExpr (Maybe a)
EMaybe a
SqlExpr (Entity a)
ret) FromClause
f'

-- | (Internal) Do a @JOIN@.
fromJoin
    :: IsJoinKind join
    => SqlExpr (PreprocessedFrom a)
    -> SqlExpr (PreprocessedFrom b)
    -> SqlQuery (SqlExpr (PreprocessedFrom (join a b)))
fromJoin :: SqlExpr (PreprocessedFrom a)
-> SqlExpr (PreprocessedFrom b)
-> SqlQuery (SqlExpr (PreprocessedFrom (join a b)))
fromJoin (EPreprocessedFrom a
lhsRet FromClause
lhsFrom)
         (EPreprocessedFrom a
rhsRet FromClause
rhsFrom) = WriterT
  SideData (State IdentState) (SqlExpr (PreprocessedFrom (join a a)))
-> SqlQuery (SqlExpr (PreprocessedFrom (join a a)))
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (WriterT
   SideData (State IdentState) (SqlExpr (PreprocessedFrom (join a a)))
 -> SqlQuery (SqlExpr (PreprocessedFrom (join a a))))
-> WriterT
     SideData (State IdentState) (SqlExpr (PreprocessedFrom (join a a)))
-> SqlQuery (SqlExpr (PreprocessedFrom (join a a)))
forall a b. (a -> b) -> a -> b
$ do
    let ret :: join a a
ret = a -> a -> join a a
forall (join :: * -> * -> *) a b.
IsJoinKind join =>
a -> b -> join a b
smartJoin a
lhsRet a
rhsRet
        from' :: FromClause
from' =
            FromClause
-> JoinKind
-> FromClause
-> Maybe (SqlExpr (Value Bool))
-> FromClause
FromJoin
                FromClause
lhsFrom             -- LHS
                (join a a -> JoinKind
forall (join :: * -> * -> *) a b.
IsJoinKind join =>
join a b -> JoinKind
reifyJoinKind join a a
ret) -- JOIN
                FromClause
rhsFrom             -- RHS
                Maybe (SqlExpr (Value Bool))
forall a. Maybe a
Nothing             -- ON
    SqlExpr (PreprocessedFrom (join a a))
-> WriterT
     SideData (State IdentState) (SqlExpr (PreprocessedFrom (join a a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (join a a -> FromClause -> SqlExpr (PreprocessedFrom (join a a))
forall a. a -> FromClause -> SqlExpr (PreprocessedFrom a)
EPreprocessedFrom join a a
ret FromClause
from')

-- | (Internal) Finish a @JOIN@.
fromFinish
  :: SqlExpr (PreprocessedFrom a)
  -> SqlQuery a
fromFinish :: SqlExpr (PreprocessedFrom a) -> SqlQuery a
fromFinish (EPreprocessedFrom a
ret FromClause
f') = 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
$ do
    SideData -> WriterT SideData (State IdentState) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
W.tell SideData
forall a. Monoid a => a
mempty { sdFromClause :: [FromClause]
sdFromClause = [FromClause
f'] }
    a -> WriterT SideData (State IdentState) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
ret

-- | @WHERE@ clause: restrict the query's result.
where_ :: SqlExpr (Value Bool) -> SqlQuery ()
where_ :: SqlExpr (Value Bool) -> SqlQuery ()
where_ SqlExpr (Value Bool)
expr = 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 { sdWhereClause :: WhereClause
sdWhereClause = SqlExpr (Value Bool) -> WhereClause
Where SqlExpr (Value Bool)
expr }

-- | An @ON@ clause, useful to describe how two tables are related. Cross joins
-- and tuple-joins do not need an 'on' clause, but 'InnerJoin' and the various
-- outer joins do.
--
-- "Database.Esqueleto.Experimental" in version 4.0.0.0 of the library. The
-- @Experimental@ module has a dramatically improved means for introducing
-- tables and entities that provides more power and less potential for runtime
-- errors.
--
-- If you don't include an 'on' clause (or include too many!) then a runtime
-- exception will be thrown.
--
-- As an example, consider this simple join:
--
-- @
-- 'select' $
-- 'from' $ \\(foo `'InnerJoin`` bar) -> do
--   'on' (foo '^.' FooId '==.' bar '^.' BarFooId)
--   ...
-- @
--
-- We need to specify the clause for joining the two columns together. If we had
-- this:
--
-- @
-- 'select' $
-- 'from' $ \\(foo `'CrossJoin`` bar) -> do
--   ...
-- @
--
-- Then we can safely omit the 'on' clause, because the cross join will make
-- pairs of all records possible.
--
-- You can do multiple 'on' clauses in a query. This query joins three tables,
-- and has two 'on' clauses:
--
-- @
-- 'select' $
-- 'from' $ \\(foo `'InnerJoin`` bar `'InnerJoin`` baz) -> do
--   'on' (baz '^.' BazId '==.' bar '^.' BarBazId)
--   'on' (foo '^.' FooId '==.' bar '^.' BarFooId)
--   ...
-- @
--
-- Old versions of esqueleto required that you provide the 'on' clauses in
-- reverse order. This restriction has been lifted - you can now provide 'on'
-- clauses in any order, and the SQL should work itself out. The above query is
-- now totally equivalent to this:
--
-- @
-- 'select' $
-- 'from' $ \\(foo `'InnerJoin`` bar `'InnerJoin`` baz) -> do
--   'on' (foo '^.' FooId '==.' bar '^.' BarFooId)
--   'on' (baz '^.' BazId '==.' bar '^.' BarBazId)
--   ...
-- @
on :: SqlExpr (Value Bool) -> SqlQuery ()
on :: SqlExpr (Value Bool) -> SqlQuery ()
on SqlExpr (Value Bool)
expr = 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 { sdFromClause :: [FromClause]
sdFromClause = [SqlExpr (Value Bool) -> FromClause
OnClause SqlExpr (Value Bool)
expr] }

-- | @GROUP BY@ clause. You can enclose multiple columns
-- in a tuple.
--
-- @
-- select $ 'from' \\(foo `'InnerJoin`` bar) -> do
--   'on' (foo '^.' FooBarId '==.' bar '^.' BarId)
--   'groupBy' (bar '^.' BarId, bar '^.' BarName)
--   return (bar '^.' BarId, bar '^.' BarName, countRows)
-- @
--
-- With groupBy you can sort by aggregate functions, like so
-- (we used @let@ to restrict the more general 'countRows' to
-- @SqlSqlExpr (Value Int)@ to avoid ambiguity---the second use of
-- 'countRows' has its type restricted by the @:: Int@ below):
--
-- @
-- r \<- select $ 'from' \\(foo `'InnerJoin`` bar) -> do
--   'on' (foo '^.' FooBarId '==.' bar '^.' BarId)
--   'groupBy' $ bar '^.' BarName
--   let countRows' = 'countRows'
--   'orderBy' ['asc' countRows']
--   return (bar '^.' BarName, countRows')
-- forM_ r $ \\('Value' name, 'Value' count) -> do
--   print name
--   print (count :: Int)
-- @
--
-- === Need more columns?
--
-- The 'ToSomeValues' class is defined for 'SqlExpr' and tuples of 'SqlExpr's.
-- We only have definitions for up to 8 elements in a tuple right now, so it's
-- possible that you may need to have more than 8 elements.
--
-- For example, consider a query with a 'groupBy' call like this:
--
-- @
-- groupBy (e0, e1, e2, e3, e4, e5, e6, e7)
-- @
--
-- This is the biggest you can get with a single tuple. However, you can easily
-- nest the tuples to add more:
--
-- @
-- groupBy ((e0, e1, e2, e3, e4, e5, e6, e7), e8, e9)
-- @
groupBy :: (ToSomeValues a) => a -> SqlQuery ()
groupBy :: a -> SqlQuery ()
groupBy a
expr = 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 { sdGroupByClause :: GroupByClause
sdGroupByClause = [SomeValue] -> GroupByClause
GroupBy ([SomeValue] -> GroupByClause) -> [SomeValue] -> GroupByClause
forall a b. (a -> b) -> a -> b
$ a -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues a
expr }

-- | @ORDER BY@ clause. See also 'asc' and 'desc'.
--
-- Multiple calls to 'orderBy' get concatenated on the final
-- query, including 'distinctOnOrderBy'.
orderBy :: [SqlExpr OrderBy] -> SqlQuery ()
orderBy :: [SqlExpr OrderBy] -> SqlQuery ()
orderBy [SqlExpr OrderBy]
exprs = 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 { sdOrderByClause :: [SqlExpr OrderBy]
sdOrderByClause = [SqlExpr OrderBy]
exprs }

-- | Ascending order of this field or SqlExpression.
asc :: PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
asc :: SqlExpr (Value a) -> SqlExpr OrderBy
asc  = OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy
forall a. OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy
EOrderBy OrderByType
ASC

-- | Descending order of this field or SqlExpression.
desc :: PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
desc :: SqlExpr (Value a) -> SqlExpr OrderBy
desc = OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy
forall a. OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy
EOrderBy OrderByType
DESC

-- | @LIMIT@.  Limit the number of returned rows.
limit :: Int64 -> SqlQuery ()
limit :: Int64 -> SqlQuery ()
limit  Int64
n = 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 { sdLimitClause :: LimitClause
sdLimitClause = Maybe Int64 -> Maybe Int64 -> LimitClause
Limit (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
n) Maybe Int64
forall a. Maybe a
Nothing  }

-- | @OFFSET@.  Usually used with 'limit'.
offset :: Int64 -> SqlQuery ()
offset :: Int64 -> SqlQuery ()
offset Int64
n = 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 { sdLimitClause :: LimitClause
sdLimitClause = Maybe Int64 -> Maybe Int64 -> LimitClause
Limit Maybe Int64
forall a. Maybe a
Nothing  (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
n) }

-- | @DISTINCT@.  Change the current @SELECT@ into @SELECT
-- DISTINCT@.  For example:
--
-- @
-- select $ distinct $
--   'from' \\foo -> do
--   ...
-- @
--
-- Note that this also has the same effect:
--
-- @
-- select $
--   'from' \\foo -> do
--   distinct (return ())
--   ...
-- @
--
-- @since 2.2.4
distinct :: SqlQuery a -> SqlQuery a
distinct :: SqlQuery a -> SqlQuery a
distinct SqlQuery a
act = WriterT SideData (State IdentState) () -> SqlQuery ()
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (SideData -> WriterT SideData (State IdentState) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
W.tell SideData
forall a. Monoid a => a
mempty { sdDistinctClause :: DistinctClause
sdDistinctClause = DistinctClause
DistinctStandard }) SqlQuery () -> SqlQuery a -> SqlQuery a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SqlQuery a
act

-- | @DISTINCT ON@.  Change the current @SELECT@ into
-- @SELECT DISTINCT ON (SqlExpressions)@.  For example:
--
-- @
-- select $
--   'from' \\foo ->
--   'distinctOn' ['don' (foo ^. FooName), 'don' (foo ^. FooState)] $ do
--   ...
-- @
--
-- You can also chain different calls to 'distinctOn'.  The
-- above is equivalent to:
--
-- @
-- select $
--   'from' \\foo ->
--   'distinctOn' ['don' (foo ^. FooName)] $
--   'distinctOn' ['don' (foo ^. FooState)] $ do
--   ...
-- @
--
-- Each call to 'distinctOn' adds more SqlExpressions.  Calls to
-- 'distinctOn' override any calls to 'distinct'.
--
-- Note that PostgreSQL requires the SqlExpressions on @DISTINCT
-- ON@ to be the first ones to appear on a @ORDER BY@.  This is
-- not managed automatically by esqueleto, keeping its spirit
-- of trying to be close to raw SQL.
--
-- Supported by PostgreSQL only.
--
-- @since 2.2.4
distinctOn :: [SqlExpr DistinctOn] -> SqlQuery a -> SqlQuery a
distinctOn :: [SqlExpr DistinctOn] -> SqlQuery a -> SqlQuery a
distinctOn [SqlExpr DistinctOn]
exprs SqlQuery a
act = WriterT SideData (State IdentState) () -> SqlQuery ()
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (SideData -> WriterT SideData (State IdentState) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
W.tell SideData
forall a. Monoid a => a
mempty { sdDistinctClause :: DistinctClause
sdDistinctClause = [SqlExpr DistinctOn] -> DistinctClause
DistinctOn [SqlExpr DistinctOn]
exprs }) SqlQuery () -> SqlQuery a -> SqlQuery a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SqlQuery a
act

-- | Erase an SqlExpression's type so that it's suitable to
-- be used by 'distinctOn'.
--
-- @since 2.2.4
don :: SqlExpr (Value a) -> SqlExpr DistinctOn
don :: SqlExpr (Value a) -> SqlExpr DistinctOn
don = SqlExpr (Value a) -> SqlExpr DistinctOn
forall a. SqlExpr (Value a) -> SqlExpr DistinctOn
EDistinctOn

-- | A convenience function that calls both 'distinctOn' and
-- 'orderBy'.  In other words,
--
-- @
-- 'distinctOnOrderBy' [asc foo, desc bar, desc quux] $ do
--   ...
-- @
--
-- is the same as:
--
-- @
-- 'distinctOn' [don foo, don  bar, don  quux] $ do
--   'orderBy'  [asc foo, desc bar, desc quux]
--   ...
-- @
--
-- @since 2.2.4
distinctOnOrderBy :: [SqlExpr OrderBy] -> SqlQuery a -> SqlQuery a
distinctOnOrderBy :: [SqlExpr OrderBy] -> SqlQuery a -> SqlQuery a
distinctOnOrderBy [SqlExpr OrderBy]
exprs SqlQuery a
act =
    [SqlExpr DistinctOn] -> SqlQuery a -> SqlQuery a
forall a. [SqlExpr DistinctOn] -> SqlQuery a -> SqlQuery a
distinctOn (SqlExpr OrderBy -> SqlExpr DistinctOn
toDistinctOn (SqlExpr OrderBy -> SqlExpr DistinctOn)
-> [SqlExpr OrderBy] -> [SqlExpr DistinctOn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SqlExpr OrderBy]
exprs) (SqlQuery a -> SqlQuery a) -> SqlQuery a -> SqlQuery a
forall a b. (a -> b) -> a -> b
$ do
        [SqlExpr OrderBy] -> SqlQuery ()
orderBy [SqlExpr OrderBy]
exprs
        SqlQuery a
act
  where
    toDistinctOn :: SqlExpr OrderBy -> SqlExpr DistinctOn
    toDistinctOn :: SqlExpr OrderBy -> SqlExpr DistinctOn
toDistinctOn (EOrderBy OrderByType
_ SqlExpr (Value a)
f) = SqlExpr (Value a) -> SqlExpr DistinctOn
forall a. SqlExpr (Value a) -> SqlExpr DistinctOn
EDistinctOn SqlExpr (Value a)
f
    toDistinctOn SqlExpr OrderBy
EOrderRandom =
        [Char] -> SqlExpr DistinctOn
forall a. HasCallStack => [Char] -> a
error [Char]
"We can't select distinct by a random order!"

-- | @ORDER BY random()@ clause.
--
-- @since 1.3.10
rand :: SqlExpr OrderBy
rand :: SqlExpr OrderBy
rand = SqlExpr OrderBy
EOrderRandom

-- | @HAVING@.
--
-- @since 1.2.2
having :: SqlExpr (Value Bool) -> SqlQuery ()
having :: SqlExpr (Value Bool) -> SqlQuery ()
having SqlExpr (Value Bool)
expr = 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 { sdHavingClause :: WhereClause
sdHavingClause = SqlExpr (Value Bool) -> WhereClause
Where SqlExpr (Value Bool)
expr }

-- | Add a locking clause to the query.  Please read
-- 'LockingKind' documentation and your RDBMS manual.
--
-- If multiple calls to 'locking' are made on the same query,
-- the last one is used.
--
-- @since 2.2.7
locking :: LockingKind -> SqlQuery ()
locking :: LockingKind -> SqlQuery ()
locking LockingKind
kind = 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 { sdLockingClause :: LockingClause
sdLockingClause = Maybe LockingKind -> LockingClause
forall a. Maybe a -> Last a
Monoid.Last (LockingKind -> Maybe LockingKind
forall a. a -> Maybe a
Just LockingKind
kind) }

{-#
  DEPRECATED
    sub_select
    "sub_select \n \
sub_select is an unsafe function to use. If used with a SqlQuery that \n \
returns 0 results, then it may return NULL despite not mentioning Maybe \n \
in the return type. If it returns more than 1 result, then it will throw a \n \
SQL error.\n\n Instead, consider using one of the following alternatives: \n \
- subSelect: attaches a LIMIT 1 and the Maybe return type, totally safe.  \n \
- subSelectMaybe: Attaches a LIMIT 1, useful for a query that already \n \
  has a Maybe in the return type. \n \
- subSelectCount: Performs a count of the query - this is always safe. \n \
- subSelectUnsafe: Performs no checks or guarantees. Safe to use with \n \
  countRows and friends."
  #-}
-- | Execute a subquery @SELECT@ in an SqlExpression.  Returns a
-- simple value so should be used only when the @SELECT@ query
-- is guaranteed to return just one row.
--
-- Deprecated in 3.2.0.
sub_select :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
sub_select :: SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
sub_select         = Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
forall a.
PersistField a =>
Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
sub Mode
SELECT

-- | Execute a subquery @SELECT@ in a 'SqlExpr'. The query passed to this
-- function will only return a single result - it has a @LIMIT 1@ passed in to
-- the query to make it safe, and the return type is 'Maybe' to indicate that
-- the subquery might result in 0 rows.
--
-- If you find yourself writing @'joinV' . 'subSelect'@, then consider using
-- 'subSelectMaybe'.
--
-- If you're performing a 'countRows', then you can use 'subSelectCount' which
-- is safe.
--
-- If you know that the subquery will always return exactly one row (eg
-- a foreign key constraint guarantees that you'll get exactly one row), then
-- consider 'subSelectUnsafe', along with a comment explaining why it is safe.
--
-- @since 3.2.0
subSelect
  :: PersistField a
  => SqlQuery (SqlExpr (Value a))
  -> SqlExpr (Value (Maybe a))
subSelect :: SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value (Maybe a))
subSelect SqlQuery (SqlExpr (Value a))
query = SqlExpr (Value a) -> SqlExpr (Value (Maybe a))
forall typ. SqlExpr (Value typ) -> SqlExpr (Value (Maybe typ))
just (SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
forall a.
PersistField a =>
SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
subSelectUnsafe (SqlQuery (SqlExpr (Value a))
query SqlQuery (SqlExpr (Value a))
-> SqlQuery () -> SqlQuery (SqlExpr (Value a))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int64 -> SqlQuery ()
limit Int64
1))

-- | Execute a subquery @SELECT@ in a 'SqlExpr'. This function is a shorthand
-- for the common @'joinV' . 'subSelect'@ idiom, where you are calling
-- 'subSelect' on an expression that would be 'Maybe' already.
--
-- As an example, you would use this function when calling 'sum_' or 'max_',
-- which have 'Maybe' in the result type (for a 0 row query).
--
-- @since 3.2.0
subSelectMaybe
    :: PersistField a
    => SqlQuery (SqlExpr (Value (Maybe a)))
    -> SqlExpr (Value (Maybe a))
subSelectMaybe :: SqlQuery (SqlExpr (Value (Maybe a))) -> SqlExpr (Value (Maybe a))
subSelectMaybe = SqlExpr (Value (Maybe (Maybe a))) -> SqlExpr (Value (Maybe a))
forall typ.
SqlExpr (Value (Maybe (Maybe typ))) -> SqlExpr (Value (Maybe typ))
joinV (SqlExpr (Value (Maybe (Maybe a))) -> SqlExpr (Value (Maybe a)))
-> (SqlQuery (SqlExpr (Value (Maybe a)))
    -> SqlExpr (Value (Maybe (Maybe a))))
-> SqlQuery (SqlExpr (Value (Maybe a)))
-> SqlExpr (Value (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlQuery (SqlExpr (Value (Maybe a)))
-> SqlExpr (Value (Maybe (Maybe a)))
forall a.
PersistField a =>
SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value (Maybe a))
subSelect

-- | Performs a @COUNT@ of the given query in a @subSelect@ manner. This is
-- always guaranteed to return a result value, and is completely safe.
--
-- @since 3.2.0
subSelectCount
    :: (Num a, PersistField a)
    => SqlQuery ignored
    -> SqlExpr (Value a)
subSelectCount :: SqlQuery ignored -> SqlExpr (Value a)
subSelectCount SqlQuery ignored
query =
    SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
forall a.
PersistField a =>
SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
subSelectUnsafe (SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a))
-> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
forall a b. (a -> b) -> a -> b
$ do
        ignored
_ <- SqlQuery ignored
query
        SqlExpr (Value a) -> SqlQuery (SqlExpr (Value a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlExpr (Value a)
forall a. Num a => SqlExpr (Value a)
countRows

-- | Execute a subquery @SELECT@ in a 'SqlExpr' that returns a list. This is an
-- alias for 'subList_select' and is provided for symmetry with the other safe
-- subselect functions.
--
-- @since 3.2.0
subSelectList
    :: PersistField a
    => SqlQuery (SqlExpr (Value a))
    -> SqlExpr (ValueList a)
subSelectList :: SqlQuery (SqlExpr (Value a)) -> SqlExpr (ValueList a)
subSelectList = SqlQuery (SqlExpr (Value a)) -> SqlExpr (ValueList a)
forall a.
PersistField a =>
SqlQuery (SqlExpr (Value a)) -> SqlExpr (ValueList a)
subList_select

-- | Performs a sub-select using the given foreign key on the entity. This is
-- useful to extract values that are known to be present by the database schema.
--
-- As an example, consider the following persistent definition:
--
-- @
-- User
--   profile ProfileId
--
-- Profile
--   name    Text
-- @
--
-- The following query will return the name of the user.
--
-- @
-- getUserWithName =
--     'select' $
--     'from' $ \user ->
--     'pure' (user, 'subSelectForeign' user UserProfile (^. ProfileName)
-- @
--
-- @since 3.2.0
subSelectForeign
    ::
    ( BackendCompatible SqlBackend (PersistEntityBackend val1)
    , PersistEntity val1, PersistEntity val2, PersistField a
    )
    => SqlExpr (Entity val2)
    -- ^ An expression representing the table you have access to now.
    -> EntityField val2 (Key val1)
    -- ^ The foreign key field on the table.
    -> (SqlExpr (Entity val1) -> SqlExpr (Value a))
    -- ^ A function to extract a value from the foreign reference table.
    -> SqlExpr (Value a)
subSelectForeign :: SqlExpr (Entity val2)
-> EntityField val2 (Key val1)
-> (SqlExpr (Entity val1) -> SqlExpr (Value a))
-> SqlExpr (Value a)
subSelectForeign SqlExpr (Entity val2)
expr EntityField val2 (Key val1)
foreignKey SqlExpr (Entity val1) -> SqlExpr (Value a)
k =
    SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
forall a.
PersistField a =>
SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
subSelectUnsafe (SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a))
-> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
forall a b. (a -> b) -> a -> b
$
    (SqlExpr (Entity val1) -> SqlQuery (SqlExpr (Value a)))
-> SqlQuery (SqlExpr (Value a))
forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
from ((SqlExpr (Entity val1) -> SqlQuery (SqlExpr (Value a)))
 -> SqlQuery (SqlExpr (Value a)))
-> (SqlExpr (Entity val1) -> SqlQuery (SqlExpr (Value a)))
-> SqlQuery (SqlExpr (Value a))
forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity val1)
table -> do
    SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Value Bool) -> SqlQuery ())
-> SqlExpr (Value Bool) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity val2)
expr SqlExpr (Entity val2)
-> EntityField val2 (Key val1) -> SqlExpr (Value (Key val1))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField val2 (Key val1)
foreignKey SqlExpr (Value (Key val1))
-> SqlExpr (Value (Key val1)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity val1)
table SqlExpr (Entity val1)
-> EntityField val1 (Key val1) -> SqlExpr (Value (Key val1))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField val1 (Key val1)
forall record.
PersistEntity record =>
EntityField record (Key record)
persistIdField
    SqlExpr (Value a) -> SqlQuery (SqlExpr (Value a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Entity val1) -> SqlExpr (Value a)
k SqlExpr (Entity val1)
table)

-- | Execute a subquery @SELECT@ in a 'SqlExpr'. This function is unsafe,
-- because it can throw runtime exceptions in two cases:
--
-- 1. If the query passed has 0 result rows, then it will return a @NULL@ value.
--    The @persistent@ parsing operations will fail on an unexpected @NULL@.
-- 2. If the query passed returns more than one row, then the SQL engine will
--    fail with an error like "More than one row returned by a subquery used as
--    an expression".
--
-- This function is safe if you guarantee that exactly one row will be returned,
-- or if the result already has a 'Maybe' type for some reason.
--
-- For variants with the safety encoded already, see 'subSelect' and
-- 'subSelectMaybe'. For the most common safe use of this, see 'subSelectCount'.
--
-- @since 3.2.0
subSelectUnsafe :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
subSelectUnsafe :: SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
subSelectUnsafe = Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
forall a.
PersistField a =>
Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
sub Mode
SELECT

-- | Project a field of an entity.
(^.)
    :: forall typ val. (PersistEntity val, PersistField typ)
    => SqlExpr (Entity val)
    -> EntityField val typ
    -> SqlExpr (Value typ)
(EAliasedEntityReference Ident
source Ident
base) ^. :: SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField val typ
field =
    Ident -> (IdentInfo -> Ident) -> SqlExpr (Value typ)
forall a. Ident -> (IdentInfo -> Ident) -> SqlExpr (Value a)
EValueReference Ident
source (\IdentInfo
_ -> Ident -> FieldDef -> Ident
aliasedEntityColumnIdent Ident
base FieldDef
fieldDef)
  where
    fieldDef :: FieldDef
fieldDef =
        if EntityField val typ -> Bool
forall record typ.
PersistEntity record =>
EntityField record typ -> Bool
isIdField EntityField val typ
field then
            -- TODO what about composite natural keys in a join this will ignore them
            [FieldDef] -> FieldDef
forall a. [a] -> a
head ([FieldDef] -> FieldDef) -> [FieldDef] -> FieldDef
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
entityKeyFields EntityDef
ed
        else
            EntityField val typ -> FieldDef
forall record typ.
PersistEntity record =>
EntityField record typ -> FieldDef
persistFieldDef EntityField val typ
field

    ed :: EntityDef
ed = Proxy val -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Proxy val -> EntityDef) -> Proxy val -> EntityDef
forall a b. (a -> b) -> a -> b
$ Proxy (SqlExpr (Entity val)) -> Proxy val
forall a. Proxy (SqlExpr (Entity a)) -> Proxy a
getEntityVal (Proxy (SqlExpr (Entity val))
forall k (t :: k). Proxy t
Proxy :: Proxy (SqlExpr (Entity val)))

SqlExpr (Entity val)
e ^. EntityField val typ
field
    | EntityField val typ -> Bool
forall record typ.
PersistEntity record =>
EntityField record typ -> Bool
isIdField EntityField val typ
field = SqlExpr (Value typ)
idFieldValue
    | Bool
otherwise = NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value typ)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value typ))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value typ)
forall a b. (a -> b) -> a -> b
$ \IdentInfo
info -> (IdentInfo -> FieldDef -> Builder
dot IdentInfo
info (FieldDef -> Builder) -> FieldDef -> Builder
forall a b. (a -> b) -> a -> b
$ EntityField val typ -> FieldDef
forall record typ.
PersistEntity record =>
EntityField record typ -> FieldDef
persistFieldDef EntityField val typ
field, [])
  where
    idFieldValue :: SqlExpr (Value typ)
idFieldValue =
        case EntityDef -> [FieldDef]
entityKeyFields EntityDef
ed of
            FieldDef
idField:[] ->
                NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value typ)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never    ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value typ))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value typ)
forall a b. (a -> b) -> a -> b
$ \IdentInfo
info -> (IdentInfo -> FieldDef -> Builder
dot IdentInfo
info FieldDef
idField, [])

            [FieldDef]
idFields ->
                (IdentInfo -> [Builder]) -> SqlExpr (Value typ)
forall a. (IdentInfo -> [Builder]) -> SqlExpr (Value a)
ECompositeKey ((IdentInfo -> [Builder]) -> SqlExpr (Value typ))
-> (IdentInfo -> [Builder]) -> SqlExpr (Value typ)
forall a b. (a -> b) -> a -> b
$ \IdentInfo
info ->  IdentInfo -> FieldDef -> Builder
dot IdentInfo
info (FieldDef -> Builder) -> [FieldDef] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldDef]
idFields


    ed :: EntityDef
ed = Proxy val -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Proxy val -> EntityDef) -> Proxy val -> EntityDef
forall a b. (a -> b) -> a -> b
$ Proxy (SqlExpr (Entity val)) -> Proxy val
forall a. Proxy (SqlExpr (Entity a)) -> Proxy a
getEntityVal (Proxy (SqlExpr (Entity val))
forall k (t :: k). Proxy t
Proxy :: Proxy (SqlExpr (Entity val)))

    dot :: IdentInfo -> FieldDef -> Builder
dot IdentInfo
info FieldDef
fieldDef =
        IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
sourceIdent Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fieldIdent
      where
        sourceIdent :: Ident
sourceIdent =
            case SqlExpr (Entity val)
e of
                EEntity Ident
ident -> Ident
ident
                EAliasedEntity Ident
baseI Ident
_ -> Ident
baseI
                EAliasedEntityReference Ident
a Ident
b ->
                    [Char] -> Ident
forall a. HasCallStack => [Char] -> a
error ([Char] -> Ident) -> [Char] -> Ident
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords
                        [ [Char]
"Used (^.) with an EAliasedEntityReference."
                        , [Char]
"Please file this as an Esqueleto bug."
                        , [Char]
"EAliasedEntityReference", Ident -> [Char]
forall a. Show a => a -> [Char]
show Ident
a, Ident -> [Char]
forall a. Show a => a -> [Char]
show Ident
b
                        ]
        fieldIdent :: Builder
fieldIdent =
            case SqlExpr (Entity val)
e of
                EEntity Ident
_ -> IdentInfo -> DBName -> Builder
fromDBName IdentInfo
info (FieldDef -> DBName
fieldDB FieldDef
fieldDef)
                EAliasedEntity Ident
baseI Ident
_ -> IdentInfo -> Ident -> Builder
useIdent IdentInfo
info (Ident -> Builder) -> Ident -> Builder
forall a b. (a -> b) -> a -> b
$ Ident -> FieldDef -> Ident
aliasedEntityColumnIdent Ident
baseI FieldDef
fieldDef
                EAliasedEntityReference Ident
a Ident
b ->
                    [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char] -> Builder) -> [Char] -> Builder
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords
                        [ [Char]
"Used (^.) with an EAliasedEntityReference."
                        , [Char]
"Please file this as an Esqueleto bug."
                        , [Char]
"EAliasedEntityReference", Ident -> [Char]
forall a. Show a => a -> [Char]
show Ident
a, Ident -> [Char]
forall a. Show a => a -> [Char]
show Ident
b
                        ]


-- | Project an SqlExpression that may be null, guarding against null cases.
withNonNull
    :: PersistField typ
    => SqlExpr (Value (Maybe typ))
    -> (SqlExpr (Value typ) -> SqlQuery a)
    -> SqlQuery a
withNonNull :: SqlExpr (Value (Maybe typ))
-> (SqlExpr (Value typ) -> SqlQuery a) -> SqlQuery a
withNonNull SqlExpr (Value (Maybe typ))
field SqlExpr (Value typ) -> SqlQuery a
f = do
    SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Value Bool) -> SqlQuery ())
-> SqlExpr (Value Bool) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ SqlExpr (Value Bool) -> SqlExpr (Value Bool)
not_ (SqlExpr (Value Bool) -> SqlExpr (Value Bool))
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
forall a b. (a -> b) -> a -> b
$ SqlExpr (Value (Maybe typ)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value (Maybe typ)) -> SqlExpr (Value Bool)
isNothing SqlExpr (Value (Maybe typ))
field
    SqlExpr (Value typ) -> SqlQuery a
f (SqlExpr (Value typ) -> SqlQuery a)
-> SqlExpr (Value typ) -> SqlQuery a
forall a b. (a -> b) -> a -> b
$ SqlExpr (Value (Maybe typ)) -> SqlExpr (Value typ)
forall a b. SqlExpr (Value a) -> SqlExpr (Value b)
veryUnsafeCoerceSqlExprValue SqlExpr (Value (Maybe typ))
field

-- | Project a field of an entity that may be null.
(?.)
    :: (PersistEntity val, PersistField typ)
    => SqlExpr (Maybe (Entity val))
    -> EntityField val typ
    -> SqlExpr (Value (Maybe typ))
EMaybe SqlExpr a
r ?. :: SqlExpr (Maybe (Entity val))
-> EntityField val typ -> SqlExpr (Value (Maybe typ))
?. EntityField val typ
field = SqlExpr (Value typ) -> SqlExpr (Value (Maybe typ))
forall typ. SqlExpr (Value typ) -> SqlExpr (Value (Maybe typ))
just (SqlExpr a
SqlExpr (Entity val)
r SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField val typ
field)

-- | Lift a constant value from Haskell-land to the query.
val  :: PersistField typ => typ -> SqlExpr (Value typ)
val :: typ -> SqlExpr (Value typ)
val typ
v = NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value typ)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value typ))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value typ)
forall a b. (a -> b) -> a -> b
$ (Builder, [PersistValue]) -> IdentInfo -> (Builder, [PersistValue])
forall a b. a -> b -> a
const (Builder
"?", [typ -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue typ
v])

-- | @IS NULL@ comparison.
--
-- For @IS NOT NULL@, you can negate this with 'not_', as in @not_ (isNothing (person ^. PersonAge))@
--
-- Warning: Persistent and Esqueleto have different behavior for @!= Nothing@:
--
-- +----------------+----------------------------------+---------------+
-- |                | Haskell                          | SQL           |
-- +================+==================================+===============+
-- | __Persistent__ | @'Database.Persist.!=.' Nothing@ | @IS NOT NULL@ |
-- +----------------+----------------------------------+---------------+
-- | __Esqueleto__  | @'!=.' Nothing@                  | @!= NULL@     |
-- +----------------+----------------------------------+---------------+
--
-- In SQL, @= NULL@ and @!= NULL@ return NULL instead of true or false. For this reason, you very likely do not want to use @'!=.' Nothing@ in Esqueleto.
-- You may find these @hlint@ rules helpful to enforce this:
--
-- > - error: {lhs: v ==. nothing, rhs: Database.Esqueleto.isNothing v, name: Use Esqueleto's isNothing}
-- > - error: {lhs: v ==. val Nothing, rhs: Database.Esqueleto.isNothing v, name: Use Esqueleto's isNothing}
-- > - error: {lhs: v !=. nothing, rhs: not_ (Database.Esqueleto.isNothing v), name: Use Esqueleto's not isNothing}
-- > - error: {lhs: v !=. val Nothing, rhs: not_ (Database.Esqueleto.isNothing v), name: Use Esqueleto's not isNothing}
isNothing :: PersistField typ => SqlExpr (Value (Maybe typ)) -> SqlExpr (Value Bool)
isNothing :: SqlExpr (Value (Maybe typ)) -> SqlExpr (Value Bool)
isNothing SqlExpr (Value (Maybe typ))
v =
    case SqlExpr (Value (Maybe typ))
v of
        ERaw NeedParens
p IdentInfo -> (Builder, [PersistValue])
f ->
            (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool)
isNullExpr ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool)
forall a b. (a -> b) -> a -> b
$ (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
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]))
-> (IdentInfo -> (Builder, [PersistValue]))
-> IdentInfo
-> (Builder, [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> (Builder, [PersistValue])
f
        EAliasedValue Ident
i SqlExpr (Value a)
_ ->
            (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool)
isNullExpr ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool)
forall a b. (a -> b) -> a -> b
$ Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i
        EValueReference Ident
i IdentInfo -> Ident
i' ->
            (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool)
isNullExpr ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool)
forall a b. (a -> b) -> a -> b
$ Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i'
        ECompositeKey IdentInfo -> [Builder]
f ->
            NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Parens ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool)
forall a b. (a -> b) -> a -> b
$ (Builder -> [PersistValue] -> (Builder, [PersistValue]))
-> [PersistValue] -> Builder -> (Builder, [PersistValue])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [] (Builder -> (Builder, [PersistValue]))
-> (IdentInfo -> Builder) -> IdentInfo -> (Builder, [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> [Builder] -> Builder
intersperseB Builder
" AND " ([Builder] -> Builder)
-> ([Builder] -> [Builder]) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Builder) -> [Builder] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" IS NULL")) ([Builder] -> Builder)
-> (IdentInfo -> [Builder]) -> IdentInfo -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> [Builder]
f
  where
    isNullExpr :: (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value Bool)
    isNullExpr :: (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool)
isNullExpr IdentInfo -> (Builder, [PersistValue])
g = NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Parens ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool)
forall a b. (a -> b) -> a -> b
$ (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" IS NULL")) ((Builder, [PersistValue]) -> (Builder, [PersistValue]))
-> (IdentInfo -> (Builder, [PersistValue]))
-> IdentInfo
-> (Builder, [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> (Builder, [PersistValue])
g

-- | Analogous to 'Just', promotes a value of type @typ@ into
-- one of type @Maybe typ@.  It should hold that @'val' . Just
-- === just . 'val'@.
just :: SqlExpr (Value typ) -> SqlExpr (Value (Maybe typ))
just :: SqlExpr (Value typ) -> SqlExpr (Value (Maybe typ))
just SqlExpr (Value typ)
exprVal = case SqlExpr (Value typ)
exprVal of
    ERaw NeedParens
p IdentInfo -> (Builder, [PersistValue])
f -> NeedParens
-> (IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Value (Maybe typ))
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
p IdentInfo -> (Builder, [PersistValue])
f
    ECompositeKey IdentInfo -> [Builder]
f -> (IdentInfo -> [Builder]) -> SqlExpr (Value (Maybe typ))
forall a. (IdentInfo -> [Builder]) -> SqlExpr (Value a)
ECompositeKey IdentInfo -> [Builder]
f
    EAliasedValue Ident
i SqlExpr (Value a)
v -> Ident -> SqlExpr (Value (Maybe a)) -> SqlExpr (Value (Maybe a))
forall a. Ident -> SqlExpr (Value a) -> SqlExpr (Value a)
EAliasedValue Ident
i (SqlExpr (Value a) -> SqlExpr (Value (Maybe a))
forall typ. SqlExpr (Value typ) -> SqlExpr (Value (Maybe typ))
just SqlExpr (Value a)
v)
    EValueReference Ident
i IdentInfo -> Ident
i' -> Ident -> (IdentInfo -> Ident) -> SqlExpr (Value (Maybe typ))
forall a. Ident -> (IdentInfo -> Ident) -> SqlExpr (Value a)
EValueReference Ident
i IdentInfo -> Ident
i'

-- | @NULL@ value.
nothing :: SqlExpr (Value (Maybe typ))
nothing :: SqlExpr (Value (Maybe typ))
nothing = Builder -> SqlExpr (Value (Maybe typ))
forall a. Builder -> SqlExpr (Value a)
unsafeSqlValue Builder
"NULL"

-- | Join nested 'Maybe's in a 'Value' into one. This is useful when
-- calling aggregate functions on nullable fields.
joinV :: SqlExpr (Value (Maybe (Maybe typ))) -> SqlExpr (Value (Maybe typ))
joinV :: SqlExpr (Value (Maybe (Maybe typ))) -> SqlExpr (Value (Maybe typ))
joinV SqlExpr (Value (Maybe (Maybe typ)))
exprMM = case SqlExpr (Value (Maybe (Maybe typ)))
exprMM of
    ERaw NeedParens
p IdentInfo -> (Builder, [PersistValue])
f -> NeedParens
-> (IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Value (Maybe typ))
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
p IdentInfo -> (Builder, [PersistValue])
f
    ECompositeKey IdentInfo -> [Builder]
f -> (IdentInfo -> [Builder]) -> SqlExpr (Value (Maybe typ))
forall a. (IdentInfo -> [Builder]) -> SqlExpr (Value a)
ECompositeKey IdentInfo -> [Builder]
f
    EAliasedValue Ident
i SqlExpr (Value a)
v -> Ident -> SqlExpr (Value (Maybe typ)) -> SqlExpr (Value (Maybe typ))
forall a. Ident -> SqlExpr (Value a) -> SqlExpr (Value a)
EAliasedValue Ident
i (SqlExpr (Value (Maybe (Maybe typ))) -> SqlExpr (Value (Maybe typ))
forall typ.
SqlExpr (Value (Maybe (Maybe typ))) -> SqlExpr (Value (Maybe typ))
joinV SqlExpr (Value a)
SqlExpr (Value (Maybe (Maybe typ)))
v)
    EValueReference Ident
i IdentInfo -> Ident
i' -> Ident -> (IdentInfo -> Ident) -> SqlExpr (Value (Maybe typ))
forall a. Ident -> (IdentInfo -> Ident) -> SqlExpr (Value a)
EValueReference Ident
i IdentInfo -> Ident
i'


countHelper :: Num a => TLB.Builder -> TLB.Builder -> SqlExpr (Value typ) -> SqlExpr (Value a)
countHelper :: Builder -> Builder -> SqlExpr (Value typ) -> SqlExpr (Value a)
countHelper Builder
open Builder
close SqlExpr (Value typ)
v =
    case SqlExpr (Value typ)
v of
        ERaw NeedParens
_ IdentInfo -> (Builder, [PersistValue])
f -> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a.
(IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
countRawSql IdentInfo -> (Builder, [PersistValue])
f
        EAliasedValue Ident
i SqlExpr (Value a)
_ -> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a.
(IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
countRawSql ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a b. (a -> b) -> a -> b
$ Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i
        EValueReference Ident
i IdentInfo -> Ident
i' -> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a.
(IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
countRawSql ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a b. (a -> b) -> a -> b
$ Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i'
        ECompositeKey IdentInfo -> [Builder]
_ -> SqlExpr (Value a)
forall a. Num a => SqlExpr (Value a)
countRows
  where
    countRawSql :: (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a)
    countRawSql :: (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
countRawSql IdentInfo -> (Builder, [PersistValue])
x = NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a b. (a -> b) -> a -> b
$ (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (\Builder
b -> Builder
"COUNT" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
open Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
close) ((Builder, [PersistValue]) -> (Builder, [PersistValue]))
-> (IdentInfo -> (Builder, [PersistValue]))
-> IdentInfo
-> (Builder, [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> (Builder, [PersistValue])
x

-- | @COUNT(*)@ value.
countRows :: Num a => SqlExpr (Value a)
countRows :: SqlExpr (Value a)
countRows = Builder -> SqlExpr (Value a)
forall a. Builder -> SqlExpr (Value a)
unsafeSqlValue Builder
"COUNT(*)"

-- | @COUNT@.
count :: Num a => SqlExpr (Value typ) -> SqlExpr (Value a)
count :: SqlExpr (Value typ) -> SqlExpr (Value a)
count = Builder -> Builder -> SqlExpr (Value typ) -> SqlExpr (Value a)
forall a typ.
Num a =>
Builder -> Builder -> SqlExpr (Value typ) -> SqlExpr (Value a)
countHelper Builder
""           Builder
""

-- | @COUNT(DISTINCT x)@.
--
-- @since 2.4.1
countDistinct :: Num a => SqlExpr (Value typ) -> SqlExpr (Value a)
countDistinct :: SqlExpr (Value typ) -> SqlExpr (Value a)
countDistinct = Builder -> Builder -> SqlExpr (Value typ) -> SqlExpr (Value a)
forall a typ.
Num a =>
Builder -> Builder -> SqlExpr (Value typ) -> SqlExpr (Value a)
countHelper Builder
"(DISTINCT " Builder
")"

not_ :: SqlExpr (Value Bool) -> SqlExpr (Value Bool)
not_ :: SqlExpr (Value Bool) -> SqlExpr (Value Bool)
not_ SqlExpr (Value Bool)
v = NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Bool)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never (\IdentInfo
info -> (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Builder
"NOT " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) ((Builder, [PersistValue]) -> (Builder, [PersistValue]))
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ IdentInfo -> (Builder, [PersistValue])
x IdentInfo
info)
  where
    x :: IdentInfo -> (Builder, [PersistValue])
x IdentInfo
info =
        case SqlExpr (Value Bool)
v of
            ERaw NeedParens
p IdentInfo -> (Builder, [PersistValue])
f ->
                let (Builder
b, [PersistValue]
vals) = IdentInfo -> (Builder, [PersistValue])
f IdentInfo
info
                in (NeedParens -> Builder -> Builder
parensM NeedParens
p Builder
b, [PersistValue]
vals)
            ECompositeKey IdentInfo -> [Builder]
_      ->
                EsqueletoError -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
NotError)
            EAliasedValue Ident
i SqlExpr (Value a)
_    ->
                Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i IdentInfo
info
            EValueReference Ident
i IdentInfo -> Ident
i' ->
                Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i' IdentInfo
info

(==.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. :: SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
(==.) = Builder
-> Builder
-> SqlExpr (Value typ)
-> SqlExpr (Value typ)
-> SqlExpr (Value Bool)
forall a b c.
Builder
-> Builder
-> SqlExpr (Value a)
-> SqlExpr (Value b)
-> SqlExpr (Value c)
unsafeSqlBinOpComposite Builder
" = " Builder
" AND "

(>=.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
>=. :: SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
(>=.) = Builder
-> SqlExpr (Value typ)
-> SqlExpr (Value typ)
-> SqlExpr (Value Bool)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
" >= "

(>.)  :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
>. :: SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
(>.)  = Builder
-> SqlExpr (Value typ)
-> SqlExpr (Value typ)
-> SqlExpr (Value Bool)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
" > "

(<=.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
<=. :: SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
(<=.) = Builder
-> SqlExpr (Value typ)
-> SqlExpr (Value typ)
-> SqlExpr (Value Bool)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
" <= "

(<.)  :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
<. :: SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
(<.)  = Builder
-> SqlExpr (Value typ)
-> SqlExpr (Value typ)
-> SqlExpr (Value Bool)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
" < "
(!=.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
!=. :: SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
(!=.) = Builder
-> Builder
-> SqlExpr (Value typ)
-> SqlExpr (Value typ)
-> SqlExpr (Value Bool)
forall a b c.
Builder
-> Builder
-> SqlExpr (Value a)
-> SqlExpr (Value b)
-> SqlExpr (Value c)
unsafeSqlBinOpComposite Builder
" != " Builder
" OR "

(&&.) :: SqlExpr (Value Bool) -> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
&&. :: SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
(&&.) = Builder
-> SqlExpr (Value Bool)
-> SqlExpr (Value Bool)
-> SqlExpr (Value Bool)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
" AND "

(||.) :: SqlExpr (Value Bool) -> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
||. :: SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
(||.) = Builder
-> SqlExpr (Value Bool)
-> SqlExpr (Value Bool)
-> SqlExpr (Value Bool)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
" OR "

(+.)  :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
+. :: SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
(+.)  = Builder
-> SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
" + "

(-.)  :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
-. :: SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
(-.)  = Builder
-> SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
" - "

(/.)  :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
/. :: SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
(/.)  = Builder
-> SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
" / "

(*.)  :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
*. :: SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
(*.)  = Builder
-> SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
" * "

-- | @BETWEEN@.
--
-- @since: 3.1.0
between :: PersistField a => SqlExpr (Value a) -> (SqlExpr (Value a), SqlExpr (Value a)) -> SqlExpr (Value Bool)
SqlExpr (Value a)
a between :: SqlExpr (Value a)
-> (SqlExpr (Value a), SqlExpr (Value a)) -> SqlExpr (Value Bool)
`between` (SqlExpr (Value a)
b, SqlExpr (Value a)
c) = SqlExpr (Value a)
a SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
>=. SqlExpr (Value a)
b SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
&&. SqlExpr (Value a)
a SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
<=. SqlExpr (Value a)
c

random_  :: (PersistField a, Num a) => SqlExpr (Value a)
random_ :: SqlExpr (Value a)
random_  = Builder -> SqlExpr (Value a)
forall a. Builder -> SqlExpr (Value a)
unsafeSqlValue Builder
"RANDOM()"

round_   :: (PersistField a, Num a, PersistField b, Num b) => SqlExpr (Value a) -> SqlExpr (Value b)
round_ :: SqlExpr (Value a) -> SqlExpr (Value b)
round_   = Builder -> SqlExpr (Value a) -> SqlExpr (Value b)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"ROUND"

ceiling_ :: (PersistField a, Num a, PersistField b, Num b) => SqlExpr (Value a) -> SqlExpr (Value b)
ceiling_ :: SqlExpr (Value a) -> SqlExpr (Value b)
ceiling_ = Builder -> SqlExpr (Value a) -> SqlExpr (Value b)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"CEILING"

floor_   :: (PersistField a, Num a, PersistField b, Num b) => SqlExpr (Value a) -> SqlExpr (Value b)
floor_ :: SqlExpr (Value a) -> SqlExpr (Value b)
floor_   = Builder -> SqlExpr (Value a) -> SqlExpr (Value b)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"FLOOR"

sum_     :: (PersistField a, PersistField b) => SqlExpr (Value a) -> SqlExpr (Value (Maybe b))
sum_ :: SqlExpr (Value a) -> SqlExpr (Value (Maybe b))
sum_     = Builder -> SqlExpr (Value a) -> SqlExpr (Value (Maybe b))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"SUM"
min_     :: (PersistField a) => SqlExpr (Value a) -> SqlExpr (Value (Maybe a))
min_ :: SqlExpr (Value a) -> SqlExpr (Value (Maybe a))
min_     = Builder -> SqlExpr (Value a) -> SqlExpr (Value (Maybe a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"MIN"
max_     :: (PersistField a) => SqlExpr (Value a) -> SqlExpr (Value (Maybe a))
max_ :: SqlExpr (Value a) -> SqlExpr (Value (Maybe a))
max_     = Builder -> SqlExpr (Value a) -> SqlExpr (Value (Maybe a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"MAX"
avg_     :: (PersistField a, PersistField b) => SqlExpr (Value a) -> SqlExpr (Value (Maybe b))
avg_ :: SqlExpr (Value a) -> SqlExpr (Value (Maybe b))
avg_     = Builder -> SqlExpr (Value a) -> SqlExpr (Value (Maybe b))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"AVG"

-- | Allow a number of one type to be used as one of another
-- type via an implicit cast.  An explicit cast is not made,
-- this function changes only the types on the Haskell side.
--
-- /Caveat/: Trying to use @castNum@ from @Double@ to @Int@
-- will not result in an integer, the original fractional
-- number will still be used!  Use 'round_', 'ceiling_' or
-- 'floor_' instead.
--
-- /Safety/: This operation is mostly safe due to the 'Num'
-- constraint between the types and the fact that RDBMSs
-- usually allow numbers of different types to be used
-- interchangeably.  However, there may still be issues with
-- the query not being accepted by the RDBMS or @persistent@
-- not being able to parse it.
--
-- @since 2.2.9
castNum :: (Num a, Num b) => SqlExpr (Value a) -> SqlExpr (Value b)
castNum :: SqlExpr (Value a) -> SqlExpr (Value b)
castNum  = SqlExpr (Value a) -> SqlExpr (Value b)
forall a b. SqlExpr (Value a) -> SqlExpr (Value b)
veryUnsafeCoerceSqlExprValue

-- | Same as 'castNum', but for nullable values.
--
-- @since 2.2.9
castNumM :: (Num a, Num b) => SqlExpr (Value (Maybe a)) -> SqlExpr (Value (Maybe b))
castNumM :: SqlExpr (Value (Maybe a)) -> SqlExpr (Value (Maybe b))
castNumM = SqlExpr (Value (Maybe a)) -> SqlExpr (Value (Maybe b))
forall a b. SqlExpr (Value a) -> SqlExpr (Value b)
veryUnsafeCoerceSqlExprValue

-- | @COALESCE@ function. Evaluates the arguments in order and
-- returns the value of the first non-NULL SqlExpression, or NULL
-- (Nothing) otherwise. Some RDBMSs (such as SQLite) require
-- at least two arguments; please refer to the appropriate
-- documentation.
--
-- @since 1.4.3
coalesce :: PersistField a => [SqlExpr (Value (Maybe a))] -> SqlExpr (Value (Maybe a))
coalesce :: [SqlExpr (Value (Maybe a))] -> SqlExpr (Value (Maybe a))
coalesce              = Builder -> [SqlExpr (Value (Maybe a))] -> SqlExpr (Value (Maybe a))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunctionParens Builder
"COALESCE"

-- | Like @coalesce@, but takes a non-nullable SqlExpression
-- placed at the end of the SqlExpression list, which guarantees
-- a non-NULL result.
--
-- @since 1.4.3
coalesceDefault :: PersistField a => [SqlExpr (Value (Maybe a))] -> SqlExpr (Value a) -> SqlExpr (Value a)
coalesceDefault :: [SqlExpr (Value (Maybe a))]
-> SqlExpr (Value a) -> SqlExpr (Value a)
coalesceDefault [SqlExpr (Value (Maybe a))]
exprs = Builder -> [SqlExpr (Value (Maybe a))] -> SqlExpr (Value a)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunctionParens Builder
"COALESCE" ([SqlExpr (Value (Maybe a))] -> SqlExpr (Value a))
-> (SqlExpr (Value a) -> [SqlExpr (Value (Maybe a))])
-> SqlExpr (Value a)
-> SqlExpr (Value a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SqlExpr (Value (Maybe a))]
exprs [SqlExpr (Value (Maybe a))]
-> [SqlExpr (Value (Maybe a))] -> [SqlExpr (Value (Maybe a))]
forall a. [a] -> [a] -> [a]
++) ([SqlExpr (Value (Maybe a))] -> [SqlExpr (Value (Maybe a))])
-> (SqlExpr (Value a) -> [SqlExpr (Value (Maybe a))])
-> SqlExpr (Value a)
-> [SqlExpr (Value (Maybe a))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlExpr (Value (Maybe a)) -> [SqlExpr (Value (Maybe a))]
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlExpr (Value (Maybe a)) -> [SqlExpr (Value (Maybe a))])
-> (SqlExpr (Value a) -> SqlExpr (Value (Maybe a)))
-> SqlExpr (Value a)
-> [SqlExpr (Value (Maybe a))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlExpr (Value a) -> SqlExpr (Value (Maybe a))
forall typ. SqlExpr (Value typ) -> SqlExpr (Value (Maybe typ))
just

-- | @LOWER@ function.
lower_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
lower_ :: SqlExpr (Value s) -> SqlExpr (Value s)
lower_  = Builder -> SqlExpr (Value s) -> SqlExpr (Value s)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"LOWER"

-- | @UPPER@ function.
-- @since 3.3.0
upper_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
upper_ :: SqlExpr (Value s) -> SqlExpr (Value s)
upper_  = Builder -> SqlExpr (Value s) -> SqlExpr (Value s)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"UPPER"

-- | @TRIM@ function.
-- @since 3.3.0
trim_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
trim_ :: SqlExpr (Value s) -> SqlExpr (Value s)
trim_  = Builder -> SqlExpr (Value s) -> SqlExpr (Value s)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"TRIM"

-- | @RTRIM@ function.
-- @since 3.3.0
rtrim_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
rtrim_ :: SqlExpr (Value s) -> SqlExpr (Value s)
rtrim_  = Builder -> SqlExpr (Value s) -> SqlExpr (Value s)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"RTRIM"

-- | @LTRIM@ function.
-- @since 3.3.0
ltrim_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
ltrim_ :: SqlExpr (Value s) -> SqlExpr (Value s)
ltrim_  = Builder -> SqlExpr (Value s) -> SqlExpr (Value s)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"LTRIM"

-- | @LENGTH@ function.
-- @since 3.3.0
length_ :: (SqlString s, Num a) => SqlExpr (Value s) -> SqlExpr (Value a)
length_ :: SqlExpr (Value s) -> SqlExpr (Value a)
length_ = Builder -> SqlExpr (Value s) -> SqlExpr (Value a)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"LENGTH"

-- | @LEFT@ function.
-- @since 3.3.0
left_ :: (SqlString s, Num a) => (SqlExpr (Value s), SqlExpr (Value a)) -> SqlExpr (Value s)
left_ :: (SqlExpr (Value s), SqlExpr (Value a)) -> SqlExpr (Value s)
left_ = Builder
-> (SqlExpr (Value s), SqlExpr (Value a)) -> SqlExpr (Value s)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"LEFT"

-- | @RIGHT@ function.
-- @since 3.3.0
right_ :: (SqlString s, Num a) => (SqlExpr (Value s), SqlExpr (Value a)) -> SqlExpr (Value s)
right_ :: (SqlExpr (Value s), SqlExpr (Value a)) -> SqlExpr (Value s)
right_ = Builder
-> (SqlExpr (Value s), SqlExpr (Value a)) -> SqlExpr (Value s)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"RIGHT"

-- | @LIKE@ operator.
like :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
like :: SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
like    = Builder
-> SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp    Builder
" LIKE "

-- | @ILIKE@ operator (case-insensitive @LIKE@).
--
-- Supported by PostgreSQL only.
--
-- @since 2.2.3
ilike :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
ilike :: SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
ilike   = Builder
-> SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp    Builder
" ILIKE "

-- | The string @'%'@.  May be useful while using 'like' and
-- concatenation ('concat_' or '++.', depending on your
-- database).  Note that you always have to type the parenthesis,
-- for example:
--
-- @
-- name `'like`` (%) ++. 'val' \"John\" ++. (%)
-- @
(%) :: SqlString s => SqlExpr (Value s)
% :: SqlExpr (Value s)
(%)     = Builder -> SqlExpr (Value s)
forall a. Builder -> SqlExpr (Value a)
unsafeSqlValue    Builder
"'%'"

-- | The @CONCAT@ function with a variable number of
-- parameters.  Supported by MySQL and PostgreSQL.
concat_ :: SqlString s => [SqlExpr (Value s)] -> SqlExpr (Value s)
concat_ :: [SqlExpr (Value s)] -> SqlExpr (Value s)
concat_ = Builder -> [SqlExpr (Value s)] -> SqlExpr (Value s)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"CONCAT"

-- | The @||@ string concatenation operator (named after
-- Haskell's '++' in order to avoid naming clash with '||.').
-- Supported by SQLite and PostgreSQL.
(++.) :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s)
++. :: SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s)
(++.)   = Builder
-> SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp    Builder
" || "

-- | Cast a string type into 'Text'.  This function
-- is very useful if you want to use @newtype@s, or if you want
-- to apply functions such as 'like' to strings of different
-- types.
--
-- /Safety:/ This is a slightly unsafe function, especially if
-- you have defined your own instances of 'SqlString'.  Also,
-- since 'Maybe' is an instance of 'SqlString', it's possible
-- to turn a nullable value into a non-nullable one.  Avoid
-- using this function if possible.
castString :: (SqlString s, SqlString r) => SqlExpr (Value s) -> SqlExpr (Value r)
castString :: SqlExpr (Value s) -> SqlExpr (Value r)
castString = SqlExpr (Value s) -> SqlExpr (Value r)
forall a b. SqlExpr (Value a) -> SqlExpr (Value b)
veryUnsafeCoerceSqlExprValue

-- | Execute a subquery @SELECT@ in an SqlExpression.  Returns a
-- list of values.
subList_select :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (ValueList a)
subList_select :: SqlQuery (SqlExpr (Value a)) -> SqlExpr (ValueList a)
subList_select         = SqlExpr (Value a) -> SqlExpr (ValueList a)
forall a. SqlExpr (Value a) -> SqlExpr (ValueList a)
EList (SqlExpr (Value a) -> SqlExpr (ValueList a))
-> (SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a))
-> SqlQuery (SqlExpr (Value a))
-> SqlExpr (ValueList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
forall a.
PersistField a =>
SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
sub_select

-- | Lift a list of constant value from Haskell-land to the query.
valList :: PersistField typ => [typ] -> SqlExpr (ValueList typ)
valList :: [typ] -> SqlExpr (ValueList typ)
valList []   = SqlExpr (ValueList typ)
forall a. SqlExpr (ValueList a)
EEmptyList
valList [typ]
vals = SqlExpr (Value typ) -> SqlExpr (ValueList typ)
forall a. SqlExpr (Value a) -> SqlExpr (ValueList a)
EList (SqlExpr (Value typ) -> SqlExpr (ValueList typ))
-> SqlExpr (Value typ) -> SqlExpr (ValueList typ)
forall a b. (a -> b) -> a -> b
$ NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value typ)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Parens ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value typ))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value typ)
forall a b. (a -> b) -> a -> b
$ (Builder, [PersistValue]) -> IdentInfo -> (Builder, [PersistValue])
forall a b. a -> b -> a
const ( [Builder] -> Builder
uncommas (Builder
"?" Builder -> [typ] -> [Builder]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [typ]
vals)
                                           , (typ -> PersistValue) -> [typ] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map typ -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue [typ]
vals )

-- | Same as 'just' but for 'ValueList'.  Most of the time you
-- won't need it, though, because you can use 'just' from
-- inside 'subList_select' or 'Just' from inside 'valList'.
--
-- @since 2.2.12
justList :: SqlExpr (ValueList typ) -> SqlExpr (ValueList (Maybe typ))
justList :: SqlExpr (ValueList typ) -> SqlExpr (ValueList (Maybe typ))
justList SqlExpr (ValueList typ)
EEmptyList = SqlExpr (ValueList (Maybe typ))
forall a. SqlExpr (ValueList a)
EEmptyList
justList (EList SqlExpr (Value a)
v)  = SqlExpr (Value (Maybe a)) -> SqlExpr (ValueList (Maybe a))
forall a. SqlExpr (Value a) -> SqlExpr (ValueList a)
EList (SqlExpr (Value a) -> SqlExpr (Value (Maybe a))
forall typ. SqlExpr (Value typ) -> SqlExpr (Value (Maybe typ))
just SqlExpr (Value a)
v)

-- | @IN@ operator. For example if you want to select all @Person@s by a list
-- of IDs:
--
-- @
-- SELECT *
-- FROM Person
-- WHERE Person.id IN (?)
-- @
--
-- In @esqueleto@, we may write the same query above as:
--
-- @
-- select $
-- 'from' $ \\person -> do
-- 'where_' $ person '^.' PersonId `'in_`` 'valList' personIds
-- return person
-- @
--
-- Where @personIds@ is of type @[Key Person]@.
in_ :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> SqlExpr (Value Bool)
SqlExpr (Value typ)
v in_ :: SqlExpr (Value typ)
-> SqlExpr (ValueList typ) -> SqlExpr (Value Bool)
`in_`   SqlExpr (ValueList typ)
e = SqlExpr (ValueList typ)
-> Bool -> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
forall a.
SqlExpr (ValueList a)
-> Bool -> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
ifNotEmptyList SqlExpr (ValueList typ)
e Bool
False (SqlExpr (Value Bool) -> SqlExpr (Value Bool))
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
forall a b. (a -> b) -> a -> b
$ Builder
-> SqlExpr (Value typ)
-> SqlExpr (Value typ)
-> SqlExpr (Value Bool)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp     Builder
" IN " SqlExpr (Value typ)
v (SqlExpr (ValueList typ) -> SqlExpr (Value typ)
forall a. SqlExpr (ValueList a) -> SqlExpr (Value a)
veryUnsafeCoerceSqlExprValueList SqlExpr (ValueList typ)
e)

-- | @NOT IN@ operator.
notIn :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> SqlExpr (Value Bool)
SqlExpr (Value typ)
v notIn :: SqlExpr (Value typ)
-> SqlExpr (ValueList typ) -> SqlExpr (Value Bool)
`notIn` SqlExpr (ValueList typ)
e = SqlExpr (ValueList typ)
-> Bool -> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
forall a.
SqlExpr (ValueList a)
-> Bool -> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
ifNotEmptyList SqlExpr (ValueList typ)
e Bool
True  (SqlExpr (Value Bool) -> SqlExpr (Value Bool))
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
forall a b. (a -> b) -> a -> b
$ Builder
-> SqlExpr (Value typ)
-> SqlExpr (Value typ)
-> SqlExpr (Value Bool)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
" NOT IN " SqlExpr (Value typ)
v (SqlExpr (ValueList typ) -> SqlExpr (Value typ)
forall a. SqlExpr (ValueList a) -> SqlExpr (Value a)
veryUnsafeCoerceSqlExprValueList SqlExpr (ValueList typ)
e)

-- | @EXISTS@ operator.  For example:
--
-- @
-- select $
-- 'from' $ \\person -> do
-- 'where_' $ 'exists' $
--          'from' $ \\post -> do
--          'where_' (post '^.' BlogPostAuthorId '==.' person '^.' PersonId)
-- return person
-- @
exists :: SqlQuery () -> SqlExpr (Value Bool)
exists :: SqlQuery () -> SqlExpr (Value Bool)
exists    = Builder -> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction     Builder
"EXISTS " (SqlExpr (Value Bool) -> SqlExpr (Value Bool))
-> (SqlQuery () -> SqlExpr (Value Bool))
-> SqlQuery ()
-> SqlExpr (Value Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlQuery () -> SqlExpr (Value Bool)
existsHelper

-- | @NOT EXISTS@ operator.
notExists :: SqlQuery () -> SqlExpr (Value Bool)
notExists :: SqlQuery () -> SqlExpr (Value Bool)
notExists = Builder -> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"NOT EXISTS " (SqlExpr (Value Bool) -> SqlExpr (Value Bool))
-> (SqlQuery () -> SqlExpr (Value Bool))
-> SqlQuery ()
-> SqlExpr (Value Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlQuery () -> SqlExpr (Value Bool)
existsHelper

-- | @SET@ clause used on @UPDATE@s.  Note that while it's not
-- a type error to use this function on a @SELECT@, it will
-- most certainly result in a runtime error.
set :: PersistEntity val => SqlExpr (Entity val) -> [SqlExpr (Update val)] -> SqlQuery ()
set :: SqlExpr (Entity val) -> [SqlExpr (Update val)] -> SqlQuery ()
set SqlExpr (Entity val)
ent [SqlExpr (Update val)]
upds = 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 { sdSetClause :: [SetClause]
sdSetClause = (SqlExpr (Update val) -> SetClause)
-> [SqlExpr (Update val)] -> [SetClause]
forall a b. (a -> b) -> [a] -> [b]
map SqlExpr (Update val) -> SetClause
apply [SqlExpr (Update val)]
upds }
  where
    apply :: SqlExpr (Update val) -> SetClause
apply (ESet SqlExpr (Entity val) -> SqlExpr (Value ())
f) = SqlExpr (Value ()) -> SetClause
SetClause (SqlExpr (Entity val) -> SqlExpr (Value ())
f SqlExpr (Entity val)
SqlExpr (Entity val)
ent)

(=.)  :: (PersistEntity val, PersistField typ) => EntityField val typ -> SqlExpr (Value typ) -> SqlExpr (Update val)
EntityField val typ
field  =. :: EntityField val typ -> SqlExpr (Value typ) -> SqlExpr (Update val)
=. SqlExpr (Value typ)
expr = EntityField val typ
-> (SqlExpr (Entity val) -> SqlExpr (Value typ))
-> SqlExpr (Update val)
forall val typ.
(PersistEntity val, PersistField typ) =>
EntityField val typ
-> (SqlExpr (Entity val) -> SqlExpr (Value typ))
-> SqlExpr (Update val)
setAux EntityField val typ
field (SqlExpr (Value typ) -> SqlExpr (Entity val) -> SqlExpr (Value typ)
forall a b. a -> b -> a
const SqlExpr (Value typ)
expr)

(+=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Update val)
EntityField val a
field +=. :: EntityField val a -> SqlExpr (Value a) -> SqlExpr (Update val)
+=. SqlExpr (Value a)
expr = EntityField val a
-> (SqlExpr (Entity val) -> SqlExpr (Value a))
-> SqlExpr (Update val)
forall val typ.
(PersistEntity val, PersistField typ) =>
EntityField val typ
-> (SqlExpr (Entity val) -> SqlExpr (Value typ))
-> SqlExpr (Update val)
setAux EntityField val a
field (\SqlExpr (Entity val)
ent -> SqlExpr (Entity val)
ent SqlExpr (Entity val) -> EntityField val a -> SqlExpr (Value a)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField val a
field SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
forall a.
PersistField a =>
SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
+. SqlExpr (Value a)
expr)

(-=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Update val)
EntityField val a
field -=. :: EntityField val a -> SqlExpr (Value a) -> SqlExpr (Update val)
-=. SqlExpr (Value a)
expr = EntityField val a
-> (SqlExpr (Entity val) -> SqlExpr (Value a))
-> SqlExpr (Update val)
forall val typ.
(PersistEntity val, PersistField typ) =>
EntityField val typ
-> (SqlExpr (Entity val) -> SqlExpr (Value typ))
-> SqlExpr (Update val)
setAux EntityField val a
field (\SqlExpr (Entity val)
ent -> SqlExpr (Entity val)
ent SqlExpr (Entity val) -> EntityField val a -> SqlExpr (Value a)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField val a
field SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
forall a.
PersistField a =>
SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
-. SqlExpr (Value a)
expr)

(*=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Update val)
EntityField val a
field *=. :: EntityField val a -> SqlExpr (Value a) -> SqlExpr (Update val)
*=. SqlExpr (Value a)
expr = EntityField val a
-> (SqlExpr (Entity val) -> SqlExpr (Value a))
-> SqlExpr (Update val)
forall val typ.
(PersistEntity val, PersistField typ) =>
EntityField val typ
-> (SqlExpr (Entity val) -> SqlExpr (Value typ))
-> SqlExpr (Update val)
setAux EntityField val a
field (\SqlExpr (Entity val)
ent -> SqlExpr (Entity val)
ent SqlExpr (Entity val) -> EntityField val a -> SqlExpr (Value a)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField val a
field SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
forall a.
PersistField a =>
SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
*. SqlExpr (Value a)
expr)

(/=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Update val)
EntityField val a
field /=. :: EntityField val a -> SqlExpr (Value a) -> SqlExpr (Update val)
/=. SqlExpr (Value a)
expr = EntityField val a
-> (SqlExpr (Entity val) -> SqlExpr (Value a))
-> SqlExpr (Update val)
forall val typ.
(PersistEntity val, PersistField typ) =>
EntityField val typ
-> (SqlExpr (Entity val) -> SqlExpr (Value typ))
-> SqlExpr (Update val)
setAux EntityField val a
field (\SqlExpr (Entity val)
ent -> SqlExpr (Entity val)
ent SqlExpr (Entity val) -> EntityField val a -> SqlExpr (Value a)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. EntityField val a
field SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
forall a.
PersistField a =>
SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
/. SqlExpr (Value a)
expr)

-- | Apply a 'PersistField' constructor to @SqlExpr Value@ arguments.
(<#) :: (a -> b) -> SqlExpr (Value a) -> SqlExpr (Insertion b)
<# :: (a -> b) -> SqlExpr (Value a) -> SqlExpr (Insertion b)
(<#) a -> b
_ (ERaw NeedParens
_ IdentInfo -> (Builder, [PersistValue])
f)        = Proxy b
-> (IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Insertion b)
forall a.
Proxy a
-> (IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Insertion a)
EInsert Proxy b
forall k (t :: k). Proxy t
Proxy IdentInfo -> (Builder, [PersistValue])
f
(<#) a -> b
_ (ECompositeKey IdentInfo -> [Builder]
_) = EsqueletoError -> SqlExpr (Insertion b)
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
ToInsertionError)
(<#) a -> b
_ (EAliasedValue Ident
i SqlExpr (Value a)
_) = Proxy b
-> (IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Insertion b)
forall a.
Proxy a
-> (IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Insertion a)
EInsert Proxy b
forall k (t :: k). Proxy t
Proxy ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Insertion b))
-> (IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Insertion b)
forall a b. (a -> b) -> a -> b
$ Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i
(<#) a -> b
_ (EValueReference Ident
i IdentInfo -> Ident
i') = Proxy b
-> (IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Insertion b)
forall a.
Proxy a
-> (IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Insertion a)
EInsert Proxy b
forall k (t :: k). Proxy t
Proxy ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Insertion b))
-> (IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Insertion b)
forall a b. (a -> b) -> a -> b
$ Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i'


-- | Apply extra @SqlExpr Value@ arguments to a 'PersistField' constructor
(<&>) :: SqlExpr (Insertion (a -> b)) -> SqlExpr (Value a) -> SqlExpr (Insertion b)
(EInsert Proxy a
_ IdentInfo -> (Builder, [PersistValue])
f) <&> :: SqlExpr (Insertion (a -> b))
-> SqlExpr (Value a) -> SqlExpr (Insertion b)
<&> SqlExpr (Value a)
v =
    Proxy b
-> (IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Insertion b)
forall a.
Proxy a
-> (IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Insertion a)
EInsert Proxy b
forall k (t :: k). Proxy t
Proxy ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Insertion b))
-> (IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Insertion b)
forall a b. (a -> b) -> a -> b
$ \IdentInfo
x ->
        let (Builder
fb, [PersistValue]
fv) = IdentInfo -> (Builder, [PersistValue])
f IdentInfo
x
            (Builder
gb, [PersistValue]
gv) = IdentInfo -> (Builder, [PersistValue])
g IdentInfo
x
        in
            (Builder
fb Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
gb, [PersistValue]
fv [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. [a] -> [a] -> [a]
++ [PersistValue]
gv)
  where
    g :: IdentInfo -> (Builder, [PersistValue])
g =
        case SqlExpr (Value a)
v of
            ERaw NeedParens
_ IdentInfo -> (Builder, [PersistValue])
f' -> IdentInfo -> (Builder, [PersistValue])
f'
            EAliasedValue Ident
i SqlExpr (Value a)
_ -> Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i
            EValueReference Ident
i IdentInfo -> Ident
i' -> Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i'
            ECompositeKey IdentInfo -> [Builder]
_ -> EsqueletoError -> IdentInfo -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
CombineInsertionError)

-- | @CASE@ statement.  For example:
--
-- @
-- select $
-- return $
-- 'case_'
--    [ 'when_'
--        ('exists' $
--        'from' $ \\p -> do
--        'where_' (p '^.' PersonName '==.' 'val' \"Mike\"))
--      'then_'
--        ('sub_select' $
--        'from' $ \\v -> do
--        let sub =
--                'from' $ \\c -> do
--                'where_' (c '^.' PersonName '==.' 'val' \"Mike\")
--                return (c '^.' PersonFavNum)
--        'where_' (v '^.' PersonFavNum >. 'sub_select' sub)
--        return $ 'count' (v '^.' PersonName) +. 'val' (1 :: Int)) ]
--    ('else_' $ 'val' (-1))
-- @
--
-- This query is a bit complicated, but basically it checks if a person
-- named @\"Mike\"@ exists, and if that person does, run the subquery to find
-- out how many people have a ranking (by Fav Num) higher than @\"Mike\"@.
--
-- __NOTE:__ There are a few things to be aware about this statement.
--
--    * This only implements the full CASE statement, it does not
--      implement the \"simple\" CASE statement.
--
--
--    * At least one 'when_' and 'then_' is mandatory otherwise it will
--      emit an error.
--
--
--    * The 'else_' is also mandatory, unlike the SQL statement in which
--      if the @ELSE@ is omitted it will return a @NULL@. You can
--      reproduce this via 'nothing'.
--
-- @since 2.1.2
case_ :: PersistField a => [(SqlExpr (Value Bool), SqlExpr (Value a))] -> SqlExpr (Value a) -> SqlExpr (Value a)
case_ :: [(SqlExpr (Value Bool), SqlExpr (Value a))]
-> SqlExpr (Value a) -> SqlExpr (Value a)
case_ = [(SqlExpr (Value Bool), SqlExpr (Value a))]
-> SqlExpr (Value a) -> SqlExpr (Value a)
forall a.
PersistField a =>
[(SqlExpr (Value Bool), SqlExpr (Value a))]
-> SqlExpr (Value a) -> SqlExpr (Value a)
unsafeSqlCase

-- | Convert an entity's key into another entity's.
--
-- This function is to be used when you change an entity's @Id@ to be
-- that of another entity. For example:
--
-- @
-- Bar
--   barNum Int
-- Foo
--   bar BarId
--   fooNum Int
--   Primary bar
-- @
--
-- In this example, Bar is said to be the BaseEnt(ity), and Foo the child.
-- To model this in Esqueleto, declare:
--
-- @
-- instance ToBaseId Foo where
--   type BaseEnt Foo = Bar
--   toBaseIdWitness barId = FooKey barId
-- @
--
-- Now you're able to write queries such as:
--
-- @
-- 'select' $
-- 'from' $ \(bar `'InnerJoin`` foo) -> do
-- 'on' ('toBaseId' (foo '^.' FooId) '==.' bar '^.' BarId)
-- return (bar, foo)
-- @
--
-- Note: this function may be unsafe to use in conditions not like the
-- one of the example above.
--
-- @since 2.4.3
toBaseId :: ToBaseId ent => SqlExpr (Value (Key ent)) -> SqlExpr (Value (Key (BaseEnt ent)))
toBaseId :: SqlExpr (Value (Key ent)) -> SqlExpr (Value (Key (BaseEnt ent)))
toBaseId = SqlExpr (Value (Key ent)) -> SqlExpr (Value (Key (BaseEnt ent)))
forall a b. SqlExpr (Value a) -> SqlExpr (Value b)
veryUnsafeCoerceSqlExprValue

{-# DEPRECATED random_ "Since 2.6.0: `random_` is not uniform across all databases! Please use a specific one such as 'Database.Esqueleto.PostgreSQL.random_', 'Database.Esqueleto.MySQL.random_', or 'Database.Esqueleto.SQLite.random_'" #-}

{-# DEPRECATED rand "Since 2.6.0: `rand` ordering function is not uniform across all databases! To avoid accidental partiality it will be removed in the next major version." #-}

-- Fixity declarations
infixl 9 ^.
infixl 7 *., /.
infixl 6 +., -.
infixr 5 ++.
infix  4 ==., >=., >., <=., <., !=.
infixr 3 &&., =., +=., -=., *=., /=.
infixr 2 ||., `like`, `ilike`
infixl 2 `InnerJoin`, `CrossJoin`, `LeftOuterJoin`, `RightOuterJoin`, `FullOuterJoin`

-- | Syntax sugar for 'case_'.
--
-- @since 2.1.2
when_ :: expr (Value Bool) -> () -> expr a -> (expr (Value Bool), expr a)
when_ :: expr (Value Bool) -> () -> expr a -> (expr (Value Bool), expr a)
when_ expr (Value Bool)
cond ()
_ expr a
expr = (expr (Value Bool)
cond, expr a
expr)

-- | Syntax sugar for 'case_'.
--
-- @since 2.1.2
then_ :: ()
then_ :: ()
then_ = ()

-- | Syntax sugar for 'case_'.
--
-- @since 2.1.2
else_ :: expr a -> expr a
else_ :: expr a -> expr a
else_ = expr a -> expr a
forall a. a -> a
id

-- | A single value (as opposed to a whole entity).  You may use
-- @('^.')@ or @('?.')@ to get a 'Value' from an 'Entity'.
newtype Value a = Value { Value a -> a
unValue :: a } deriving (Value a -> Value a -> Bool
(Value a -> Value a -> Bool)
-> (Value a -> Value a -> Bool) -> Eq (Value a)
forall a. Eq a => Value a -> Value a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value a -> Value a -> Bool
$c/= :: forall a. Eq a => Value a -> Value a -> Bool
== :: Value a -> Value a -> Bool
$c== :: forall a. Eq a => Value a -> Value a -> Bool
Eq, Eq (Value a)
Eq (Value a)
-> (Value a -> Value a -> Ordering)
-> (Value a -> Value a -> Bool)
-> (Value a -> Value a -> Bool)
-> (Value a -> Value a -> Bool)
-> (Value a -> Value a -> Bool)
-> (Value a -> Value a -> Value a)
-> (Value a -> Value a -> Value a)
-> Ord (Value a)
Value a -> Value a -> Bool
Value a -> Value a -> Ordering
Value a -> Value a -> Value a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Value a)
forall a. Ord a => Value a -> Value a -> Bool
forall a. Ord a => Value a -> Value a -> Ordering
forall a. Ord a => Value a -> Value a -> Value a
min :: Value a -> Value a -> Value a
$cmin :: forall a. Ord a => Value a -> Value a -> Value a
max :: Value a -> Value a -> Value a
$cmax :: forall a. Ord a => Value a -> Value a -> Value a
>= :: Value a -> Value a -> Bool
$c>= :: forall a. Ord a => Value a -> Value a -> Bool
> :: Value a -> Value a -> Bool
$c> :: forall a. Ord a => Value a -> Value a -> Bool
<= :: Value a -> Value a -> Bool
$c<= :: forall a. Ord a => Value a -> Value a -> Bool
< :: Value a -> Value a -> Bool
$c< :: forall a. Ord a => Value a -> Value a -> Bool
compare :: Value a -> Value a -> Ordering
$ccompare :: forall a. Ord a => Value a -> Value a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Value a)
Ord, Int -> Value a -> ShowS
[Value a] -> ShowS
Value a -> [Char]
(Int -> Value a -> ShowS)
-> (Value a -> [Char]) -> ([Value a] -> ShowS) -> Show (Value a)
forall a. Show a => Int -> Value a -> ShowS
forall a. Show a => [Value a] -> ShowS
forall a. Show a => Value a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Value a] -> ShowS
$cshowList :: forall a. Show a => [Value a] -> ShowS
show :: Value a -> [Char]
$cshow :: forall a. Show a => Value a -> [Char]
showsPrec :: Int -> Value a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Value a -> ShowS
Show, Typeable)

-- | @since 1.4.4
instance Functor Value where
    fmap :: (a -> b) -> Value a -> Value b
fmap a -> b
f (Value a
a) = b -> Value b
forall a. a -> Value a
Value (a -> b
f a
a)

instance Applicative Value where
  <*> :: Value (a -> b) -> Value a -> Value b
(<*>) (Value a -> b
f) (Value a
a) = b -> Value b
forall a. a -> Value a
Value (a -> b
f a
a)
  pure :: a -> Value a
pure = a -> Value a
forall a. a -> Value a
Value

instance Monad Value where
  >>= :: Value a -> (a -> Value b) -> Value b
(>>=) Value a
x a -> Value b
f = Value (Value b) -> Value b
forall a. Value a -> a
valueJoin (Value (Value b) -> Value b) -> Value (Value b) -> Value b
forall a b. (a -> b) -> a -> b
$ (a -> Value b) -> Value a -> Value (Value b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Value b
f Value a
x
    where valueJoin :: Value a -> a
valueJoin (Value a
v) = a
v

-- | A list of single values.  There's a limited set of functions
-- able to work with this data type (such as 'subList_select',
-- 'valList', 'in_' and 'exists').
newtype ValueList a = ValueList a deriving (ValueList a -> ValueList a -> Bool
(ValueList a -> ValueList a -> Bool)
-> (ValueList a -> ValueList a -> Bool) -> Eq (ValueList a)
forall a. Eq a => ValueList a -> ValueList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueList a -> ValueList a -> Bool
$c/= :: forall a. Eq a => ValueList a -> ValueList a -> Bool
== :: ValueList a -> ValueList a -> Bool
$c== :: forall a. Eq a => ValueList a -> ValueList a -> Bool
Eq, Eq (ValueList a)
Eq (ValueList a)
-> (ValueList a -> ValueList a -> Ordering)
-> (ValueList a -> ValueList a -> Bool)
-> (ValueList a -> ValueList a -> Bool)
-> (ValueList a -> ValueList a -> Bool)
-> (ValueList a -> ValueList a -> Bool)
-> (ValueList a -> ValueList a -> ValueList a)
-> (ValueList a -> ValueList a -> ValueList a)
-> Ord (ValueList a)
ValueList a -> ValueList a -> Bool
ValueList a -> ValueList a -> Ordering
ValueList a -> ValueList a -> ValueList a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ValueList a)
forall a. Ord a => ValueList a -> ValueList a -> Bool
forall a. Ord a => ValueList a -> ValueList a -> Ordering
forall a. Ord a => ValueList a -> ValueList a -> ValueList a
min :: ValueList a -> ValueList a -> ValueList a
$cmin :: forall a. Ord a => ValueList a -> ValueList a -> ValueList a
max :: ValueList a -> ValueList a -> ValueList a
$cmax :: forall a. Ord a => ValueList a -> ValueList a -> ValueList a
>= :: ValueList a -> ValueList a -> Bool
$c>= :: forall a. Ord a => ValueList a -> ValueList a -> Bool
> :: ValueList a -> ValueList a -> Bool
$c> :: forall a. Ord a => ValueList a -> ValueList a -> Bool
<= :: ValueList a -> ValueList a -> Bool
$c<= :: forall a. Ord a => ValueList a -> ValueList a -> Bool
< :: ValueList a -> ValueList a -> Bool
$c< :: forall a. Ord a => ValueList a -> ValueList a -> Bool
compare :: ValueList a -> ValueList a -> Ordering
$ccompare :: forall a. Ord a => ValueList a -> ValueList a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (ValueList a)
Ord, Int -> ValueList a -> ShowS
[ValueList a] -> ShowS
ValueList a -> [Char]
(Int -> ValueList a -> ShowS)
-> (ValueList a -> [Char])
-> ([ValueList a] -> ShowS)
-> Show (ValueList a)
forall a. Show a => Int -> ValueList a -> ShowS
forall a. Show a => [ValueList a] -> ShowS
forall a. Show a => ValueList a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ValueList a] -> ShowS
$cshowList :: forall a. Show a => [ValueList a] -> ShowS
show :: ValueList a -> [Char]
$cshow :: forall a. Show a => ValueList a -> [Char]
showsPrec :: Int -> ValueList a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ValueList a -> ShowS
Show, Typeable)

-- | A wrapper type for for any @expr (Value a)@ for all a.
data SomeValue where
    SomeValue :: SqlExpr (Value a) -> SomeValue

-- | A class of things that can be converted into a list of SomeValue. It has
-- instances for tuples and is the reason why 'groupBy' can take tuples, like
-- @'groupBy' (foo '^.' FooId, foo '^.' FooName, foo '^.' FooType)@.
class ToSomeValues a where
    toSomeValues :: a -> [SomeValue]

instance
    ( ToSomeValues a
    , ToSomeValues b
    )
  =>
    ToSomeValues (a, b)
  where
    toSomeValues :: (a, b) -> [SomeValue]
toSomeValues (a
a,b
b) = a -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues a
a [SomeValue] -> [SomeValue] -> [SomeValue]
forall a. [a] -> [a] -> [a]
++ b -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues b
b

instance
    ( ToSomeValues a
    , ToSomeValues b
    , ToSomeValues c
    )
  =>
    ToSomeValues (a, b, c)
  where
    toSomeValues :: (a, b, c) -> [SomeValue]
toSomeValues (a
a,b
b,c
c) = a -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues a
a [SomeValue] -> [SomeValue] -> [SomeValue]
forall a. [a] -> [a] -> [a]
++ b -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues b
b [SomeValue] -> [SomeValue] -> [SomeValue]
forall a. [a] -> [a] -> [a]
++ c -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues c
c

instance
    ( ToSomeValues a
    , ToSomeValues b
    , ToSomeValues c
    , ToSomeValues d
    )
  =>
    ToSomeValues (a, b, c, d)
  where
    toSomeValues :: (a, b, c, d) -> [SomeValue]
toSomeValues (a
a,b
b,c
c,d
d) =
        a -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues a
a [SomeValue] -> [SomeValue] -> [SomeValue]
forall a. [a] -> [a] -> [a]
++ b -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues b
b [SomeValue] -> [SomeValue] -> [SomeValue]
forall a. [a] -> [a] -> [a]
++ c -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues c
c [SomeValue] -> [SomeValue] -> [SomeValue]
forall a. [a] -> [a] -> [a]
++ d -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues d
d

instance
    ( ToSomeValues a
    , ToSomeValues b
    , ToSomeValues c
    , ToSomeValues d
    , ToSomeValues e
    )
  =>
    ToSomeValues (a, b, c, d, e)
  where
    toSomeValues :: (a, b, c, d, e) -> [SomeValue]
toSomeValues (a
a,b
b,c
c,d
d,e
e) = [[SomeValue]] -> [SomeValue]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ a -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues a
a, b -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues b
b, c -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues c
c , d -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues d
d
        , e -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues e
e
        ]

instance
    ( ToSomeValues a
    , ToSomeValues b
    , ToSomeValues c
    , ToSomeValues d
    , ToSomeValues e
    , ToSomeValues f
    )
  =>
    ToSomeValues (a, b, c, d, e, f)
  where
    toSomeValues :: (a, b, c, d, e, f) -> [SomeValue]
toSomeValues (a
a,b
b,c
c,d
d,e
e,f
f) = [[SomeValue]] -> [SomeValue]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ a -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues a
a, b -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues b
b, c -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues c
c, d -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues d
d
        , e -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues e
e , f -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues f
f
        ]

instance
    ( ToSomeValues a
    , ToSomeValues b
    , ToSomeValues c
    , ToSomeValues d
    , ToSomeValues e
    , ToSomeValues f
    , ToSomeValues g
    )
  =>
    ToSomeValues (a, b, c, d, e, f, g)
  where
    toSomeValues :: (a, b, c, d, e, f, g) -> [SomeValue]
toSomeValues (a
a,b
b,c
c,d
d,e
e,f
f,g
g) = [[SomeValue]] -> [SomeValue]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ a -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues a
a,  b -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues b
b, c -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues c
c,  d -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues d
d
        , e -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues e
e,  f -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues f
f, g -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues g
g
        ]

instance
    ( ToSomeValues a
    , ToSomeValues b
    , ToSomeValues c
    , ToSomeValues d
    , ToSomeValues e
    , ToSomeValues f
    , ToSomeValues g
    , ToSomeValues h
    )
  =>
    ToSomeValues (a, b, c, d, e, f, g, h)
  where
    toSomeValues :: (a, b, c, d, e, f, g, h) -> [SomeValue]
toSomeValues (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = [[SomeValue]] -> [SomeValue]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ a -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues a
a, b -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues b
b, c -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues c
c, d -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues d
d
        , e -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues e
e, f -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues f
f, g -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues g
g, h -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues h
h
        ]

type family KnowResult a where
    KnowResult (i -> o) = KnowResult o
    KnowResult a = a

-- | A class for constructors or function which result type is known.
--
-- @since 3.1.3
class FinalResult a where
  finalR :: a -> KnowResult a

instance FinalResult (Unique val) where
  finalR :: Unique val -> KnowResult (Unique val)
finalR = Unique val -> KnowResult (Unique val)
forall a. a -> a
id

instance (FinalResult b) => FinalResult (a -> b) where
  finalR :: (a -> b) -> KnowResult (a -> b)
finalR a -> b
f = b -> KnowResult b
forall a. FinalResult a => a -> KnowResult a
finalR (a -> b
f a
forall a. HasCallStack => a
undefined)

-- | Convert a constructor for a 'Unique' key on a record to the 'UniqueDef'
-- that defines it. You can supply just the constructor itself, or a value of
-- the type - the library is capable of figuring it out from there.
--
-- @since 3.1.3
toUniqueDef
    :: forall a val.
    ( KnowResult a ~ Unique val
    , PersistEntity val
    , FinalResult a
    )
    => a
    -> UniqueDef
toUniqueDef :: a -> UniqueDef
toUniqueDef a
uniqueConstructor = UniqueDef
uniqueDef
  where
    proxy :: Proxy val
    proxy :: Proxy val
proxy = Proxy val
forall k (t :: k). Proxy t
Proxy
    unique :: Unique val
    unique :: Unique val
unique = a -> KnowResult a
forall a. FinalResult a => a -> KnowResult a
finalR a
uniqueConstructor
    -- there must be a better way to get the constrain name from a unique, make this not a list search
    filterF :: UniqueDef -> Bool
filterF = [(HaskellName, DBName)] -> [(HaskellName, DBName)] -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Unique val -> [(HaskellName, DBName)]
forall record.
PersistEntity record =>
Unique record -> [(HaskellName, DBName)]
persistUniqueToFieldNames Unique val
unique) ([(HaskellName, DBName)] -> Bool)
-> (UniqueDef -> [(HaskellName, DBName)]) -> UniqueDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqueDef -> [(HaskellName, DBName)]
uniqueFields
    uniqueDef :: UniqueDef
uniqueDef = [UniqueDef] -> UniqueDef
forall a. [a] -> a
head ([UniqueDef] -> UniqueDef)
-> (Proxy val -> [UniqueDef]) -> Proxy val -> UniqueDef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniqueDef -> Bool) -> [UniqueDef] -> [UniqueDef]
forall a. (a -> Bool) -> [a] -> [a]
filter UniqueDef -> Bool
filterF ([UniqueDef] -> [UniqueDef])
-> (Proxy val -> [UniqueDef]) -> Proxy val -> [UniqueDef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> [UniqueDef]
entityUniques (EntityDef -> [UniqueDef])
-> (Proxy val -> EntityDef) -> Proxy val -> [UniqueDef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy val -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Proxy val -> UniqueDef) -> Proxy val -> UniqueDef
forall a b. (a -> b) -> a -> b
$ Proxy val
proxy

-- | Render updates to be use in a SET clause for a given sql backend.
--
-- @since 3.1.3
renderUpdates
    :: (BackendCompatible SqlBackend backend)
    => backend
    -> [SqlExpr (Update val)]
    -> (TLB.Builder, [PersistValue])
renderUpdates :: backend -> [SqlExpr (Update val)] -> (Builder, [PersistValue])
renderUpdates backend
conn = [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas' ([(Builder, [PersistValue])] -> (Builder, [PersistValue]))
-> ([SqlExpr (Update val)] -> [(Builder, [PersistValue])])
-> [SqlExpr (Update val)]
-> (Builder, [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SqlExpr (Update val) -> [(Builder, [PersistValue])])
-> [SqlExpr (Update val)] -> [(Builder, [PersistValue])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SqlExpr (Update val) -> [(Builder, [PersistValue])]
forall val. SqlExpr (Update val) -> [(Builder, [PersistValue])]
renderUpdate
  where
    mk :: SqlExpr (Value ()) -> [(TLB.Builder, [PersistValue])]
    mk :: SqlExpr (Value ()) -> [(Builder, [PersistValue])]
mk (ERaw NeedParens
_ IdentInfo -> (Builder, [PersistValue])
f)             = [IdentInfo -> (Builder, [PersistValue])
f IdentInfo
info]
    mk (ECompositeKey IdentInfo -> [Builder]
_)      = EsqueletoError -> [(Builder, [PersistValue])]
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
MakeSetError) -- FIXME
    mk (EAliasedValue Ident
i SqlExpr (Value a)
_)    = [Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i IdentInfo
info]
    mk (EValueReference Ident
i IdentInfo -> Ident
i') = [Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i' IdentInfo
info]

    renderUpdate :: SqlExpr (Update val) -> [(TLB.Builder, [PersistValue])]
    renderUpdate :: SqlExpr (Update val) -> [(Builder, [PersistValue])]
renderUpdate (ESet SqlExpr (Entity val) -> SqlExpr (Value ())
f) = SqlExpr (Value ()) -> [(Builder, [PersistValue])]
mk (SqlExpr (Entity val) -> SqlExpr (Value ())
f SqlExpr (Entity val)
forall a. HasCallStack => a
undefined) -- second parameter of f is always unused
    info :: IdentInfo
info = (backend -> SqlBackend
forall sup sub. BackendCompatible sup sub => sub -> sup
projectBackend backend
conn, IdentState
initialIdentState)

-- | Data type that represents an @INNER JOIN@ (see 'LeftOuterJoin' for an example).
data InnerJoin a b = a `InnerJoin` b

-- | Data type that represents a @CROSS JOIN@ (see 'LeftOuterJoin' for an example).
data CrossJoin a b = a `CrossJoin` b

-- | Data type that represents a @LEFT OUTER JOIN@. For example,
--
-- @
-- select $
-- 'from' $ \\(person `'LeftOuterJoin`` pet) ->
--   ...
-- @
--
-- is translated into
--
-- @
-- SELECT ...
-- FROM Person LEFT OUTER JOIN Pet
-- ...
-- @
--
-- See also: 'from'.
data LeftOuterJoin a b = a `LeftOuterJoin` b

-- | Data type that represents a @RIGHT OUTER JOIN@ (see 'LeftOuterJoin' for an example).
data RightOuterJoin a b = a `RightOuterJoin` b

-- | Data type that represents a @FULL OUTER JOIN@ (see 'LeftOuterJoin' for an example).
data FullOuterJoin a b = a `FullOuterJoin` b


-- | (Internal) A kind of @JOIN@.
data JoinKind
    = InnerJoinKind      -- ^ @INNER JOIN@
    | CrossJoinKind      -- ^ @CROSS JOIN@
    | LeftOuterJoinKind  -- ^ @LEFT OUTER JOIN@
    | RightOuterJoinKind -- ^ @RIGHT OUTER JOIN@
    | FullOuterJoinKind  -- ^ @FULL OUTER JOIN@
    deriving (JoinKind -> JoinKind -> Bool
(JoinKind -> JoinKind -> Bool)
-> (JoinKind -> JoinKind -> Bool) -> Eq JoinKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JoinKind -> JoinKind -> Bool
$c/= :: JoinKind -> JoinKind -> Bool
== :: JoinKind -> JoinKind -> Bool
$c== :: JoinKind -> JoinKind -> Bool
Eq, Int -> JoinKind -> ShowS
[JoinKind] -> ShowS
JoinKind -> [Char]
(Int -> JoinKind -> ShowS)
-> (JoinKind -> [Char]) -> ([JoinKind] -> ShowS) -> Show JoinKind
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [JoinKind] -> ShowS
$cshowList :: [JoinKind] -> ShowS
show :: JoinKind -> [Char]
$cshow :: JoinKind -> [Char]
showsPrec :: Int -> JoinKind -> ShowS
$cshowsPrec :: Int -> JoinKind -> ShowS
Show)


-- | (Internal) Functions that operate on types (that should be)
-- of kind 'JoinKind'.
class IsJoinKind join where
    -- | (Internal) @smartJoin a b@ is a @JOIN@ of the correct kind.
    smartJoin :: a -> b -> join a b
    -- | (Internal) Reify a @JoinKind@ from a @JOIN@.  This
    -- function is non-strict.
    reifyJoinKind :: join a b -> JoinKind

instance IsJoinKind InnerJoin where
    smartJoin :: a -> b -> InnerJoin a b
smartJoin a
a b
b = a
a a -> b -> InnerJoin a b
forall a b. a -> b -> InnerJoin a b
`InnerJoin` b
b
    reifyJoinKind :: InnerJoin a b -> JoinKind
reifyJoinKind InnerJoin a b
_ = JoinKind
InnerJoinKind
instance IsJoinKind CrossJoin where
    smartJoin :: a -> b -> CrossJoin a b
smartJoin a
a b
b = a
a a -> b -> CrossJoin a b
forall a b. a -> b -> CrossJoin a b
`CrossJoin` b
b
    reifyJoinKind :: CrossJoin a b -> JoinKind
reifyJoinKind CrossJoin a b
_ = JoinKind
CrossJoinKind
instance IsJoinKind LeftOuterJoin where
    smartJoin :: a -> b -> LeftOuterJoin a b
smartJoin a
a b
b = a
a a -> b -> LeftOuterJoin a b
forall a b. a -> b -> LeftOuterJoin a b
`LeftOuterJoin` b
b
    reifyJoinKind :: LeftOuterJoin a b -> JoinKind
reifyJoinKind LeftOuterJoin a b
_ = JoinKind
LeftOuterJoinKind
instance IsJoinKind RightOuterJoin where
    smartJoin :: a -> b -> RightOuterJoin a b
smartJoin a
a b
b = a
a a -> b -> RightOuterJoin a b
forall a b. a -> b -> RightOuterJoin a b
`RightOuterJoin` b
b
    reifyJoinKind :: RightOuterJoin a b -> JoinKind
reifyJoinKind RightOuterJoin a b
_ = JoinKind
RightOuterJoinKind
instance IsJoinKind FullOuterJoin where
    smartJoin :: a -> b -> FullOuterJoin a b
smartJoin a
a b
b = a
a a -> b -> FullOuterJoin a b
forall a b. a -> b -> FullOuterJoin a b
`FullOuterJoin` b
b
    reifyJoinKind :: FullOuterJoin a b -> JoinKind
reifyJoinKind FullOuterJoin a b
_ = JoinKind
FullOuterJoinKind


-- | Exception thrown whenever 'on' is used to create an @ON@
-- clause but no matching @JOIN@ is found.
data OnClauseWithoutMatchingJoinException =
    OnClauseWithoutMatchingJoinException String
    deriving (OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Bool
(OnClauseWithoutMatchingJoinException
 -> OnClauseWithoutMatchingJoinException -> Bool)
-> (OnClauseWithoutMatchingJoinException
    -> OnClauseWithoutMatchingJoinException -> Bool)
-> Eq OnClauseWithoutMatchingJoinException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Bool
$c/= :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Bool
== :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Bool
$c== :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Bool
Eq, Eq OnClauseWithoutMatchingJoinException
Eq OnClauseWithoutMatchingJoinException
-> (OnClauseWithoutMatchingJoinException
    -> OnClauseWithoutMatchingJoinException -> Ordering)
-> (OnClauseWithoutMatchingJoinException
    -> OnClauseWithoutMatchingJoinException -> Bool)
-> (OnClauseWithoutMatchingJoinException
    -> OnClauseWithoutMatchingJoinException -> Bool)
-> (OnClauseWithoutMatchingJoinException
    -> OnClauseWithoutMatchingJoinException -> Bool)
-> (OnClauseWithoutMatchingJoinException
    -> OnClauseWithoutMatchingJoinException -> Bool)
-> (OnClauseWithoutMatchingJoinException
    -> OnClauseWithoutMatchingJoinException
    -> OnClauseWithoutMatchingJoinException)
-> (OnClauseWithoutMatchingJoinException
    -> OnClauseWithoutMatchingJoinException
    -> OnClauseWithoutMatchingJoinException)
-> Ord OnClauseWithoutMatchingJoinException
OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Bool
OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Ordering
OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException
$cmin :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException
max :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException
$cmax :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException
>= :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Bool
$c>= :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Bool
> :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Bool
$c> :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Bool
<= :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Bool
$c<= :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Bool
< :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Bool
$c< :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Bool
compare :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Ordering
$ccompare :: OnClauseWithoutMatchingJoinException
-> OnClauseWithoutMatchingJoinException -> Ordering
$cp1Ord :: Eq OnClauseWithoutMatchingJoinException
Ord, Int -> OnClauseWithoutMatchingJoinException -> ShowS
[OnClauseWithoutMatchingJoinException] -> ShowS
OnClauseWithoutMatchingJoinException -> [Char]
(Int -> OnClauseWithoutMatchingJoinException -> ShowS)
-> (OnClauseWithoutMatchingJoinException -> [Char])
-> ([OnClauseWithoutMatchingJoinException] -> ShowS)
-> Show OnClauseWithoutMatchingJoinException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OnClauseWithoutMatchingJoinException] -> ShowS
$cshowList :: [OnClauseWithoutMatchingJoinException] -> ShowS
show :: OnClauseWithoutMatchingJoinException -> [Char]
$cshow :: OnClauseWithoutMatchingJoinException -> [Char]
showsPrec :: Int -> OnClauseWithoutMatchingJoinException -> ShowS
$cshowsPrec :: Int -> OnClauseWithoutMatchingJoinException -> ShowS
Show, Typeable)

instance Exception OnClauseWithoutMatchingJoinException

-- | (Internal) Phantom type used to process 'from' (see 'fromStart').
data PreprocessedFrom a

-- | Phantom type used by 'orderBy', 'asc' and 'desc'.
data OrderBy

-- | Phantom type used by 'distinctOn' and 'don'.
data DistinctOn

-- | Phantom type for a @SET@ operation on an entity of the given
-- type (see 'set' and '(=.)').
data Update typ

-- | Phantom type used by 'insertSelect'.
data Insertion a

-- | Different kinds of locking clauses supported by 'locking'.
--
-- Note that each RDBMS has different locking support.  The
-- constructors of this datatype specify only the /syntax/ of the
-- locking mechanism, not its /semantics/.  For example, even
-- though both MySQL and PostgreSQL support 'ForUpdate', there
-- are no guarantees that they will behave the same.
--
-- @since 2.2.7
data LockingKind
    = ForUpdate
      -- ^ @FOR UPDATE@ syntax.  Supported by MySQL, Oracle and
      -- PostgreSQL.
      --
      -- @since 2.2.7
    | ForUpdateSkipLocked
      -- ^ @FOR UPDATE SKIP LOCKED@ syntax.  Supported by MySQL, Oracle and
      -- PostgreSQL.
      --
      -- @since 2.2.7
    | ForShare
      -- ^ @FOR SHARE@ syntax.  Supported by PostgreSQL.
      --
      -- @since 2.2.7
    | LockInShareMode
      -- ^ @LOCK IN SHARE MODE@ syntax.  Supported by MySQL.
      --
      -- @since 2.2.7

-- | Phantom class of data types that are treated as strings by the
-- RDBMS.  It has no methods because it's only used to avoid type
-- errors such as trying to concatenate integers.
--
-- If you have a custom data type or @newtype@, feel free to make
-- it an instance of this class.
--
-- @since 2.4.0
class PersistField a => SqlString a where

-- | @since 2.3.0
instance (a ~ Char) => SqlString [a] where

-- | @since 2.3.0
instance SqlString T.Text where

-- | @since 2.3.0
instance SqlString TL.Text where

-- | @since 2.3.0
instance SqlString B.ByteString where

-- | @since 2.3.0
instance SqlString Html where

-- | @since 2.4.0
instance SqlString a => SqlString (Maybe a) where

-- | Class that enables one to use 'toBaseId' to convert an entity's
-- key on a query into another (cf. 'toBaseId').
class ToBaseId ent where
    -- | e.g. @type BaseEnt MyBase = MyChild@
    type BaseEnt ent :: *
    -- | Convert from the key of the BaseEnt(ity) to the key of the child entity.
    -- This function is not actually called, but that it typechecks proves this operation is safe.
    toBaseIdWitness :: Key (BaseEnt ent) -> Key ent


-- | @FROM@ clause: bring entities into scope.
--
-- Note that this function will be replaced by the one in
-- "Database.Esqueleto.Experimental" in version 4.0.0.0 of the library. The
-- @Experimental@ module has a dramatically improved means for introducing
-- tables and entities that provides more power and less potential for runtime
-- errors.
--
-- This function internally uses two type classes in order to
-- provide some flexibility of how you may call it.  Internally
-- we refer to these type classes as the two different magics.
--
-- The innermost magic allows you to use @from@ with the
-- following types:
--
--  * @expr (Entity val)@, which brings a single entity into
--  scope.
--
--  * @expr (Maybe (Entity val))@, which brings a single entity
--  that may be @NULL@ into scope.  Used for @OUTER JOIN@s.
--
--  * A @JOIN@ of any other two types allowed by the innermost
--  magic, where a @JOIN@ may be an 'InnerJoin', a 'CrossJoin', a
--  'LeftOuterJoin', a 'RightOuterJoin', or a 'FullOuterJoin'.
--  The @JOINs@ have left fixity.
--
-- The outermost magic allows you to use @from@ on any tuples of
-- types supported by innermost magic (and also tuples of tuples,
-- and so on), up to 8-tuples.
--
-- Note that using @from@ for the same entity twice does work and
-- corresponds to a self-join.  You don't even need to use two
-- different calls to @from@, you may use a @JOIN@ or a tuple.
--
-- The following are valid examples of uses of @from@ (the types
-- of the arguments of the lambda are inside square brackets):
--
-- @
-- 'from' $ \\person -> ...
-- 'from' $ \\(person, blogPost) -> ...
-- 'from' $ \\(p `'LeftOuterJoin`` mb) -> ...
-- 'from' $ \\(p1 `'InnerJoin`` f `'InnerJoin`` p2) -> ...
-- 'from' $ \\((p1 `'InnerJoin`` f) `'InnerJoin`` p2) -> ...
-- @
--
-- The types of the arguments to the lambdas above are,
-- respectively:
--
-- @
-- person
--   :: ( Esqueleto query expr backend
--      , PersistEntity Person
--      , PersistEntityBackend Person ~ backend
--      ) => expr (Entity Person)
-- (person, blogPost)
--   :: (...) => (expr (Entity Person), expr (Entity BlogPost))
-- (p `'LeftOuterJoin`` mb)
--   :: (...) => InnerJoin (expr (Entity Person)) (expr (Maybe (Entity BlogPost)))
-- (p1 `'InnerJoin`` f `'InnerJoin`` p2)
--   :: (...) => InnerJoin
--                 (InnerJoin (expr (Entity Person))
--                            (expr (Entity Follow)))
--                 (expr (Entity Person))
-- (p1 `'InnerJoin`` (f `'InnerJoin`` p2)) ::
--   :: (...) => InnerJoin
--                 (expr (Entity Person))
--                 (InnerJoin (expr (Entity Follow))
--                            (expr (Entity Person)))
-- @
--
-- Note that some backends may not support all kinds of @JOIN@s.
from :: From a => (a -> SqlQuery b) -> SqlQuery b
from :: (a -> SqlQuery b) -> SqlQuery b
from = (SqlQuery a
forall a. From a => SqlQuery a
from_ SqlQuery a -> (a -> SqlQuery b) -> SqlQuery b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)


-- | (Internal) Class that implements the tuple 'from' magic (see
-- 'fromStart').
class From a where
    from_ :: SqlQuery a

instance
    ( FromPreprocess (SqlExpr (Entity val))
    )
  =>
    From (SqlExpr (Entity val))
  where
    from_ :: SqlQuery (SqlExpr (Entity val))
from_ = SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Entity val))))
forall a.
FromPreprocess a =>
SqlQuery (SqlExpr (PreprocessedFrom a))
fromPreprocess SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Entity val))))
-> (SqlExpr (PreprocessedFrom (SqlExpr (Entity val)))
    -> SqlQuery (SqlExpr (Entity val)))
-> SqlQuery (SqlExpr (Entity val))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SqlExpr (PreprocessedFrom (SqlExpr (Entity val)))
-> SqlQuery (SqlExpr (Entity val))
forall a. SqlExpr (PreprocessedFrom a) -> SqlQuery a
fromFinish

instance
    ( FromPreprocess (SqlExpr (Maybe (Entity val)))
    )
  =>
    From (SqlExpr (Maybe (Entity val)))
  where
    from_ :: SqlQuery (SqlExpr (Maybe (Entity val)))
from_ = SqlQuery
  (SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity val)))))
forall a.
FromPreprocess a =>
SqlQuery (SqlExpr (PreprocessedFrom a))
fromPreprocess SqlQuery
  (SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity val)))))
-> (SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity val))))
    -> SqlQuery (SqlExpr (Maybe (Entity val))))
-> SqlQuery (SqlExpr (Maybe (Entity val)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity val))))
-> SqlQuery (SqlExpr (Maybe (Entity val)))
forall a. SqlExpr (PreprocessedFrom a) -> SqlQuery a
fromFinish

instance
    ( FromPreprocess (InnerJoin a b)
    )
  =>
    From (InnerJoin a b)
  where
    from_ :: SqlQuery (InnerJoin a b)
from_ = SqlQuery (SqlExpr (PreprocessedFrom (InnerJoin a b)))
forall a.
FromPreprocess a =>
SqlQuery (SqlExpr (PreprocessedFrom a))
fromPreprocess SqlQuery (SqlExpr (PreprocessedFrom (InnerJoin a b)))
-> (SqlExpr (PreprocessedFrom (InnerJoin a b))
    -> SqlQuery (InnerJoin a b))
-> SqlQuery (InnerJoin a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SqlExpr (PreprocessedFrom (InnerJoin a b))
-> SqlQuery (InnerJoin a b)
forall a. SqlExpr (PreprocessedFrom a) -> SqlQuery a
fromFinish

instance
    ( FromPreprocess (CrossJoin a b)
    )
  =>
    From (CrossJoin a b)
  where
    from_ :: SqlQuery (CrossJoin a b)
from_ = SqlQuery (SqlExpr (PreprocessedFrom (CrossJoin a b)))
forall a.
FromPreprocess a =>
SqlQuery (SqlExpr (PreprocessedFrom a))
fromPreprocess SqlQuery (SqlExpr (PreprocessedFrom (CrossJoin a b)))
-> (SqlExpr (PreprocessedFrom (CrossJoin a b))
    -> SqlQuery (CrossJoin a b))
-> SqlQuery (CrossJoin a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SqlExpr (PreprocessedFrom (CrossJoin a b))
-> SqlQuery (CrossJoin a b)
forall a. SqlExpr (PreprocessedFrom a) -> SqlQuery a
fromFinish

instance (FromPreprocess (LeftOuterJoin a b)) => From (LeftOuterJoin a b) where
    from_ :: SqlQuery (LeftOuterJoin a b)
from_ = SqlQuery (SqlExpr (PreprocessedFrom (LeftOuterJoin a b)))
forall a.
FromPreprocess a =>
SqlQuery (SqlExpr (PreprocessedFrom a))
fromPreprocess SqlQuery (SqlExpr (PreprocessedFrom (LeftOuterJoin a b)))
-> (SqlExpr (PreprocessedFrom (LeftOuterJoin a b))
    -> SqlQuery (LeftOuterJoin a b))
-> SqlQuery (LeftOuterJoin a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SqlExpr (PreprocessedFrom (LeftOuterJoin a b))
-> SqlQuery (LeftOuterJoin a b)
forall a. SqlExpr (PreprocessedFrom a) -> SqlQuery a
fromFinish

instance (FromPreprocess (RightOuterJoin a b)) => From (RightOuterJoin a b) where
    from_ :: SqlQuery (RightOuterJoin a b)
from_ = SqlQuery (SqlExpr (PreprocessedFrom (RightOuterJoin a b)))
forall a.
FromPreprocess a =>
SqlQuery (SqlExpr (PreprocessedFrom a))
fromPreprocess SqlQuery (SqlExpr (PreprocessedFrom (RightOuterJoin a b)))
-> (SqlExpr (PreprocessedFrom (RightOuterJoin a b))
    -> SqlQuery (RightOuterJoin a b))
-> SqlQuery (RightOuterJoin a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SqlExpr (PreprocessedFrom (RightOuterJoin a b))
-> SqlQuery (RightOuterJoin a b)
forall a. SqlExpr (PreprocessedFrom a) -> SqlQuery a
fromFinish

instance (FromPreprocess (FullOuterJoin a b)) => From (FullOuterJoin a b) where
    from_ :: SqlQuery (FullOuterJoin a b)
from_ = SqlQuery (SqlExpr (PreprocessedFrom (FullOuterJoin a b)))
forall a.
FromPreprocess a =>
SqlQuery (SqlExpr (PreprocessedFrom a))
fromPreprocess SqlQuery (SqlExpr (PreprocessedFrom (FullOuterJoin a b)))
-> (SqlExpr (PreprocessedFrom (FullOuterJoin a b))
    -> SqlQuery (FullOuterJoin a b))
-> SqlQuery (FullOuterJoin a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SqlExpr (PreprocessedFrom (FullOuterJoin a b))
-> SqlQuery (FullOuterJoin a b)
forall a. SqlExpr (PreprocessedFrom a) -> SqlQuery a
fromFinish

instance (From a, From b) => From (a, b) where
    from_ :: SqlQuery (a, b)
from_ = (,) (a -> b -> (a, b)) -> SqlQuery a -> SqlQuery (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlQuery a
forall a. From a => SqlQuery a
from_ SqlQuery (b -> (a, b)) -> SqlQuery b -> SqlQuery (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery b
forall a. From a => SqlQuery a
from_

instance (From a, From b, From c) => From (a, b, c) where
    from_ :: SqlQuery (a, b, c)
from_ = (,,) (a -> b -> c -> (a, b, c))
-> SqlQuery a -> SqlQuery (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlQuery a
forall a. From a => SqlQuery a
from_ SqlQuery (b -> c -> (a, b, c))
-> SqlQuery b -> SqlQuery (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery b
forall a. From a => SqlQuery a
from_ SqlQuery (c -> (a, b, c)) -> SqlQuery c -> SqlQuery (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery c
forall a. From a => SqlQuery a
from_

instance (From a, From b, From c, From d) => From (a, b, c, d) where
    from_ :: SqlQuery (a, b, c, d)
from_ = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> SqlQuery a -> SqlQuery (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlQuery a
forall a. From a => SqlQuery a
from_ SqlQuery (b -> c -> d -> (a, b, c, d))
-> SqlQuery b -> SqlQuery (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery b
forall a. From a => SqlQuery a
from_ SqlQuery (c -> d -> (a, b, c, d))
-> SqlQuery c -> SqlQuery (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery c
forall a. From a => SqlQuery a
from_ SqlQuery (d -> (a, b, c, d)) -> SqlQuery d -> SqlQuery (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery d
forall a. From a => SqlQuery a
from_

instance (From a, From b, From c, From d, From e) => From (a, b, c, d, e) where
    from_ :: SqlQuery (a, b, c, d, e)
from_ = (,,,,) (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> SqlQuery a -> SqlQuery (b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlQuery a
forall a. From a => SqlQuery a
from_ SqlQuery (b -> c -> d -> e -> (a, b, c, d, e))
-> SqlQuery b -> SqlQuery (c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery b
forall a. From a => SqlQuery a
from_ SqlQuery (c -> d -> e -> (a, b, c, d, e))
-> SqlQuery c -> SqlQuery (d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery c
forall a. From a => SqlQuery a
from_ SqlQuery (d -> e -> (a, b, c, d, e))
-> SqlQuery d -> SqlQuery (e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery d
forall a. From a => SqlQuery a
from_ SqlQuery (e -> (a, b, c, d, e))
-> SqlQuery e -> SqlQuery (a, b, c, d, e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery e
forall a. From a => SqlQuery a
from_

instance
    (From a, From b, From c, From d, From e, From f)
  =>
    From (a, b, c, d, e, f)
  where
    from_ :: SqlQuery (a, b, c, d, e, f)
from_ = (,,,,,) (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> SqlQuery a
-> SqlQuery (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlQuery a
forall a. From a => SqlQuery a
from_ SqlQuery (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> SqlQuery b -> SqlQuery (c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery b
forall a. From a => SqlQuery a
from_ SqlQuery (c -> d -> e -> f -> (a, b, c, d, e, f))
-> SqlQuery c -> SqlQuery (d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery c
forall a. From a => SqlQuery a
from_ SqlQuery (d -> e -> f -> (a, b, c, d, e, f))
-> SqlQuery d -> SqlQuery (e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery d
forall a. From a => SqlQuery a
from_ SqlQuery (e -> f -> (a, b, c, d, e, f))
-> SqlQuery e -> SqlQuery (f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery e
forall a. From a => SqlQuery a
from_ SqlQuery (f -> (a, b, c, d, e, f))
-> SqlQuery f -> SqlQuery (a, b, c, d, e, f)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery f
forall a. From a => SqlQuery a
from_

instance
    (From a, From b, From c, From d, From e, From f, From g)
  =>
    From (a, b, c, d, e, f, g)
  where
    from_ :: SqlQuery (a, b, c, d, e, f, g)
from_ =
        (,,,,,,) (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> SqlQuery a
-> SqlQuery (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlQuery a
forall a. From a => SqlQuery a
from_ SqlQuery (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> SqlQuery b
-> SqlQuery (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery b
forall a. From a => SqlQuery a
from_ SqlQuery (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> SqlQuery c
-> SqlQuery (d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery c
forall a. From a => SqlQuery a
from_ SqlQuery (d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> SqlQuery d -> SqlQuery (e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery d
forall a. From a => SqlQuery a
from_ SqlQuery (e -> f -> g -> (a, b, c, d, e, f, g))
-> SqlQuery e -> SqlQuery (f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery e
forall a. From a => SqlQuery a
from_ SqlQuery (f -> g -> (a, b, c, d, e, f, g))
-> SqlQuery f -> SqlQuery (g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery f
forall a. From a => SqlQuery a
from_ SqlQuery (g -> (a, b, c, d, e, f, g))
-> SqlQuery g -> SqlQuery (a, b, c, d, e, f, g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery g
forall a. From a => SqlQuery a
from_

instance
    (From a, From b, From c, From d, From e, From f, From g, From h)
  =>
    From (a, b, c, d, e, f, g, h)
  where
    from_ :: SqlQuery (a, b, c, d, e, f, g, h)
from_ =
        (,,,,,,,) (a -> b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> SqlQuery a
-> SqlQuery
     (b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlQuery a
forall a. From a => SqlQuery a
from_ SqlQuery
  (b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> SqlQuery b
-> SqlQuery
     (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery b
forall a. From a => SqlQuery a
from_ SqlQuery (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> SqlQuery c
-> SqlQuery (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery c
forall a. From a => SqlQuery a
from_ SqlQuery (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> SqlQuery d
-> SqlQuery (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery d
forall a. From a => SqlQuery a
from_ SqlQuery (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> SqlQuery e -> SqlQuery (f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery e
forall a. From a => SqlQuery a
from_ SqlQuery (f -> g -> h -> (a, b, c, d, e, f, g, h))
-> SqlQuery f -> SqlQuery (g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery f
forall a. From a => SqlQuery a
from_ SqlQuery (g -> h -> (a, b, c, d, e, f, g, h))
-> SqlQuery g -> SqlQuery (h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery g
forall a. From a => SqlQuery a
from_ SqlQuery (h -> (a, b, c, d, e, f, g, h))
-> SqlQuery h -> SqlQuery (a, b, c, d, e, f, g, h)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SqlQuery h
forall a. From a => SqlQuery a
from_



-- | (Internal) Class that implements the @JOIN@ 'from' magic
-- (see 'fromStart').
class FromPreprocess a where
    fromPreprocess :: SqlQuery (SqlExpr (PreprocessedFrom a))

instance
    (PersistEntity val, BackendCompatible SqlBackend (PersistEntityBackend val))
  =>
    FromPreprocess (SqlExpr (Entity val))
  where
    fromPreprocess :: SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Entity val))))
fromPreprocess = SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Entity val))))
forall a.
(PersistEntity a,
 BackendCompatible SqlBackend (PersistEntityBackend a)) =>
SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Entity a))))
fromStart

instance
    (PersistEntity val, BackendCompatible SqlBackend (PersistEntityBackend val))
  =>
    FromPreprocess (SqlExpr (Maybe (Entity val)))
  where
    fromPreprocess :: SqlQuery
  (SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity val)))))
fromPreprocess = SqlQuery
  (SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity val)))))
forall val.
(PersistEntity val,
 BackendCompatible SqlBackend (PersistEntityBackend val)) =>
SqlQuery
  (SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity val)))))
fromStartMaybe

instance
    (FromPreprocess a, FromPreprocess b, IsJoinKind join)
  =>
    FromPreprocess (join a b)
  where
    fromPreprocess :: SqlQuery (SqlExpr (PreprocessedFrom (join a b)))
fromPreprocess = do
        SqlExpr (PreprocessedFrom a)
a <- SqlQuery (SqlExpr (PreprocessedFrom a))
forall a.
FromPreprocess a =>
SqlQuery (SqlExpr (PreprocessedFrom a))
fromPreprocess
        SqlExpr (PreprocessedFrom b)
b <- SqlQuery (SqlExpr (PreprocessedFrom b))
forall a.
FromPreprocess a =>
SqlQuery (SqlExpr (PreprocessedFrom a))
fromPreprocess
        SqlExpr (PreprocessedFrom a)
-> SqlExpr (PreprocessedFrom b)
-> SqlQuery (SqlExpr (PreprocessedFrom (join a b)))
forall (join :: * -> * -> *) a b.
IsJoinKind join =>
SqlExpr (PreprocessedFrom a)
-> SqlExpr (PreprocessedFrom b)
-> SqlQuery (SqlExpr (PreprocessedFrom (join a b)))
fromJoin SqlExpr (PreprocessedFrom a)
a SqlExpr (PreprocessedFrom b)
b

-- | Exception data type for @esqueleto@ internal errors
data EsqueletoError
    = CompositeKeyErr CompositeKeyError
    | AliasedValueErr UnexpectedValueError
    | UnexpectedCaseErr UnexpectedCaseError
    | SqlBinOpCompositeErr SqlBinOpCompositeError
    deriving (Int -> EsqueletoError -> ShowS
[EsqueletoError] -> ShowS
EsqueletoError -> [Char]
(Int -> EsqueletoError -> ShowS)
-> (EsqueletoError -> [Char])
-> ([EsqueletoError] -> ShowS)
-> Show EsqueletoError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [EsqueletoError] -> ShowS
$cshowList :: [EsqueletoError] -> ShowS
show :: EsqueletoError -> [Char]
$cshow :: EsqueletoError -> [Char]
showsPrec :: Int -> EsqueletoError -> ShowS
$cshowsPrec :: Int -> EsqueletoError -> ShowS
Show)

instance Exception EsqueletoError

data UnexpectedValueError
    = NotError
    | ToInsertionError
    | CombineInsertionError
    | FoldHelpError
    | SqlCaseError
    | SqlCastAsError
    | SqlFunctionError
    | MakeOnClauseError
    | MakeExcError
    | MakeSetError
    | MakeWhereError
    | MakeHavingError
    | FilterWhereAggError
    | FilterWhereClauseError
    deriving (Int -> CompositeKeyError -> ShowS
[CompositeKeyError] -> ShowS
CompositeKeyError -> [Char]
(Int -> CompositeKeyError -> ShowS)
-> (CompositeKeyError -> [Char])
-> ([CompositeKeyError] -> ShowS)
-> Show CompositeKeyError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CompositeKeyError] -> ShowS
$cshowList :: [CompositeKeyError] -> ShowS
show :: CompositeKeyError -> [Char]
$cshow :: CompositeKeyError -> [Char]
showsPrec :: Int -> CompositeKeyError -> ShowS
$cshowsPrec :: Int -> CompositeKeyError -> ShowS
Show)

type CompositeKeyError = UnexpectedValueError

data UnexpectedCaseError
    = EmptySqlExprValueList
    | MakeFromError
    | UnsupportedSqlInsertIntoType
    | InsertionFinalError
    | NewIdentForError
    | UnsafeSqlCaseError
    | OperationNotSupported
    | NotImplemented
    deriving (Int -> UnexpectedCaseError -> ShowS
[UnexpectedCaseError] -> ShowS
UnexpectedCaseError -> [Char]
(Int -> UnexpectedCaseError -> ShowS)
-> (UnexpectedCaseError -> [Char])
-> ([UnexpectedCaseError] -> ShowS)
-> Show UnexpectedCaseError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [UnexpectedCaseError] -> ShowS
$cshowList :: [UnexpectedCaseError] -> ShowS
show :: UnexpectedCaseError -> [Char]
$cshow :: UnexpectedCaseError -> [Char]
showsPrec :: Int -> UnexpectedCaseError -> ShowS
$cshowsPrec :: Int -> UnexpectedCaseError -> ShowS
Show)

data SqlBinOpCompositeError
    = MismatchingLengthsError
    | NullPlaceholdersError
    | DeconstructionError
    deriving (Int -> SqlBinOpCompositeError -> ShowS
[SqlBinOpCompositeError] -> ShowS
SqlBinOpCompositeError -> [Char]
(Int -> SqlBinOpCompositeError -> ShowS)
-> (SqlBinOpCompositeError -> [Char])
-> ([SqlBinOpCompositeError] -> ShowS)
-> Show SqlBinOpCompositeError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SqlBinOpCompositeError] -> ShowS
$cshowList :: [SqlBinOpCompositeError] -> ShowS
show :: SqlBinOpCompositeError -> [Char]
$cshow :: SqlBinOpCompositeError -> [Char]
showsPrec :: Int -> SqlBinOpCompositeError -> ShowS
$cshowsPrec :: Int -> SqlBinOpCompositeError -> ShowS
Show)

-- | SQL backend for @esqueleto@ using 'SqlPersistT'.
newtype SqlQuery a = Q { SqlQuery a -> WriterT SideData (State IdentState) a
unQ :: W.WriterT SideData (S.State IdentState) a }
    deriving newtype (a -> SqlQuery b -> SqlQuery a
(a -> b) -> SqlQuery a -> SqlQuery b
(forall a b. (a -> b) -> SqlQuery a -> SqlQuery b)
-> (forall a b. a -> SqlQuery b -> SqlQuery a) -> Functor SqlQuery
forall a b. a -> SqlQuery b -> SqlQuery a
forall a b. (a -> b) -> SqlQuery a -> SqlQuery b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SqlQuery b -> SqlQuery a
$c<$ :: forall a b. a -> SqlQuery b -> SqlQuery a
fmap :: (a -> b) -> SqlQuery a -> SqlQuery b
$cfmap :: forall a b. (a -> b) -> SqlQuery a -> SqlQuery b
Functor, Functor SqlQuery
a -> SqlQuery a
Functor SqlQuery
-> (forall a. a -> SqlQuery a)
-> (forall a b. SqlQuery (a -> b) -> SqlQuery a -> SqlQuery b)
-> (forall a b c.
    (a -> b -> c) -> SqlQuery a -> SqlQuery b -> SqlQuery c)
-> (forall a b. SqlQuery a -> SqlQuery b -> SqlQuery b)
-> (forall a b. SqlQuery a -> SqlQuery b -> SqlQuery a)
-> Applicative SqlQuery
SqlQuery a -> SqlQuery b -> SqlQuery b
SqlQuery a -> SqlQuery b -> SqlQuery a
SqlQuery (a -> b) -> SqlQuery a -> SqlQuery b
(a -> b -> c) -> SqlQuery a -> SqlQuery b -> SqlQuery c
forall a. a -> SqlQuery a
forall a b. SqlQuery a -> SqlQuery b -> SqlQuery a
forall a b. SqlQuery a -> SqlQuery b -> SqlQuery b
forall a b. SqlQuery (a -> b) -> SqlQuery a -> SqlQuery b
forall a b c.
(a -> b -> c) -> SqlQuery a -> SqlQuery b -> SqlQuery c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SqlQuery a -> SqlQuery b -> SqlQuery a
$c<* :: forall a b. SqlQuery a -> SqlQuery b -> SqlQuery a
*> :: SqlQuery a -> SqlQuery b -> SqlQuery b
$c*> :: forall a b. SqlQuery a -> SqlQuery b -> SqlQuery b
liftA2 :: (a -> b -> c) -> SqlQuery a -> SqlQuery b -> SqlQuery c
$cliftA2 :: forall a b c.
(a -> b -> c) -> SqlQuery a -> SqlQuery b -> SqlQuery c
<*> :: SqlQuery (a -> b) -> SqlQuery a -> SqlQuery b
$c<*> :: forall a b. SqlQuery (a -> b) -> SqlQuery a -> SqlQuery b
pure :: a -> SqlQuery a
$cpure :: forall a. a -> SqlQuery a
$cp1Applicative :: Functor SqlQuery
Applicative, Applicative SqlQuery
a -> SqlQuery a
Applicative SqlQuery
-> (forall a b. SqlQuery a -> (a -> SqlQuery b) -> SqlQuery b)
-> (forall a b. SqlQuery a -> SqlQuery b -> SqlQuery b)
-> (forall a. a -> SqlQuery a)
-> Monad SqlQuery
SqlQuery a -> (a -> SqlQuery b) -> SqlQuery b
SqlQuery a -> SqlQuery b -> SqlQuery b
forall a. a -> SqlQuery a
forall a b. SqlQuery a -> SqlQuery b -> SqlQuery b
forall a b. SqlQuery a -> (a -> SqlQuery b) -> SqlQuery b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SqlQuery a
$creturn :: forall a. a -> SqlQuery a
>> :: SqlQuery a -> SqlQuery b -> SqlQuery b
$c>> :: forall a b. SqlQuery a -> SqlQuery b -> SqlQuery b
>>= :: SqlQuery a -> (a -> SqlQuery b) -> SqlQuery b
$c>>= :: forall a b. SqlQuery a -> (a -> SqlQuery b) -> SqlQuery b
$cp1Monad :: Applicative SqlQuery
Monad)

-- | Constraint synonym for @persistent@ entities whose backend
-- is 'SqlBackend'.
type SqlEntity ent = (PersistEntity ent, PersistEntityBackend ent ~ SqlBackend)


----------------------------------------------------------------------


-- | Side data written by 'SqlQuery'.
data SideData = SideData
    { SideData -> DistinctClause
sdDistinctClause :: !DistinctClause
    , SideData -> [FromClause]
sdFromClause     :: ![FromClause]
    , SideData -> [SetClause]
sdSetClause      :: ![SetClause]
    , SideData -> WhereClause
sdWhereClause    :: !WhereClause
    , SideData -> GroupByClause
sdGroupByClause  :: !GroupByClause
    , SideData -> WhereClause
sdHavingClause   :: !HavingClause
    , SideData -> [SqlExpr OrderBy]
sdOrderByClause  :: ![OrderByClause]
    , SideData -> LimitClause
sdLimitClause    :: !LimitClause
    , SideData -> LockingClause
sdLockingClause  :: !LockingClause
    , SideData -> [CommonTableExpressionClause]
sdCteClause      :: ![CommonTableExpressionClause]
    }

instance Semigroup SideData where
    SideData DistinctClause
d [FromClause]
f [SetClause]
s WhereClause
w GroupByClause
g WhereClause
h [SqlExpr OrderBy]
o LimitClause
l LockingClause
k [CommonTableExpressionClause]
c <> :: SideData -> SideData -> SideData
<> SideData DistinctClause
d' [FromClause]
f' [SetClause]
s' WhereClause
w' GroupByClause
g' WhereClause
h' [SqlExpr OrderBy]
o' LimitClause
l' LockingClause
k' [CommonTableExpressionClause]
c' =
        DistinctClause
-> [FromClause]
-> [SetClause]
-> WhereClause
-> GroupByClause
-> WhereClause
-> [SqlExpr OrderBy]
-> LimitClause
-> LockingClause
-> [CommonTableExpressionClause]
-> SideData
SideData (DistinctClause
d DistinctClause -> DistinctClause -> DistinctClause
forall a. Semigroup a => a -> a -> a
<> DistinctClause
d') ([FromClause]
f [FromClause] -> [FromClause] -> [FromClause]
forall a. Semigroup a => a -> a -> a
<> [FromClause]
f') ([SetClause]
s [SetClause] -> [SetClause] -> [SetClause]
forall a. Semigroup a => a -> a -> a
<> [SetClause]
s') (WhereClause
w WhereClause -> WhereClause -> WhereClause
forall a. Semigroup a => a -> a -> a
<> WhereClause
w') (GroupByClause
g GroupByClause -> GroupByClause -> GroupByClause
forall a. Semigroup a => a -> a -> a
<> GroupByClause
g') (WhereClause
h WhereClause -> WhereClause -> WhereClause
forall a. Semigroup a => a -> a -> a
<> WhereClause
h') ([SqlExpr OrderBy]
o [SqlExpr OrderBy] -> [SqlExpr OrderBy] -> [SqlExpr OrderBy]
forall a. Semigroup a => a -> a -> a
<> [SqlExpr OrderBy]
o') (LimitClause
l LimitClause -> LimitClause -> LimitClause
forall a. Semigroup a => a -> a -> a
<> LimitClause
l') (LockingClause
k LockingClause -> LockingClause -> LockingClause
forall a. Semigroup a => a -> a -> a
<> LockingClause
k') ([CommonTableExpressionClause]
c [CommonTableExpressionClause]
-> [CommonTableExpressionClause] -> [CommonTableExpressionClause]
forall a. Semigroup a => a -> a -> a
<> [CommonTableExpressionClause]
c')

instance Monoid SideData where
    mempty :: SideData
mempty = DistinctClause
-> [FromClause]
-> [SetClause]
-> WhereClause
-> GroupByClause
-> WhereClause
-> [SqlExpr OrderBy]
-> LimitClause
-> LockingClause
-> [CommonTableExpressionClause]
-> SideData
SideData DistinctClause
forall a. Monoid a => a
mempty [FromClause]
forall a. Monoid a => a
mempty [SetClause]
forall a. Monoid a => a
mempty WhereClause
forall a. Monoid a => a
mempty GroupByClause
forall a. Monoid a => a
mempty WhereClause
forall a. Monoid a => a
mempty [SqlExpr OrderBy]
forall a. Monoid a => a
mempty LimitClause
forall a. Monoid a => a
mempty LockingClause
forall a. Monoid a => a
mempty [CommonTableExpressionClause]
forall a. Monoid a => a
mempty
    mappend :: SideData -> SideData -> SideData
mappend = SideData -> SideData -> SideData
forall a. Semigroup a => a -> a -> a
(<>)

-- | The @DISTINCT@ "clause".
data DistinctClause
    = DistinctAll
    -- ^ The default, everything.
    | DistinctStandard
    -- ^ Only @DISTINCT@, SQL standard.
    | DistinctOn [SqlExpr DistinctOn]
    -- ^ @DISTINCT ON@, PostgreSQL extension.

instance Semigroup DistinctClause where
    DistinctOn [SqlExpr DistinctOn]
a     <> :: DistinctClause -> DistinctClause -> DistinctClause
<> DistinctOn [SqlExpr DistinctOn]
b = [SqlExpr DistinctOn] -> DistinctClause
DistinctOn ([SqlExpr DistinctOn]
a [SqlExpr DistinctOn]
-> [SqlExpr DistinctOn] -> [SqlExpr DistinctOn]
forall a. Semigroup a => a -> a -> a
<> [SqlExpr DistinctOn]
b)
    DistinctOn [SqlExpr DistinctOn]
a     <> DistinctClause
_            = [SqlExpr DistinctOn] -> DistinctClause
DistinctOn [SqlExpr DistinctOn]
a
    DistinctClause
DistinctStandard <> DistinctClause
_            = DistinctClause
DistinctStandard
    DistinctClause
DistinctAll      <> DistinctClause
b            = DistinctClause
b

instance Monoid DistinctClause where
    mempty :: DistinctClause
mempty = DistinctClause
DistinctAll
    mappend :: DistinctClause -> DistinctClause -> DistinctClause
mappend = DistinctClause -> DistinctClause -> DistinctClause
forall a. Semigroup a => a -> a -> a
(<>)

-- | A part of a @FROM@ clause.
data FromClause
    = FromStart Ident EntityDef
    | FromJoin FromClause JoinKind FromClause (Maybe (SqlExpr (Value Bool)))
    | OnClause (SqlExpr (Value Bool))
    | FromQuery Ident (IdentInfo -> (TLB.Builder, [PersistValue])) SubQueryType
    | FromIdent Ident

data CommonTableExpressionKind
    = RecursiveCommonTableExpression
    | NormalCommonTableExpression
    deriving CommonTableExpressionKind -> CommonTableExpressionKind -> Bool
(CommonTableExpressionKind -> CommonTableExpressionKind -> Bool)
-> (CommonTableExpressionKind -> CommonTableExpressionKind -> Bool)
-> Eq CommonTableExpressionKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommonTableExpressionKind -> CommonTableExpressionKind -> Bool
$c/= :: CommonTableExpressionKind -> CommonTableExpressionKind -> Bool
== :: CommonTableExpressionKind -> CommonTableExpressionKind -> Bool
$c== :: CommonTableExpressionKind -> CommonTableExpressionKind -> Bool
Eq

data CommonTableExpressionClause =
    CommonTableExpressionClause CommonTableExpressionKind Ident (IdentInfo -> (TLB.Builder, [PersistValue]))

data SubQueryType
    = NormalSubQuery
    | LateralSubQuery
    deriving Int -> SubQueryType -> ShowS
[SubQueryType] -> ShowS
SubQueryType -> [Char]
(Int -> SubQueryType -> ShowS)
-> (SubQueryType -> [Char])
-> ([SubQueryType] -> ShowS)
-> Show SubQueryType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SubQueryType] -> ShowS
$cshowList :: [SubQueryType] -> ShowS
show :: SubQueryType -> [Char]
$cshow :: SubQueryType -> [Char]
showsPrec :: Int -> SubQueryType -> ShowS
$cshowsPrec :: Int -> SubQueryType -> ShowS
Show

collectIdents :: FromClause -> Set Ident
collectIdents :: FromClause -> Set Ident
collectIdents FromClause
fc = case FromClause
fc of
    FromStart Ident
i EntityDef
_ -> Ident -> Set Ident
forall a. a -> Set a
Set.singleton Ident
i
    FromJoin FromClause
lhs JoinKind
_ FromClause
rhs Maybe (SqlExpr (Value Bool))
_ -> FromClause -> Set Ident
collectIdents FromClause
lhs Set Ident -> Set Ident -> Set Ident
forall a. Semigroup a => a -> a -> a
<> FromClause -> Set Ident
collectIdents FromClause
rhs
    OnClause SqlExpr (Value Bool)
_ -> Set Ident
forall a. Monoid a => a
mempty
    FromQuery Ident
_ IdentInfo -> (Builder, [PersistValue])
_ SubQueryType
_ -> Set Ident
forall a. Monoid a => a
mempty
    FromIdent Ident
_ -> Set Ident
forall a. Monoid a => a
mempty

instance Show FromClause where
    show :: FromClause -> [Char]
show FromClause
fc = case FromClause
fc of
        FromStart Ident
i EntityDef
_ ->
            [Char]
"(FromStart " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Ident -> [Char]
forall a. Show a => a -> [Char]
show Ident
i [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
")"
        FromJoin FromClause
lhs JoinKind
jk FromClause
rhs Maybe (SqlExpr (Value Bool))
mexpr ->
            [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat
            [ [Char]
"(FromJoin "
            , FromClause -> [Char]
forall a. Show a => a -> [Char]
show FromClause
lhs
            , [Char]
" "
            , JoinKind -> [Char]
forall a. Show a => a -> [Char]
show JoinKind
jk
            , [Char]
" "
            , case Maybe (SqlExpr (Value Bool))
mexpr of
                Maybe (SqlExpr (Value Bool))
Nothing -> [Char]
"(no on clause)"
                Just SqlExpr (Value Bool)
expr -> [Char]
"(" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> SqlExpr (Value Bool) -> [Char]
render' SqlExpr (Value Bool)
expr [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
")"
            , [Char]
" "
            , FromClause -> [Char]
forall a. Show a => a -> [Char]
show FromClause
rhs
            , [Char]
")"
            ]
        OnClause SqlExpr (Value Bool)
expr ->
            [Char]
"(OnClause " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> SqlExpr (Value Bool) -> [Char]
render' SqlExpr (Value Bool)
expr [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
")"
        FromQuery Ident
ident IdentInfo -> (Builder, [PersistValue])
_ SubQueryType
subQueryType ->
            [Char]
"(FromQuery " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Ident -> [Char]
forall a. Show a => a -> [Char]
show Ident
ident [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> SubQueryType -> [Char]
forall a. Show a => a -> [Char]
show SubQueryType
subQueryType [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
")"
        FromIdent Ident
ident ->
            [Char]
"(FromIdent " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Ident -> [Char]
forall a. Show a => a -> [Char]
show Ident
ident [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
")"

      where
        dummy :: SqlBackend
dummy = SqlBackend :: (Text -> IO Statement)
-> (EntityDef -> [PersistValue] -> InsertSqlResult)
-> Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult)
-> Maybe
     (EntityDef -> NonEmpty (HaskellName, DBName) -> Text -> Text)
-> Maybe (EntityDef -> Int -> Text)
-> IORef (Map Text Statement)
-> IO ()
-> ([EntityDef]
    -> (Text -> IO Statement)
    -> EntityDef
    -> IO (Either [Text] [(Bool, Text)]))
-> ((Text -> IO Statement) -> Maybe IsolationLevel -> IO ())
-> ((Text -> IO Statement) -> IO ())
-> ((Text -> IO Statement) -> IO ())
-> (DBName -> Text)
-> Text
-> Text
-> ((Int, Int) -> Bool -> Text -> Text)
-> LogFunc
-> Maybe Int
-> Maybe (EntityDef -> Int -> Text)
-> SqlBackend
SqlBackend
            { connEscapeName :: DBName -> Text
connEscapeName = \(DBName Text
x) -> Text
x
            }
        render' :: SqlExpr (Value Bool) -> [Char]
render' = Text -> [Char]
T.unpack (Text -> [Char])
-> (SqlExpr (Value Bool) -> Text) -> SqlExpr (Value Bool) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlBackend -> SqlExpr (Value Bool) -> Text
renderExpr SqlBackend
dummy

-- | A part of a @SET@ clause.
newtype SetClause = SetClause (SqlExpr (Value ()))

-- | Collect 'OnClause's on 'FromJoin's.  Returns the first
-- unmatched 'OnClause's data on error.  Returns a list without
-- 'OnClauses' on success.
collectOnClauses
    :: SqlBackend
    -> [FromClause]
    -> Either (SqlExpr (Value Bool)) [FromClause]
collectOnClauses :: SqlBackend
-> [FromClause] -> Either (SqlExpr (Value Bool)) [FromClause]
collectOnClauses SqlBackend
sqlBackend = Set Ident
-> [FromClause]
-> [FromClause]
-> Either (SqlExpr (Value Bool)) [FromClause]
go Set Ident
forall a. Set a
Set.empty []
  where
    go :: Set Ident
-> [FromClause]
-> [FromClause]
-> Either (SqlExpr (Value Bool)) [FromClause]
go Set Ident
is []  (f :: FromClause
f@(FromStart Ident
i EntityDef
_) : [FromClause]
fs) =
        ([FromClause] -> [FromClause])
-> Either (SqlExpr (Value Bool)) [FromClause]
-> Either (SqlExpr (Value Bool)) [FromClause]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FromClause
fFromClause -> [FromClause] -> [FromClause]
forall a. a -> [a] -> [a]
:) (Set Ident
-> [FromClause]
-> [FromClause]
-> Either (SqlExpr (Value Bool)) [FromClause]
go (Ident -> Set Ident -> Set Ident
forall a. Ord a => a -> Set a -> Set a
Set.insert Ident
i Set Ident
is) [] [FromClause]
fs) -- fast path
    go Set Ident
idents [FromClause]
acc (OnClause SqlExpr (Value Bool)
expr : [FromClause]
fs) = do
        (Set Ident
idents', [FromClause]
a) <- Set Ident
-> [FromClause]
-> SqlExpr (Value Bool)
-> Either (SqlExpr (Value Bool)) (Set Ident, [FromClause])
findMatching Set Ident
idents [FromClause]
acc SqlExpr (Value Bool)
expr
        Set Ident
-> [FromClause]
-> [FromClause]
-> Either (SqlExpr (Value Bool)) [FromClause]
go Set Ident
idents' [FromClause]
a [FromClause]
fs
    go Set Ident
idents [FromClause]
acc (FromClause
f:[FromClause]
fs) =
        Set Ident
-> [FromClause]
-> [FromClause]
-> Either (SqlExpr (Value Bool)) [FromClause]
go Set Ident
idents (FromClause
fFromClause -> [FromClause] -> [FromClause]
forall a. a -> [a] -> [a]
:[FromClause]
acc) [FromClause]
fs
    go Set Ident
_ [FromClause]
acc [] =
        [FromClause] -> Either (SqlExpr (Value Bool)) [FromClause]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FromClause] -> Either (SqlExpr (Value Bool)) [FromClause])
-> [FromClause] -> Either (SqlExpr (Value Bool)) [FromClause]
forall a b. (a -> b) -> a -> b
$ [FromClause] -> [FromClause]
forall a. [a] -> [a]
reverse [FromClause]
acc

    findMatching
        :: Set Ident
        -> [FromClause]
        -> SqlExpr (Value Bool)
        -> Either (SqlExpr (Value Bool)) (Set Ident, [FromClause])
    findMatching :: Set Ident
-> [FromClause]
-> SqlExpr (Value Bool)
-> Either (SqlExpr (Value Bool)) (Set Ident, [FromClause])
findMatching Set Ident
idents [FromClause]
fromClauses SqlExpr (Value Bool)
expr =
        case [FromClause]
fromClauses of
            FromClause
f : [FromClause]
acc ->
              let idents' :: Set Ident
idents' =
                      Set Ident
idents
                      Set Ident -> Set Ident -> Set Ident
forall a. Semigroup a => a -> a -> a
<> [Ident] -> Set Ident
forall a. Ord a => [a] -> Set a
Set.fromList
                          ([Maybe Ident] -> [Ident]
forall a. [Maybe a] -> [a]
Maybe.catMaybes [FromClause -> Maybe Ident
findLeftmostIdent FromClause
f, FromClause -> Maybe Ident
findRightmostIdent FromClause
f])
              in
                  case Set Ident
-> SqlExpr (Value Bool)
-> FromClause
-> Maybe (Set Ident, FromClause)
tryMatch Set Ident
idents' SqlExpr (Value Bool)
expr FromClause
f of
                      Just (Set Ident
idents'', FromClause
f') ->
                          (Set Ident, [FromClause])
-> Either (SqlExpr (Value Bool)) (Set Ident, [FromClause])
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Ident
idents'', FromClause
f' FromClause -> [FromClause] -> [FromClause]
forall a. a -> [a] -> [a]
: [FromClause]
acc)
                      Maybe (Set Ident, FromClause)
Nothing ->
                          ([FromClause] -> [FromClause])
-> (Set Ident, [FromClause]) -> (Set Ident, [FromClause])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FromClause
fFromClause -> [FromClause] -> [FromClause]
forall a. a -> [a] -> [a]
:) ((Set Ident, [FromClause]) -> (Set Ident, [FromClause]))
-> Either (SqlExpr (Value Bool)) (Set Ident, [FromClause])
-> Either (SqlExpr (Value Bool)) (Set Ident, [FromClause])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Ident
-> [FromClause]
-> SqlExpr (Value Bool)
-> Either (SqlExpr (Value Bool)) (Set Ident, [FromClause])
findMatching Set Ident
idents' [FromClause]
acc SqlExpr (Value Bool)
expr
            [] ->
                SqlExpr (Value Bool)
-> Either (SqlExpr (Value Bool)) (Set Ident, [FromClause])
forall a b. a -> Either a b
Left SqlExpr (Value Bool)
expr

    findRightmostIdent :: FromClause -> Maybe Ident
findRightmostIdent (FromStart Ident
i EntityDef
_) = Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
i
    findRightmostIdent (FromJoin FromClause
_ JoinKind
_ FromClause
r Maybe (SqlExpr (Value Bool))
_) = FromClause -> Maybe Ident
findRightmostIdent FromClause
r
    findRightmostIdent (OnClause {}) = Maybe Ident
forall a. Maybe a
Nothing
    findRightmostIdent (FromQuery Ident
_ IdentInfo -> (Builder, [PersistValue])
_ SubQueryType
_) = Maybe Ident
forall a. Maybe a
Nothing
    findRightmostIdent (FromIdent Ident
_) = Maybe Ident
forall a. Maybe a
Nothing

    findLeftmostIdent :: FromClause -> Maybe Ident
findLeftmostIdent (FromStart Ident
i EntityDef
_) = Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
i
    findLeftmostIdent (FromJoin FromClause
l JoinKind
_ FromClause
_ Maybe (SqlExpr (Value Bool))
_) = FromClause -> Maybe Ident
findLeftmostIdent FromClause
l
    findLeftmostIdent (OnClause {}) = Maybe Ident
forall a. Maybe a
Nothing
    findLeftmostIdent (FromQuery Ident
_ IdentInfo -> (Builder, [PersistValue])
_ SubQueryType
_) = Maybe Ident
forall a. Maybe a
Nothing
    findLeftmostIdent (FromIdent Ident
_) = Maybe Ident
forall a. Maybe a
Nothing

    tryMatch
        :: Set Ident
        -> SqlExpr (Value Bool)
        -> FromClause
        -> Maybe (Set Ident, FromClause)
    tryMatch :: Set Ident
-> SqlExpr (Value Bool)
-> FromClause
-> Maybe (Set Ident, FromClause)
tryMatch Set Ident
idents SqlExpr (Value Bool)
expr FromClause
fromClause =
      case FromClause
fromClause of
        FromJoin FromClause
l JoinKind
k FromClause
r Maybe (SqlExpr (Value Bool))
onClause ->
          Maybe (Set Ident, FromClause)
matchTable Maybe (Set Ident, FromClause)
-> Maybe (Set Ident, FromClause) -> Maybe (Set Ident, FromClause)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Set Ident, FromClause)
matchR Maybe (Set Ident, FromClause)
-> Maybe (Set Ident, FromClause) -> Maybe (Set Ident, FromClause)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Set Ident, FromClause)
matchC Maybe (Set Ident, FromClause)
-> Maybe (Set Ident, FromClause) -> Maybe (Set Ident, FromClause)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Set Ident, FromClause)
matchL Maybe (Set Ident, FromClause)
-> Maybe (Set Ident, FromClause) -> Maybe (Set Ident, FromClause)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Set Ident, FromClause)
matchPartial -- right to left
            where
              matchR :: Maybe (Set Ident, FromClause)
matchR = (FromClause -> FromClause)
-> (Set Ident, FromClause) -> (Set Ident, FromClause)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FromClause
r' -> FromClause
-> JoinKind
-> FromClause
-> Maybe (SqlExpr (Value Bool))
-> FromClause
FromJoin FromClause
l JoinKind
k FromClause
r' Maybe (SqlExpr (Value Bool))
onClause)
                ((Set Ident, FromClause) -> (Set Ident, FromClause))
-> Maybe (Set Ident, FromClause) -> Maybe (Set Ident, FromClause)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Ident
-> SqlExpr (Value Bool)
-> FromClause
-> Maybe (Set Ident, FromClause)
tryMatch Set Ident
idents SqlExpr (Value Bool)
expr FromClause
r
              matchL :: Maybe (Set Ident, FromClause)
matchL = (FromClause -> FromClause)
-> (Set Ident, FromClause) -> (Set Ident, FromClause)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FromClause
l' -> FromClause
-> JoinKind
-> FromClause
-> Maybe (SqlExpr (Value Bool))
-> FromClause
FromJoin FromClause
l' JoinKind
k FromClause
r Maybe (SqlExpr (Value Bool))
onClause)
                ((Set Ident, FromClause) -> (Set Ident, FromClause))
-> Maybe (Set Ident, FromClause) -> Maybe (Set Ident, FromClause)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Ident
-> SqlExpr (Value Bool)
-> FromClause
-> Maybe (Set Ident, FromClause)
tryMatch Set Ident
idents SqlExpr (Value Bool)
expr FromClause
l

              matchPartial :: Maybe (Set Ident, FromClause)
matchPartial = do
                --Debug.traceM $ "matchPartial"
                --Debug.traceM $ "matchPartial: identsInOnClause: " <> show identsInOnClause
                Ident
i1 <- FromClause -> Maybe Ident
findLeftmostIdent FromClause
l
                Ident
i2 <- FromClause -> Maybe Ident
findLeftmostIdent FromClause
r
                let leftIdents :: Set Ident
leftIdents = FromClause -> Set Ident
collectIdents FromClause
l
                -- Debug.traceM $ "matchPartial: i1: " <> show i1
                -- Debug.traceM $ "matchPartial: i2: " <> show i2
                -- Debug.traceM $ "matchPartial: idents: " <> show idents
                Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$
                  Set Ident -> Set Ident -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf
                    Set Ident
identsInOnClause
                    ([Ident] -> Set Ident
forall a. Ord a => [a] -> Set a
Set.fromList [Ident
i1, Ident
i2] Set Ident -> Set Ident -> Set Ident
forall a. Semigroup a => a -> a -> a
<> Set Ident
leftIdents)
                Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ JoinKind
k JoinKind -> JoinKind -> Bool
forall a. Eq a => a -> a -> Bool
/= JoinKind
CrossJoinKind
                Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Maybe (SqlExpr (Value Bool)) -> Bool
forall a. Maybe a -> Bool
Maybe.isNothing Maybe (SqlExpr (Value Bool))
onClause
                (Set Ident, FromClause) -> Maybe (Set Ident, FromClause)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set Ident
idents, FromClause
-> JoinKind
-> FromClause
-> Maybe (SqlExpr (Value Bool))
-> FromClause
FromJoin FromClause
l JoinKind
k FromClause
r (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a. a -> Maybe a
Just SqlExpr (Value Bool)
expr))

              matchC :: Maybe (Set Ident, FromClause)
matchC =
                case Maybe (SqlExpr (Value Bool))
onClause of
                  Maybe (SqlExpr (Value Bool))
Nothing
                    | Text
"?" Text -> Text -> Bool
`T.isInfixOf` Text
renderedExpr ->
                        (Set Ident, FromClause) -> Maybe (Set Ident, FromClause)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Ident
idents, FromClause
-> JoinKind
-> FromClause
-> Maybe (SqlExpr (Value Bool))
-> FromClause
FromJoin FromClause
l JoinKind
k FromClause
r (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a. a -> Maybe a
Just SqlExpr (Value Bool)
expr))
                    | Set Ident -> Bool
forall a. Set a -> Bool
Set.null Set Ident
identsInOnClause ->
                        (Set Ident, FromClause) -> Maybe (Set Ident, FromClause)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Ident
idents, FromClause
-> JoinKind
-> FromClause
-> Maybe (SqlExpr (Value Bool))
-> FromClause
FromJoin FromClause
l JoinKind
k FromClause
r (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a. a -> Maybe a
Just SqlExpr (Value Bool)
expr))
                    | Bool
otherwise ->
                        Maybe (Set Ident, FromClause)
forall a. Maybe a
Nothing
                  Just SqlExpr (Value Bool)
_ ->
                    Maybe (Set Ident, FromClause)
forall a. Maybe a
Nothing
              matchTable :: Maybe (Set Ident, FromClause)
matchTable = do
                Ident
i1 <- FromClause -> Maybe Ident
findLeftmostIdent FromClause
r
                Ident
i2 <- FromClause -> Maybe Ident
findRightmostIdent FromClause
l
                Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ [Ident] -> Set Ident
forall a. Ord a => [a] -> Set a
Set.fromList [Ident
i1, Ident
i2] Set Ident -> Set Ident -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set Ident
identsInOnClause
                Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ JoinKind
k JoinKind -> JoinKind -> Bool
forall a. Eq a => a -> a -> Bool
/= JoinKind
CrossJoinKind
                Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Maybe (SqlExpr (Value Bool)) -> Bool
forall a. Maybe a -> Bool
Maybe.isNothing Maybe (SqlExpr (Value Bool))
onClause
                (Set Ident, FromClause) -> Maybe (Set Ident, FromClause)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Ident] -> Set Ident
forall a. Ord a => [a] -> Set a
Set.fromList [Ident
i1, Ident
i2] Set Ident -> Set Ident -> Set Ident
forall a. Semigroup a => a -> a -> a
<> Set Ident
idents, FromClause
-> JoinKind
-> FromClause
-> Maybe (SqlExpr (Value Bool))
-> FromClause
FromJoin FromClause
l JoinKind
k FromClause
r (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a. a -> Maybe a
Just SqlExpr (Value Bool)
expr))

        FromClause
_ ->
          Maybe (Set Ident, FromClause)
forall a. Maybe a
Nothing
      where
        identsInOnClause :: Set Ident
identsInOnClause =
          Set Ident
onExprToTableIdentifiers

        renderedExpr :: Text
renderedExpr =
          SqlBackend -> SqlExpr (Value Bool) -> Text
renderExpr SqlBackend
sqlBackend SqlExpr (Value Bool)
expr

        onExprToTableIdentifiers :: Set Ident
onExprToTableIdentifiers =
          (TableAccess -> Ident) -> Set TableAccess -> Set Ident
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Text -> Ident
I (Text -> Ident) -> (TableAccess -> Text) -> TableAccess -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableAccess -> Text
tableAccessTable)
          (Set TableAccess -> Set Ident)
-> (Text -> Set TableAccess) -> Text -> Set Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Set TableAccess)
-> (Set TableAccess -> Set TableAccess)
-> Either [Char] (Set TableAccess)
-> Set TableAccess
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Set TableAccess
forall a. HasCallStack => [Char] -> a
error Set TableAccess -> Set TableAccess
forall a. a -> a
id
          (Either [Char] (Set TableAccess) -> Set TableAccess)
-> (Text -> Either [Char] (Set TableAccess))
-> Text
-> Set TableAccess
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlBackend -> Text -> Either [Char] (Set TableAccess)
parseOnExpr SqlBackend
sqlBackend
          (Text -> Set Ident) -> Text -> Set Ident
forall a b. (a -> b) -> a -> b
$ Text
renderedExpr

-- | A complete @WHERE@ clause.
data WhereClause = Where (SqlExpr (Value Bool))
                 | NoWhere

instance Semigroup WhereClause where
  WhereClause
NoWhere  <> :: WhereClause -> WhereClause -> WhereClause
<> WhereClause
w        = WhereClause
w
  WhereClause
w        <> WhereClause
NoWhere  = WhereClause
w
  Where SqlExpr (Value Bool)
e1 <> Where SqlExpr (Value Bool)
e2 = SqlExpr (Value Bool) -> WhereClause
Where (SqlExpr (Value Bool)
e1 SqlExpr (Value Bool)
-> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
&&. SqlExpr (Value Bool)
e2)

instance Monoid WhereClause where
  mempty :: WhereClause
mempty = WhereClause
NoWhere
  mappend :: WhereClause -> WhereClause -> WhereClause
mappend = WhereClause -> WhereClause -> WhereClause
forall a. Semigroup a => a -> a -> a
(<>)

-- | A @GROUP BY@ clause.
newtype GroupByClause = GroupBy [SomeValue]

instance Semigroup GroupByClause where
  GroupBy [SomeValue]
fs <> :: GroupByClause -> GroupByClause -> GroupByClause
<> GroupBy [SomeValue]
fs' = [SomeValue] -> GroupByClause
GroupBy ([SomeValue]
fs [SomeValue] -> [SomeValue] -> [SomeValue]
forall a. Semigroup a => a -> a -> a
<> [SomeValue]
fs')

instance Monoid GroupByClause where
  mempty :: GroupByClause
mempty = [SomeValue] -> GroupByClause
GroupBy []
  mappend :: GroupByClause -> GroupByClause -> GroupByClause
mappend = GroupByClause -> GroupByClause -> GroupByClause
forall a. Semigroup a => a -> a -> a
(<>)

-- | A @HAVING@ cause.
type HavingClause = WhereClause

-- | A @ORDER BY@ clause.
type OrderByClause = SqlExpr OrderBy

-- | A @LIMIT@ clause.
data LimitClause = Limit (Maybe Int64) (Maybe Int64)
  deriving LimitClause -> LimitClause -> Bool
(LimitClause -> LimitClause -> Bool)
-> (LimitClause -> LimitClause -> Bool) -> Eq LimitClause
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LimitClause -> LimitClause -> Bool
$c/= :: LimitClause -> LimitClause -> Bool
== :: LimitClause -> LimitClause -> Bool
$c== :: LimitClause -> LimitClause -> Bool
Eq

instance Semigroup LimitClause where
  Limit Maybe Int64
l1 Maybe Int64
o1 <> :: LimitClause -> LimitClause -> LimitClause
<> Limit Maybe Int64
l2 Maybe Int64
o2 =
    Maybe Int64 -> Maybe Int64 -> LimitClause
Limit (Maybe Int64
l2 Maybe Int64 -> Maybe Int64 -> Maybe Int64
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Int64
l1) (Maybe Int64
o2 Maybe Int64 -> Maybe Int64 -> Maybe Int64
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Int64
o1)
    -- More than one 'limit' or 'offset' is issued, we want to
    -- keep the latest one.  That's why we use mplus with
    -- "reversed" arguments.

instance Monoid LimitClause where
  mempty :: LimitClause
mempty = Maybe Int64 -> Maybe Int64 -> LimitClause
Limit Maybe Int64
forall (m :: * -> *) a. MonadPlus m => m a
mzero Maybe Int64
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  mappend :: LimitClause -> LimitClause -> LimitClause
mappend = LimitClause -> LimitClause -> LimitClause
forall a. Semigroup a => a -> a -> a
(<>)

-- | A locking clause.
type LockingClause = Monoid.Last LockingKind

----------------------------------------------------------------------

-- | Identifier used for table names.
newtype Ident = I T.Text
  deriving (Ident -> Ident -> Bool
(Ident -> Ident -> Bool) -> (Ident -> Ident -> Bool) -> Eq Ident
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ident -> Ident -> Bool
$c/= :: Ident -> Ident -> Bool
== :: Ident -> Ident -> Bool
$c== :: Ident -> Ident -> Bool
Eq, Eq Ident
Eq Ident
-> (Ident -> Ident -> Ordering)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Ident)
-> (Ident -> Ident -> Ident)
-> Ord Ident
Ident -> Ident -> Bool
Ident -> Ident -> Ordering
Ident -> Ident -> Ident
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Ident -> Ident -> Ident
$cmin :: Ident -> Ident -> Ident
max :: Ident -> Ident -> Ident
$cmax :: Ident -> Ident -> Ident
>= :: Ident -> Ident -> Bool
$c>= :: Ident -> Ident -> Bool
> :: Ident -> Ident -> Bool
$c> :: Ident -> Ident -> Bool
<= :: Ident -> Ident -> Bool
$c<= :: Ident -> Ident -> Bool
< :: Ident -> Ident -> Bool
$c< :: Ident -> Ident -> Bool
compare :: Ident -> Ident -> Ordering
$ccompare :: Ident -> Ident -> Ordering
$cp1Ord :: Eq Ident
Ord, Int -> Ident -> ShowS
[Ident] -> ShowS
Ident -> [Char]
(Int -> Ident -> ShowS)
-> (Ident -> [Char]) -> ([Ident] -> ShowS) -> Show Ident
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Ident] -> ShowS
$cshowList :: [Ident] -> ShowS
show :: Ident -> [Char]
$cshow :: Ident -> [Char]
showsPrec :: Int -> Ident -> ShowS
$cshowsPrec :: Int -> Ident -> ShowS
Show)

-- | List of identifiers already in use and supply of temporary
-- identifiers.
newtype IdentState = IdentState { IdentState -> HashSet Text
inUse :: HS.HashSet T.Text }

initialIdentState :: IdentState
initialIdentState :: IdentState
initialIdentState = HashSet Text -> IdentState
IdentState HashSet Text
forall a. Monoid a => a
mempty

-- | Create a fresh 'Ident'.  If possible, use the given
-- 'DBName'.
newIdentFor :: DBName -> SqlQuery Ident
newIdentFor :: DBName -> SqlQuery Ident
newIdentFor (DBName Text
original) = WriterT SideData (State IdentState) Ident -> SqlQuery Ident
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (WriterT SideData (State IdentState) Ident -> SqlQuery Ident)
-> WriterT SideData (State IdentState) Ident -> SqlQuery Ident
forall a b. (a -> b) -> a -> b
$ StateT IdentState Identity Ident
-> WriterT SideData (State IdentState) Ident
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT IdentState Identity Ident
 -> WriterT SideData (State IdentState) Ident)
-> StateT IdentState Identity Ident
-> WriterT SideData (State IdentState) Ident
forall a b. (a -> b) -> a -> b
$ Maybe Int -> StateT IdentState Identity Ident
findFree Maybe Int
forall a. Maybe a
Nothing
  where
    findFree :: Maybe Int -> StateT IdentState Identity Ident
findFree Maybe Int
msuffix = do
      let
        withSuffix :: Text
withSuffix =
          (Text -> Text)
-> (Int -> Text -> Text) -> Maybe Int -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall a. a -> a
id (\Int
suffix -> (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
suffix))) Maybe Int
msuffix Text
original
      Bool
isInUse <- (IdentState -> Bool) -> StateT IdentState Identity Bool
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
S.gets (Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member Text
withSuffix (HashSet Text -> Bool)
-> (IdentState -> HashSet Text) -> IdentState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentState -> HashSet Text
inUse)
      if Bool
isInUse
        then Maybe Int -> StateT IdentState Identity Ident
findFree (Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Int
msuffix Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
1 :: Int)))
        else do
          (IdentState -> IdentState) -> StateT IdentState Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
S.modify (\IdentState
s -> IdentState
s { inUse :: HashSet Text
inUse = Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.insert Text
withSuffix (IdentState -> HashSet Text
inUse IdentState
s) })
          Ident -> StateT IdentState Identity Ident
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Ident
I Text
withSuffix)

-- | Information needed to escape and use identifiers.
type IdentInfo = (SqlBackend, IdentState)

-- | Use an identifier.
useIdent :: IdentInfo -> Ident -> TLB.Builder
useIdent :: IdentInfo -> Ident -> Builder
useIdent IdentInfo
info (I Text
ident) = IdentInfo -> DBName -> Builder
fromDBName IdentInfo
info (DBName -> Builder) -> DBName -> Builder
forall a b. (a -> b) -> a -> b
$ Text -> DBName
DBName Text
ident

-- | An expression on the SQL backend.
--
-- There are many comments describing the constructors of this
-- data type.  However, Haddock doesn't like GADTs, so you'll have to read them by hitting \"Source\".
data SqlExpr a where
    -- An entity, created by 'from' (cf. 'fromStart').
    EEntity  :: Ident -> SqlExpr (Entity val)
    --                Base     Table
    EAliasedEntity :: Ident -> Ident -> SqlExpr (Entity val)
    --                         Source   Base
    EAliasedEntityReference :: Ident -> Ident -> SqlExpr (Entity val)

    -- Just a tag stating that something is nullable.
    EMaybe   :: SqlExpr a -> SqlExpr (Maybe a)

    -- Raw expression: states whether parenthesis are needed
    -- around this expression, and takes information about the SQL
    -- connection (mainly for escaping names) and returns both an
    -- string ('TLB.Builder') and a list of values to be
    -- interpolated by the SQL backend.
    ERaw     :: NeedParens -> (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a)


    -- A raw expression with an alias
    EAliasedValue :: Ident -> SqlExpr (Value a) -> SqlExpr (Value a)

    -- A reference to an aliased field in a table or subquery
    EValueReference :: Ident -> (IdentInfo -> Ident) -> SqlExpr (Value a)

    -- A composite key.
    --
    -- Persistent uses the same 'PersistList' constructor for both
    -- fields which are (homogeneous) lists of values and the
    -- (probably heterogeneous) values of a composite primary key.
    --
    -- We need to treat composite keys as fields.  For example, we
    -- have to support using ==., otherwise you wouldn't be able to
    -- join.  OTOH, lists of values should be treated exactly the
    -- same as any other scalar value.
    --
    -- In particular, this is valid for persistent via rawSql for
    -- an F field that is a list:
    --
    --   A.F in ?    -- [PersistList [foo, bar]]
    --
    -- However, this is not for a composite key entity:
    --
    --   A.ID = ?    -- [PersistList [foo, bar]]
    --
    -- The ID field doesn't exist on the DB for a composite key
    -- table, it exists only on the Haskell side.  Those variations
    -- also don't work:
    --
    --   (A.KeyA, A.KeyB) = ?    -- [PersistList [foo, bar]]
    --   [A.KeyA, A.KeyB] = ?    -- [PersistList [foo, bar]]
    --
    -- We have to generate:
    --
    --   A.KeyA = ? AND A.KeyB = ?      -- [foo, bar]
    --
    -- Note that the PersistList had to be deconstructed into its
    -- components.
    --
    -- In order to disambiguate behaviors, this constructor is used
    -- /only/ to represent a composite field access.  It does not
    -- represent a 'PersistList', not even if the 'PersistList' is
    -- used in the context of a composite key.  That's because it's
    -- impossible, e.g., for 'val' to disambiguate between these
    -- uses.
    ECompositeKey :: (IdentInfo -> [TLB.Builder]) -> SqlExpr (Value a)

    -- 'EList' and 'EEmptyList' are used by list operators.
    EList      :: SqlExpr (Value a) -> SqlExpr (ValueList a)
    EEmptyList :: SqlExpr (ValueList a)

    -- A 'SqlExpr' accepted only by 'orderBy'.
    EOrderBy :: OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy

    EOrderRandom :: SqlExpr OrderBy

    -- A 'SqlExpr' accepted only by 'distinctOn'.
    EDistinctOn :: SqlExpr (Value a) -> SqlExpr DistinctOn

    -- A 'SqlExpr' accepted only by 'set'.
    ESet :: (SqlExpr (Entity val) -> SqlExpr (Value ())) -> SqlExpr (Update val)

    -- An internal 'SqlExpr' used by the 'from' hack.
    EPreprocessedFrom :: a -> FromClause -> SqlExpr (PreprocessedFrom a)

    -- Used by 'insertSelect'.
    EInsert  :: Proxy a -> (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Insertion a)
    EInsertFinal :: PersistEntity a => SqlExpr (Insertion a) -> SqlExpr InsertFinal

-- | Phantom type used to mark a @INSERT INTO@ query.
data InsertFinal

data NeedParens = Parens | Never
    deriving NeedParens -> NeedParens -> Bool
(NeedParens -> NeedParens -> Bool)
-> (NeedParens -> NeedParens -> Bool) -> Eq NeedParens
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NeedParens -> NeedParens -> Bool
$c/= :: NeedParens -> NeedParens -> Bool
== :: NeedParens -> NeedParens -> Bool
$c== :: NeedParens -> NeedParens -> Bool
Eq

parensM :: NeedParens -> TLB.Builder -> TLB.Builder
parensM :: NeedParens -> Builder -> Builder
parensM NeedParens
Never  = Builder -> Builder
forall a. a -> a
id
parensM NeedParens
Parens = Builder -> Builder
parens

data OrderByType = ASC | DESC

instance ToSomeValues (SqlExpr (Value a)) where
  toSomeValues :: SqlExpr (Value a) -> [SomeValue]
toSomeValues SqlExpr (Value a)
a = [SqlExpr (Value a) -> SomeValue
forall a. SqlExpr (Value a) -> SomeValue
SomeValue SqlExpr (Value a)
a]

fieldName
    :: (PersistEntity val, PersistField typ)
    => IdentInfo -> EntityField val typ -> TLB.Builder
fieldName :: IdentInfo -> EntityField val typ -> Builder
fieldName IdentInfo
info = IdentInfo -> DBName -> Builder
fromDBName IdentInfo
info (DBName -> Builder)
-> (EntityField val typ -> DBName)
-> EntityField val typ
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> DBName
fieldDB (FieldDef -> DBName)
-> (EntityField val typ -> FieldDef)
-> EntityField val typ
-> DBName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityField val typ -> FieldDef
forall record typ.
PersistEntity record =>
EntityField record typ -> FieldDef
persistFieldDef

-- FIXME: Composite/non-id pKS not supported on set
setAux
    :: (PersistEntity val, PersistField typ)
    => EntityField val typ
    -> (SqlExpr (Entity val) -> SqlExpr (Value typ))
    -> SqlExpr (Update val)
setAux :: EntityField val typ
-> (SqlExpr (Entity val) -> SqlExpr (Value typ))
-> SqlExpr (Update val)
setAux EntityField val typ
field SqlExpr (Entity val) -> SqlExpr (Value typ)
mkVal = (SqlExpr (Entity val) -> SqlExpr (Value ()))
-> SqlExpr (Update val)
forall val.
(SqlExpr (Entity val) -> SqlExpr (Value ()))
-> SqlExpr (Update val)
ESet ((SqlExpr (Entity val) -> SqlExpr (Value ()))
 -> SqlExpr (Update val))
-> (SqlExpr (Entity val) -> SqlExpr (Value ()))
-> SqlExpr (Update val)
forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity val)
ent -> Builder
-> SqlExpr (Value Any) -> SqlExpr (Value typ) -> SqlExpr (Value ())
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
" = " SqlExpr (Value Any)
name (SqlExpr (Entity val) -> SqlExpr (Value typ)
mkVal SqlExpr (Entity val)
ent)
  where
    name :: SqlExpr (Value Any)
name = NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Any)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Any))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value Any)
forall a b. (a -> b) -> a -> b
$ \IdentInfo
info -> (IdentInfo -> EntityField val typ -> Builder
forall val typ.
(PersistEntity val, PersistField typ) =>
IdentInfo -> EntityField val typ -> Builder
fieldName IdentInfo
info EntityField val typ
field, [PersistValue]
forall a. Monoid a => a
mempty)

sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
sub :: Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
sub Mode
mode SqlQuery (SqlExpr (Value a))
query = NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Parens ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a b. (a -> b) -> a -> b
$ \IdentInfo
info -> Mode
-> IdentInfo
-> SqlQuery (SqlExpr (Value a))
-> (Builder, [PersistValue])
forall a r backend.
(SqlSelect a r, BackendCompatible SqlBackend backend) =>
Mode
-> (backend, IdentState) -> SqlQuery a -> (Builder, [PersistValue])
toRawSql Mode
mode IdentInfo
info SqlQuery (SqlExpr (Value a))
query

fromDBName :: IdentInfo -> DBName -> TLB.Builder
fromDBName :: IdentInfo -> DBName -> Builder
fromDBName (SqlBackend
conn, IdentState
_) = Text -> Builder
TLB.fromText (Text -> Builder) -> (DBName -> Text) -> DBName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlBackend -> DBName -> Text
connEscapeName SqlBackend
conn

existsHelper :: SqlQuery () -> SqlExpr (Value Bool)
existsHelper :: SqlQuery () -> SqlExpr (Value Bool)
existsHelper = Mode -> SqlQuery (SqlExpr (Value Bool)) -> SqlExpr (Value Bool)
forall a.
PersistField a =>
Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
sub Mode
SELECT (SqlQuery (SqlExpr (Value Bool)) -> SqlExpr (Value Bool))
-> (SqlQuery () -> SqlQuery (SqlExpr (Value Bool)))
-> SqlQuery ()
-> SqlExpr (Value Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SqlQuery ()
-> SqlQuery (SqlExpr (Value Bool))
-> SqlQuery (SqlExpr (Value Bool))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SqlExpr (Value Bool) -> SqlQuery (SqlExpr (Value Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return SqlExpr (Value Bool)
true)
  where
    true :: SqlExpr (Value Bool)
    true :: SqlExpr (Value Bool)
true = Bool -> SqlExpr (Value Bool)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Bool
True

ifNotEmptyList :: SqlExpr (ValueList a) -> Bool -> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
ifNotEmptyList :: SqlExpr (ValueList a)
-> Bool -> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
ifNotEmptyList SqlExpr (ValueList a)
EEmptyList Bool
b SqlExpr (Value Bool)
_ = Bool -> SqlExpr (Value Bool)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Bool
b
ifNotEmptyList (EList SqlExpr (Value a)
_)  Bool
_ SqlExpr (Value Bool)
x = SqlExpr (Value Bool)
x

-- | (Internal) Create a case statement.
--
-- Since: 2.1.1
unsafeSqlCase :: PersistField a => [(SqlExpr (Value Bool), SqlExpr (Value a))] -> SqlExpr (Value a) -> SqlExpr (Value a)
unsafeSqlCase :: [(SqlExpr (Value Bool), SqlExpr (Value a))]
-> SqlExpr (Value a) -> SqlExpr (Value a)
unsafeSqlCase [(SqlExpr (Value Bool), SqlExpr (Value a))]
when SqlExpr (Value a)
v = NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never IdentInfo -> (Builder, [PersistValue])
buildCase
  where
    buildCase :: IdentInfo -> (TLB.Builder, [PersistValue])
    buildCase :: IdentInfo -> (Builder, [PersistValue])
buildCase IdentInfo
info =
        let (Builder
elseText, [PersistValue]
elseVals) = SqlExpr (Value a) -> IdentInfo -> (Builder, [PersistValue])
forall a.
SqlExpr (Value a) -> IdentInfo -> (Builder, [PersistValue])
valueToSql SqlExpr (Value a)
v IdentInfo
info
            (Builder
whenText, [PersistValue]
whenVals) = [(SqlExpr (Value Bool), SqlExpr (Value a))]
-> IdentInfo -> (Builder, [PersistValue])
forall a.
[(SqlExpr (Value Bool), SqlExpr (Value a))]
-> IdentInfo -> (Builder, [PersistValue])
mapWhen [(SqlExpr (Value Bool), SqlExpr (Value a))]
when IdentInfo
info
        in ( Builder
"CASE" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
whenText Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" ELSE " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
elseText Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" END", [PersistValue]
whenVals [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. Semigroup a => a -> a -> a
<> [PersistValue]
elseVals)

    mapWhen :: [(SqlExpr (Value Bool), SqlExpr (Value a))] -> IdentInfo -> (TLB.Builder, [PersistValue])
    mapWhen :: [(SqlExpr (Value Bool), SqlExpr (Value a))]
-> IdentInfo -> (Builder, [PersistValue])
mapWhen []    IdentInfo
_    = EsqueletoError -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (UnexpectedCaseError -> EsqueletoError
UnexpectedCaseErr UnexpectedCaseError
UnsafeSqlCaseError)
    mapWhen [(SqlExpr (Value Bool), SqlExpr (Value a))]
when' IdentInfo
info = ((Builder, [PersistValue])
 -> (SqlExpr (Value Bool), SqlExpr (Value a))
 -> (Builder, [PersistValue]))
-> (Builder, [PersistValue])
-> [(SqlExpr (Value Bool), SqlExpr (Value a))]
-> (Builder, [PersistValue])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (IdentInfo
-> (Builder, [PersistValue])
-> (SqlExpr (Value Bool), SqlExpr (Value a))
-> (Builder, [PersistValue])
forall a.
IdentInfo
-> (Builder, [PersistValue])
-> (SqlExpr (Value Bool), SqlExpr (Value a))
-> (Builder, [PersistValue])
foldHelp IdentInfo
info) (Builder
forall a. Monoid a => a
mempty, [PersistValue]
forall a. Monoid a => a
mempty) [(SqlExpr (Value Bool), SqlExpr (Value a))]
when'

    foldHelp :: IdentInfo -> (TLB.Builder, [PersistValue]) -> (SqlExpr (Value Bool), SqlExpr (Value a)) -> (TLB.Builder, [PersistValue])
    foldHelp :: IdentInfo
-> (Builder, [PersistValue])
-> (SqlExpr (Value Bool), SqlExpr (Value a))
-> (Builder, [PersistValue])
foldHelp IdentInfo
_ (Builder, [PersistValue])
_ (ECompositeKey IdentInfo -> [Builder]
_, SqlExpr (Value a)
_) = EsqueletoError -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
FoldHelpError)
    foldHelp IdentInfo
_ (Builder, [PersistValue])
_ (SqlExpr (Value Bool)
_, ECompositeKey IdentInfo -> [Builder]
_) = EsqueletoError -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
FoldHelpError)
    foldHelp IdentInfo
info (Builder
b0, [PersistValue]
vals0) (SqlExpr (Value Bool)
v1, SqlExpr (Value a)
v2) =
        let (Builder
b1, [PersistValue]
vals1) = SqlExpr (Value Bool) -> IdentInfo -> (Builder, [PersistValue])
forall a.
SqlExpr (Value a) -> IdentInfo -> (Builder, [PersistValue])
valueToSql SqlExpr (Value Bool)
v1 IdentInfo
info
            (Builder
b2, [PersistValue]
vals2) = SqlExpr (Value a) -> IdentInfo -> (Builder, [PersistValue])
forall a.
SqlExpr (Value a) -> IdentInfo -> (Builder, [PersistValue])
valueToSql SqlExpr (Value a)
v2 IdentInfo
info
        in ( Builder
b0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" WHEN " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" THEN " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b2, [PersistValue]
vals0 [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. Semigroup a => a -> a -> a
<> [PersistValue]
vals1 [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. Semigroup a => a -> a -> a
<> [PersistValue]
vals2 )

    valueToSql :: SqlExpr (Value a) -> IdentInfo -> (TLB.Builder, [PersistValue])
    valueToSql :: SqlExpr (Value a) -> IdentInfo -> (Builder, [PersistValue])
valueToSql (ERaw NeedParens
p IdentInfo -> (Builder, [PersistValue])
f) = ((Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
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]))
-> (IdentInfo -> (Builder, [PersistValue]))
-> IdentInfo
-> (Builder, [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> (Builder, [PersistValue])
f
    valueToSql (ECompositeKey IdentInfo -> [Builder]
_) = EsqueletoError -> IdentInfo -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
SqlCaseError)
    valueToSql (EAliasedValue Ident
i SqlExpr (Value a)
_) = Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i
    valueToSql (EValueReference Ident
i IdentInfo -> Ident
i') = Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i'

-- | (Internal) Create a custom binary operator.  You /should/
-- /not/ use this function directly since its type is very
-- general, you should always use it with an explicit type
-- signature.  For example:
--
-- @
-- (==.) :: SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Bool)
-- (==.) = unsafeSqlBinOp " = "
-- @
--
-- In the example above, we constraint the arguments to be of the
-- same type and constraint the result to be a boolean value.
unsafeSqlBinOp :: TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp :: Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
op (ERaw NeedParens
p1 IdentInfo -> (Builder, [PersistValue])
f1) (ERaw NeedParens
p2 IdentInfo -> (Builder, [PersistValue])
f2) = NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value c)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Parens IdentInfo -> (Builder, [PersistValue])
f
  where
    f :: IdentInfo -> (Builder, [PersistValue])
f IdentInfo
info =
        let (Builder
b1, [PersistValue]
vals1) = IdentInfo -> (Builder, [PersistValue])
f1 IdentInfo
info
            (Builder
b2, [PersistValue]
vals2) = IdentInfo -> (Builder, [PersistValue])
f2 IdentInfo
info
        in
            ( NeedParens -> Builder -> Builder
parensM NeedParens
p1 Builder
b1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
op Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NeedParens -> Builder -> Builder
parensM NeedParens
p2 Builder
b2
            , [PersistValue]
vals1 [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. Semigroup a => a -> a -> a
<> [PersistValue]
vals2
            )
unsafeSqlBinOp Builder
op SqlExpr (Value a)
a SqlExpr (Value b)
b = Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
op (SqlExpr (Value a) -> SqlExpr (Value a)
forall a. SqlExpr (Value a) -> SqlExpr (Value a)
construct SqlExpr (Value a)
a) (SqlExpr (Value b) -> SqlExpr (Value b)
forall a. SqlExpr (Value a) -> SqlExpr (Value a)
construct SqlExpr (Value b)
b)
  where
    construct :: SqlExpr (Value a) -> SqlExpr (Value a)
    construct :: SqlExpr (Value a) -> SqlExpr (Value a)
construct (ERaw NeedParens
p IdentInfo -> (Builder, [PersistValue])
f) =
        NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw (if NeedParens
p NeedParens -> NeedParens -> Bool
forall a. Eq a => a -> a -> Bool
== NeedParens
Never then NeedParens
Parens else NeedParens
Never) ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a b. (a -> b) -> a -> b
$ \IdentInfo
info ->
            let (Builder
b1, [PersistValue]
vals) = IdentInfo -> (Builder, [PersistValue])
f IdentInfo
info
                build :: (Builder, [PersistValue]) -> (Builder, [PersistValue])
build (Builder
"?", [PersistList [PersistValue]
vals']) =
                    ([Builder] -> Builder
uncommas ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder -> [Builder]
forall a. Int -> a -> [a]
replicate ([PersistValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PersistValue]
vals') Builder
"?", [PersistValue]
vals')
                build (Builder, [PersistValue])
expr = (Builder, [PersistValue])
expr
             in
                (Builder, [PersistValue]) -> (Builder, [PersistValue])
build (NeedParens -> Builder -> Builder
parensM NeedParens
p Builder
b1, [PersistValue]
vals)
    construct (ECompositeKey IdentInfo -> [Builder]
f) =
        NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Parens ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a b. (a -> b) -> a -> b
$ \IdentInfo
info -> ([Builder] -> Builder
uncommas ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ IdentInfo -> [Builder]
f IdentInfo
info, [PersistValue]
forall a. Monoid a => a
mempty)
    construct (EAliasedValue Ident
i SqlExpr (Value a)
_) =
        NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a b. (a -> b) -> a -> b
$ Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i
    construct (EValueReference Ident
i IdentInfo -> Ident
i') =
        NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a b. (a -> b) -> a -> b
$ Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i'
{-# INLINE unsafeSqlBinOp #-}

-- | Similar to 'unsafeSqlBinOp', but may also be applied to
-- composite keys.  Uses the operator given as the second
-- argument whenever applied to composite keys.
--
-- Usage example:
--
-- @
-- (==.) :: SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Bool)
-- (==.) = unsafeSqlBinOpComposite " = " " AND "
-- @
--
-- Persistent has a hack for implementing composite keys (see
-- 'ECompositeKey' doc for more details), so we're forced to use
-- a hack here as well.  We deconstruct 'ERaw' values based on
-- two rules:
--
--   - If it is a single placeholder, then it's assumed to be
--   coming from a 'PersistList' and thus its components are
--   separated so that they may be applied to a composite key.
--
--   - If it is not a single placeholder, then it's assumed to be
--   a foreign (composite or not) key, so we enforce that it has
--   no placeholders and split it on the commas.
unsafeSqlBinOpComposite :: TLB.Builder -> TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOpComposite :: Builder
-> Builder
-> SqlExpr (Value a)
-> SqlExpr (Value b)
-> SqlExpr (Value c)
unsafeSqlBinOpComposite Builder
op Builder
sep SqlExpr (Value a)
a SqlExpr (Value b)
b
    | SqlExpr (Value a) -> Bool
forall x. SqlExpr (Value x) -> Bool
isCompositeKey SqlExpr (Value a)
a Bool -> Bool -> Bool
|| SqlExpr (Value b) -> Bool
forall x. SqlExpr (Value x) -> Bool
isCompositeKey SqlExpr (Value b)
b = NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value c)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Parens ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value c))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value c)
forall a b. (a -> b) -> a -> b
$ (IdentInfo -> ([Builder], [PersistValue]))
-> (IdentInfo -> ([Builder], [PersistValue]))
-> IdentInfo
-> (Builder, [PersistValue])
compose (SqlExpr (Value a) -> IdentInfo -> ([Builder], [PersistValue])
forall x.
SqlExpr (Value x) -> IdentInfo -> ([Builder], [PersistValue])
listify SqlExpr (Value a)
a) (SqlExpr (Value b) -> IdentInfo -> ([Builder], [PersistValue])
forall x.
SqlExpr (Value x) -> IdentInfo -> ([Builder], [PersistValue])
listify SqlExpr (Value b)
b)
    | Bool
otherwise = Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp Builder
op SqlExpr (Value a)
a SqlExpr (Value b)
b
  where
    isCompositeKey :: SqlExpr (Value x) -> Bool
    isCompositeKey :: SqlExpr (Value x) -> Bool
isCompositeKey (ECompositeKey IdentInfo -> [Builder]
_) = Bool
True
    isCompositeKey SqlExpr (Value x)
_ = Bool
False

    listify :: SqlExpr (Value x) -> IdentInfo -> ([TLB.Builder], [PersistValue])
    listify :: SqlExpr (Value x) -> IdentInfo -> ([Builder], [PersistValue])
listify (ECompositeKey IdentInfo -> [Builder]
f)      = ([Builder] -> [PersistValue] -> ([Builder], [PersistValue]))
-> [PersistValue] -> [Builder] -> ([Builder], [PersistValue])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [] ([Builder] -> ([Builder], [PersistValue]))
-> (IdentInfo -> [Builder])
-> IdentInfo
-> ([Builder], [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> [Builder]
f
    listify (ERaw NeedParens
_ IdentInfo -> (Builder, [PersistValue])
f)             = (Builder, [PersistValue]) -> ([Builder], [PersistValue])
deconstruct ((Builder, [PersistValue]) -> ([Builder], [PersistValue]))
-> (IdentInfo -> (Builder, [PersistValue]))
-> IdentInfo
-> ([Builder], [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> (Builder, [PersistValue])
f
    listify (EAliasedValue Ident
i SqlExpr (Value a)
_)    = (Builder, [PersistValue]) -> ([Builder], [PersistValue])
deconstruct ((Builder, [PersistValue]) -> ([Builder], [PersistValue]))
-> (IdentInfo -> (Builder, [PersistValue]))
-> IdentInfo
-> ([Builder], [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i)
    listify (EValueReference Ident
i IdentInfo -> Ident
i') = (Builder, [PersistValue]) -> ([Builder], [PersistValue])
deconstruct ((Builder, [PersistValue]) -> ([Builder], [PersistValue]))
-> (IdentInfo -> (Builder, [PersistValue]))
-> IdentInfo
-> ([Builder], [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i')

    deconstruct :: (TLB.Builder, [PersistValue]) -> ([TLB.Builder], [PersistValue])
    deconstruct :: (Builder, [PersistValue]) -> ([Builder], [PersistValue])
deconstruct (Builder
"?", [PersistList [PersistValue]
vals]) = (Int -> Builder -> [Builder]
forall a. Int -> a -> [a]
replicate ([PersistValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PersistValue]
vals) Builder
"?", [PersistValue]
vals)
    deconstruct (Builder
b', []) = (Text -> Builder
TLB.fromLazyText (Text -> Builder) -> [Text] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> [Text]
TL.splitOn Text
"," (Builder -> Text
TLB.toLazyText Builder
b'), [])
    deconstruct (Builder, [PersistValue])
_ = EsqueletoError -> ([Builder], [PersistValue])
forall a e. Exception e => e -> a
throw (SqlBinOpCompositeError -> EsqueletoError
SqlBinOpCompositeErr SqlBinOpCompositeError
DeconstructionError)

    compose :: (IdentInfo -> ([Builder], [PersistValue]))
-> (IdentInfo -> ([Builder], [PersistValue]))
-> IdentInfo
-> (Builder, [PersistValue])
compose IdentInfo -> ([Builder], [PersistValue])
f1 IdentInfo -> ([Builder], [PersistValue])
f2 IdentInfo
info
        | Bool -> Bool
not ([PersistValue] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PersistValue]
v1 Bool -> Bool -> Bool
|| [PersistValue] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PersistValue]
v2) = EsqueletoError -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (SqlBinOpCompositeError -> EsqueletoError
SqlBinOpCompositeErr SqlBinOpCompositeError
NullPlaceholdersError)
        | [Builder] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Builder]
b1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Builder] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Builder]
b2   = EsqueletoError -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (SqlBinOpCompositeError -> EsqueletoError
SqlBinOpCompositeErr SqlBinOpCompositeError
MismatchingLengthsError)
        | Bool
otherwise                = (Builder
bc, [PersistValue]
vc)
      where
        ([Builder]
b1, [PersistValue]
v1) = IdentInfo -> ([Builder], [PersistValue])
f1 IdentInfo
info
        ([Builder]
b2, [PersistValue]
v2) = IdentInfo -> ([Builder], [PersistValue])
f2 IdentInfo
info
        bc :: Builder
bc = Builder -> [Builder] -> Builder
intersperseB Builder
sep [Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
op Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
y | (Builder
x, Builder
y) <- [Builder] -> [Builder] -> [(Builder, Builder)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Builder]
b1 [Builder]
b2]
        vc :: [PersistValue]
vc = [PersistValue]
v1 [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. Semigroup a => a -> a -> a
<> [PersistValue]
v2

-- | (Internal) A raw SQL value.  The same warning from
-- 'unsafeSqlBinOp' applies to this function as well.
unsafeSqlValue :: TLB.Builder -> SqlExpr (Value a)
unsafeSqlValue :: Builder -> SqlExpr (Value a)
unsafeSqlValue Builder
v = NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a b. (a -> b) -> a -> b
$ (Builder, [PersistValue]) -> IdentInfo -> (Builder, [PersistValue])
forall a b. a -> b -> a
const (Builder
v, [PersistValue]
forall a. Monoid a => a
mempty)
{-# INLINE unsafeSqlValue #-}

valueToFunctionArg :: IdentInfo -> SqlExpr (Value a) -> (TLB.Builder, [PersistValue])
valueToFunctionArg :: IdentInfo -> SqlExpr (Value a) -> (Builder, [PersistValue])
valueToFunctionArg IdentInfo
info SqlExpr (Value a)
v =
    case SqlExpr (Value a)
v of
        ERaw NeedParens
_ IdentInfo -> (Builder, [PersistValue])
f             -> IdentInfo -> (Builder, [PersistValue])
f IdentInfo
info
        EAliasedValue Ident
i SqlExpr (Value a)
_    -> Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i IdentInfo
info
        EValueReference Ident
i IdentInfo -> Ident
i' -> Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i' IdentInfo
info
        ECompositeKey IdentInfo -> [Builder]
_      -> EsqueletoError -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
SqlFunctionError)

-- | (Internal) A raw SQL function.  Once again, the same warning
-- from 'unsafeSqlBinOp' applies to this function as well.
unsafeSqlFunction
    :: UnsafeSqlFunctionArgument a
    => TLB.Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction :: Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
name a
arg =
    NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value b)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value b))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value b)
forall a b. (a -> b) -> a -> b
$ \IdentInfo
info ->
        let (Builder
argsTLB, [PersistValue]
argsVals) =
              [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas' ([(Builder, [PersistValue])] -> (Builder, [PersistValue]))
-> [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ (SqlExpr (Value ()) -> (Builder, [PersistValue]))
-> [SqlExpr (Value ())] -> [(Builder, [PersistValue])]
forall a b. (a -> b) -> [a] -> [b]
map (IdentInfo -> SqlExpr (Value ()) -> (Builder, [PersistValue])
forall a.
IdentInfo -> SqlExpr (Value a) -> (Builder, [PersistValue])
valueToFunctionArg IdentInfo
info) ([SqlExpr (Value ())] -> [(Builder, [PersistValue])])
-> [SqlExpr (Value ())] -> [(Builder, [PersistValue])]
forall a b. (a -> b) -> a -> b
$ a -> [SqlExpr (Value ())]
forall a. UnsafeSqlFunctionArgument a => a -> [SqlExpr (Value ())]
toArgList a
arg
        in
            (Builder
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens Builder
argsTLB, [PersistValue]
argsVals)

-- | (Internal) An unsafe SQL function to extract a subfield from a compound
-- field, e.g. datetime. See 'unsafeSqlBinOp' for warnings.
--
-- Since: 1.3.6.
unsafeSqlExtractSubField
    :: UnsafeSqlFunctionArgument a
    => TLB.Builder -> a -> SqlExpr (Value b)
unsafeSqlExtractSubField :: Builder -> a -> SqlExpr (Value b)
unsafeSqlExtractSubField Builder
subField a
arg =
    NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value b)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value b))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value b)
forall a b. (a -> b) -> a -> b
$ \IdentInfo
info ->
        let (Builder
argsTLB, [PersistValue]
argsVals) =
                [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas' ([(Builder, [PersistValue])] -> (Builder, [PersistValue]))
-> [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ (SqlExpr (Value ()) -> (Builder, [PersistValue]))
-> [SqlExpr (Value ())] -> [(Builder, [PersistValue])]
forall a b. (a -> b) -> [a] -> [b]
map (IdentInfo -> SqlExpr (Value ()) -> (Builder, [PersistValue])
forall a.
IdentInfo -> SqlExpr (Value a) -> (Builder, [PersistValue])
valueToFunctionArg IdentInfo
info) ([SqlExpr (Value ())] -> [(Builder, [PersistValue])])
-> [SqlExpr (Value ())] -> [(Builder, [PersistValue])]
forall a b. (a -> b) -> a -> b
$ a -> [SqlExpr (Value ())]
forall a. UnsafeSqlFunctionArgument a => a -> [SqlExpr (Value ())]
toArgList a
arg
        in
            (Builder
"EXTRACT" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens (Builder
subField Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" FROM " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
argsTLB), [PersistValue]
argsVals)

-- | (Internal) A raw SQL function. Preserves parentheses around arguments.
-- See 'unsafeSqlBinOp' for warnings.
unsafeSqlFunctionParens
    :: UnsafeSqlFunctionArgument a
    => TLB.Builder -> a -> SqlExpr (Value b)
unsafeSqlFunctionParens :: Builder -> a -> SqlExpr (Value b)
unsafeSqlFunctionParens Builder
name a
arg =
    NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value b)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value b))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value b)
forall a b. (a -> b) -> a -> b
$ \IdentInfo
info ->
        let valueToFunctionArgParens :: SqlExpr (Value ()) -> (Builder, [PersistValue])
valueToFunctionArgParens SqlExpr (Value ())
v =
                case SqlExpr (Value ())
v of
                    ERaw NeedParens
p IdentInfo -> (Builder, [PersistValue])
f             -> (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (NeedParens -> Builder -> Builder
parensM NeedParens
p) (IdentInfo -> (Builder, [PersistValue])
f IdentInfo
info)
                    EAliasedValue Ident
i SqlExpr (Value a)
_    -> Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i IdentInfo
info
                    EValueReference Ident
i IdentInfo -> Ident
i' -> Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i' IdentInfo
info
                    ECompositeKey IdentInfo -> [Builder]
_      -> EsqueletoError -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
SqlFunctionError)
            (Builder
argsTLB, [PersistValue]
argsVals) =
                [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas' ([(Builder, [PersistValue])] -> (Builder, [PersistValue]))
-> [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ (SqlExpr (Value ()) -> (Builder, [PersistValue]))
-> [SqlExpr (Value ())] -> [(Builder, [PersistValue])]
forall a b. (a -> b) -> [a] -> [b]
map SqlExpr (Value ()) -> (Builder, [PersistValue])
valueToFunctionArgParens ([SqlExpr (Value ())] -> [(Builder, [PersistValue])])
-> [SqlExpr (Value ())] -> [(Builder, [PersistValue])]
forall a b. (a -> b) -> a -> b
$ a -> [SqlExpr (Value ())]
forall a. UnsafeSqlFunctionArgument a => a -> [SqlExpr (Value ())]
toArgList a
arg
        in
            (Builder
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens Builder
argsTLB, [PersistValue]
argsVals)

-- | (Internal) An explicit SQL type cast using CAST(value as type).
-- See 'unsafeSqlBinOp' for warnings.
unsafeSqlCastAs :: T.Text -> SqlExpr (Value a) -> SqlExpr (Value b)
unsafeSqlCastAs :: Text -> SqlExpr (Value a) -> SqlExpr (Value b)
unsafeSqlCastAs Text
t SqlExpr (Value a)
v = NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value b)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never (((Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (\Builder
value -> Builder
"CAST" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens (Builder
value Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" AS " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromText Text
t))) ((Builder, [PersistValue]) -> (Builder, [PersistValue]))
-> (IdentInfo -> (Builder, [PersistValue]))
-> IdentInfo
-> (Builder, [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> (Builder, [PersistValue])
valueToText)
  where
    valueToText :: IdentInfo -> (Builder, [PersistValue])
valueToText IdentInfo
info =
        case SqlExpr (Value a)
v of
            (ERaw NeedParens
p IdentInfo -> (Builder, [PersistValue])
f) ->
              let (Builder
b, [PersistValue]
vals) = IdentInfo -> (Builder, [PersistValue])
f IdentInfo
info
              in (NeedParens -> Builder -> Builder
parensM NeedParens
p Builder
b, [PersistValue]
vals)
            EAliasedValue Ident
i SqlExpr (Value a)
_ -> Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i IdentInfo
info
            EValueReference Ident
i IdentInfo -> Ident
i' -> Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i' IdentInfo
info
            ECompositeKey IdentInfo -> [Builder]
_ -> EsqueletoError -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
SqlCastAsError)

-- | (Internal) This class allows 'unsafeSqlFunction' to work with different
-- numbers of arguments; specifically it allows providing arguments to a sql
-- function via an n-tuple of @SqlExpr (Value _)@ values, which are not all
-- necessarily required to be the same type. There are instances for up to
-- 10-tuples, but for sql functions which take more than 10 arguments, you can
-- also nest tuples, as e.g. @toArgList ((a,b),(c,d))@ is the same as
-- @toArgList (a,b,c,d)@.
class UnsafeSqlFunctionArgument a where
    toArgList :: a -> [SqlExpr (Value ())]

-- | Useful for 0-argument functions, like @now@ in Postgresql.
--
-- @since 3.2.1
instance UnsafeSqlFunctionArgument () where
    toArgList :: () -> [SqlExpr (Value ())]
toArgList ()
_ = []

instance (a ~ Value b) => UnsafeSqlFunctionArgument (SqlExpr a) where
    toArgList :: SqlExpr a -> [SqlExpr (Value ())]
toArgList = (SqlExpr (Value ()) -> [SqlExpr (Value ())] -> [SqlExpr (Value ())]
forall a. a -> [a] -> [a]
:[]) (SqlExpr (Value ()) -> [SqlExpr (Value ())])
-> (SqlExpr (Value b) -> SqlExpr (Value ()))
-> SqlExpr (Value b)
-> [SqlExpr (Value ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlExpr (Value b) -> SqlExpr (Value ())
forall a b. SqlExpr (Value a) -> SqlExpr (Value b)
veryUnsafeCoerceSqlExprValue

instance UnsafeSqlFunctionArgument a => UnsafeSqlFunctionArgument [a] where
  toArgList :: [a] -> [SqlExpr (Value ())]
toArgList = (a -> [SqlExpr (Value ())]) -> [a] -> [SqlExpr (Value ())]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> [SqlExpr (Value ())]
forall a. UnsafeSqlFunctionArgument a => a -> [SqlExpr (Value ())]
toArgList

instance
    (UnsafeSqlFunctionArgument a , UnsafeSqlFunctionArgument b)
  =>
    UnsafeSqlFunctionArgument (a, b)
  where
    toArgList :: (a, b) -> [SqlExpr (Value ())]
toArgList (a
a, b
b) = a -> [SqlExpr (Value ())]
forall a. UnsafeSqlFunctionArgument a => a -> [SqlExpr (Value ())]
toArgList a
a [SqlExpr (Value ())]
-> [SqlExpr (Value ())] -> [SqlExpr (Value ())]
forall a. [a] -> [a] -> [a]
++ b -> [SqlExpr (Value ())]
forall a. UnsafeSqlFunctionArgument a => a -> [SqlExpr (Value ())]
toArgList b
b

instance
    ( UnsafeSqlFunctionArgument a
    , UnsafeSqlFunctionArgument b
    , UnsafeSqlFunctionArgument c
    )
  =>
    UnsafeSqlFunctionArgument (a, b, c)
  where
    toArgList :: (a, b, c) -> [SqlExpr (Value ())]
toArgList = ((a, b), c) -> [SqlExpr (Value ())]
forall a. UnsafeSqlFunctionArgument a => a -> [SqlExpr (Value ())]
toArgList (((a, b), c) -> [SqlExpr (Value ())])
-> ((a, b, c) -> ((a, b), c)) -> (a, b, c) -> [SqlExpr (Value ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c) -> ((a, b), c)
forall a b c. (a, b, c) -> ((a, b), c)
from3

instance
    ( UnsafeSqlFunctionArgument a
    , UnsafeSqlFunctionArgument b
    , UnsafeSqlFunctionArgument c
    , UnsafeSqlFunctionArgument d
    )
  =>
    UnsafeSqlFunctionArgument (a, b, c, d)
  where
    toArgList :: (a, b, c, d) -> [SqlExpr (Value ())]
toArgList = ((a, b), (c, d)) -> [SqlExpr (Value ())]
forall a. UnsafeSqlFunctionArgument a => a -> [SqlExpr (Value ())]
toArgList (((a, b), (c, d)) -> [SqlExpr (Value ())])
-> ((a, b, c, d) -> ((a, b), (c, d)))
-> (a, b, c, d)
-> [SqlExpr (Value ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d) -> ((a, b), (c, d))
forall a b c d. (a, b, c, d) -> ((a, b), (c, d))
from4

-- | @since 3.2.3
instance
    ( UnsafeSqlFunctionArgument a
    , UnsafeSqlFunctionArgument b
    , UnsafeSqlFunctionArgument c
    , UnsafeSqlFunctionArgument d
    , UnsafeSqlFunctionArgument e
    )
  =>
    UnsafeSqlFunctionArgument (a, b, c, d, e)
  where
    toArgList :: (a, b, c, d, e) -> [SqlExpr (Value ())]
toArgList = ((a, b), (c, d), e) -> [SqlExpr (Value ())]
forall a. UnsafeSqlFunctionArgument a => a -> [SqlExpr (Value ())]
toArgList (((a, b), (c, d), e) -> [SqlExpr (Value ())])
-> ((a, b, c, d, e) -> ((a, b), (c, d), e))
-> (a, b, c, d, e)
-> [SqlExpr (Value ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e) -> ((a, b), (c, d), e)
forall a b c d e. (a, b, c, d, e) -> ((a, b), (c, d), e)
from5

-- | @since 3.2.3
instance
    ( UnsafeSqlFunctionArgument a
    , UnsafeSqlFunctionArgument b
    , UnsafeSqlFunctionArgument c
    , UnsafeSqlFunctionArgument d
    , UnsafeSqlFunctionArgument e
    , UnsafeSqlFunctionArgument f
    )
  =>
    UnsafeSqlFunctionArgument (a, b, c, d, e, f)
  where
    toArgList :: (a, b, c, d, e, f) -> [SqlExpr (Value ())]
toArgList = ((a, b), (c, d), (e, f)) -> [SqlExpr (Value ())]
forall a. UnsafeSqlFunctionArgument a => a -> [SqlExpr (Value ())]
toArgList (((a, b), (c, d), (e, f)) -> [SqlExpr (Value ())])
-> ((a, b, c, d, e, f) -> ((a, b), (c, d), (e, f)))
-> (a, b, c, d, e, f)
-> [SqlExpr (Value ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f) -> ((a, b), (c, d), (e, f))
forall a b c d e f. (a, b, c, d, e, f) -> ((a, b), (c, d), (e, f))
from6

-- | @since 3.2.3
instance ( UnsafeSqlFunctionArgument a
         , UnsafeSqlFunctionArgument b
         , UnsafeSqlFunctionArgument c
         , UnsafeSqlFunctionArgument d
         , UnsafeSqlFunctionArgument e
         , UnsafeSqlFunctionArgument f
         , UnsafeSqlFunctionArgument g
         ) => UnsafeSqlFunctionArgument (a, b, c, d, e, f, g) where
  toArgList :: (a, b, c, d, e, f, g) -> [SqlExpr (Value ())]
toArgList = ((a, b), (c, d), (e, f), g) -> [SqlExpr (Value ())]
forall a. UnsafeSqlFunctionArgument a => a -> [SqlExpr (Value ())]
toArgList (((a, b), (c, d), (e, f), g) -> [SqlExpr (Value ())])
-> ((a, b, c, d, e, f, g) -> ((a, b), (c, d), (e, f), g))
-> (a, b, c, d, e, f, g)
-> [SqlExpr (Value ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g) -> ((a, b), (c, d), (e, f), g)
forall a b c d e f g.
(a, b, c, d, e, f, g) -> ((a, b), (c, d), (e, f), g)
from7
-- | @since 3.2.3
instance ( UnsafeSqlFunctionArgument a
         , UnsafeSqlFunctionArgument b
         , UnsafeSqlFunctionArgument c
         , UnsafeSqlFunctionArgument d
         , UnsafeSqlFunctionArgument e
         , UnsafeSqlFunctionArgument f
         , UnsafeSqlFunctionArgument g
         , UnsafeSqlFunctionArgument h
         ) => UnsafeSqlFunctionArgument (a, b, c, d, e, f, g, h) where
  toArgList :: (a, b, c, d, e, f, g, h) -> [SqlExpr (Value ())]
toArgList = ((a, b), (c, d), (e, f), (g, h)) -> [SqlExpr (Value ())]
forall a. UnsafeSqlFunctionArgument a => a -> [SqlExpr (Value ())]
toArgList (((a, b), (c, d), (e, f), (g, h)) -> [SqlExpr (Value ())])
-> ((a, b, c, d, e, f, g, h) -> ((a, b), (c, d), (e, f), (g, h)))
-> (a, b, c, d, e, f, g, h)
-> [SqlExpr (Value ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g, h) -> ((a, b), (c, d), (e, f), (g, h))
forall a b c d e f g h.
(a, b, c, d, e, f, g, h) -> ((a, b), (c, d), (e, f), (g, h))
from8
-- | @since 3.2.3
instance ( UnsafeSqlFunctionArgument a
         , UnsafeSqlFunctionArgument b
         , UnsafeSqlFunctionArgument c
         , UnsafeSqlFunctionArgument d
         , UnsafeSqlFunctionArgument e
         , UnsafeSqlFunctionArgument f
         , UnsafeSqlFunctionArgument g
         , UnsafeSqlFunctionArgument h
         , UnsafeSqlFunctionArgument i
         ) => UnsafeSqlFunctionArgument (a, b, c, d, e, f, g, h, i) where
  toArgList :: (a, b, c, d, e, f, g, h, i) -> [SqlExpr (Value ())]
toArgList = ((a, b), (c, d), (e, f), (g, h), i) -> [SqlExpr (Value ())]
forall a. UnsafeSqlFunctionArgument a => a -> [SqlExpr (Value ())]
toArgList (((a, b), (c, d), (e, f), (g, h), i) -> [SqlExpr (Value ())])
-> ((a, b, c, d, e, f, g, h, i)
    -> ((a, b), (c, d), (e, f), (g, h), i))
-> (a, b, c, d, e, f, g, h, i)
-> [SqlExpr (Value ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g, h, i) -> ((a, b), (c, d), (e, f), (g, h), i)
forall a b c d e f g h i.
(a, b, c, d, e, f, g, h, i) -> ((a, b), (c, d), (e, f), (g, h), i)
from9
-- | @since 3.2.3
instance ( UnsafeSqlFunctionArgument a
         , UnsafeSqlFunctionArgument b
         , UnsafeSqlFunctionArgument c
         , UnsafeSqlFunctionArgument d
         , UnsafeSqlFunctionArgument e
         , UnsafeSqlFunctionArgument f
         , UnsafeSqlFunctionArgument g
         , UnsafeSqlFunctionArgument h
         , UnsafeSqlFunctionArgument i
         , UnsafeSqlFunctionArgument j
         ) => UnsafeSqlFunctionArgument (a, b, c, d, e, f, g, h, i, j) where
  toArgList :: (a, b, c, d, e, f, g, h, i, j) -> [SqlExpr (Value ())]
toArgList = ((a, b), (c, d), (e, f), (g, h), (i, j)) -> [SqlExpr (Value ())]
forall a. UnsafeSqlFunctionArgument a => a -> [SqlExpr (Value ())]
toArgList (((a, b), (c, d), (e, f), (g, h), (i, j)) -> [SqlExpr (Value ())])
-> ((a, b, c, d, e, f, g, h, i, j)
    -> ((a, b), (c, d), (e, f), (g, h), (i, j)))
-> (a, b, c, d, e, f, g, h, i, j)
-> [SqlExpr (Value ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g, h, i, j)
-> ((a, b), (c, d), (e, f), (g, h), (i, j))
forall a b c d e f g h i j.
(a, b, c, d, e, f, g, h, i, j)
-> ((a, b), (c, d), (e, f), (g, h), (i, j))
from10


-- | (Internal) Coerce a value's type from 'SqlExpr (Value a)' to
-- 'SqlExpr (Value b)'.  You should /not/ use this function
-- unless you know what you're doing!
veryUnsafeCoerceSqlExprValue :: SqlExpr (Value a) -> SqlExpr (Value b)
veryUnsafeCoerceSqlExprValue :: SqlExpr (Value a) -> SqlExpr (Value b)
veryUnsafeCoerceSqlExprValue (ERaw NeedParens
p IdentInfo -> (Builder, [PersistValue])
f)             = NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value b)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
p IdentInfo -> (Builder, [PersistValue])
f
veryUnsafeCoerceSqlExprValue (ECompositeKey IdentInfo -> [Builder]
f)      = (IdentInfo -> [Builder]) -> SqlExpr (Value b)
forall a. (IdentInfo -> [Builder]) -> SqlExpr (Value a)
ECompositeKey IdentInfo -> [Builder]
f
veryUnsafeCoerceSqlExprValue (EAliasedValue Ident
i SqlExpr (Value a)
v)    = Ident -> SqlExpr (Value b) -> SqlExpr (Value b)
forall a. Ident -> SqlExpr (Value a) -> SqlExpr (Value a)
EAliasedValue Ident
i (SqlExpr (Value a) -> SqlExpr (Value b)
forall a b. SqlExpr (Value a) -> SqlExpr (Value b)
veryUnsafeCoerceSqlExprValue SqlExpr (Value a)
v)
veryUnsafeCoerceSqlExprValue (EValueReference Ident
i IdentInfo -> Ident
i') = Ident -> (IdentInfo -> Ident) -> SqlExpr (Value b)
forall a. Ident -> (IdentInfo -> Ident) -> SqlExpr (Value a)
EValueReference Ident
i IdentInfo -> Ident
i'


-- | (Internal) Coerce a value's type from 'SqlExpr (ValueList
-- a)' to 'SqlExpr (Value a)'.  Does not work with empty lists.
veryUnsafeCoerceSqlExprValueList :: SqlExpr (ValueList a) -> SqlExpr (Value a)
veryUnsafeCoerceSqlExprValueList :: SqlExpr (ValueList a) -> SqlExpr (Value a)
veryUnsafeCoerceSqlExprValueList (EList SqlExpr (Value a)
v)  = SqlExpr (Value a)
SqlExpr (Value a)
v
veryUnsafeCoerceSqlExprValueList SqlExpr (ValueList a)
EEmptyList = EsqueletoError -> SqlExpr (Value a)
forall a e. Exception e => e -> a
throw (UnexpectedCaseError -> EsqueletoError
UnexpectedCaseErr UnexpectedCaseError
EmptySqlExprValueList)


----------------------------------------------------------------------

-- | (Internal) Execute an @esqueleto@ @SELECT@ 'SqlQuery' inside
-- @persistent@'s 'SqlPersistT' monad.
rawSelectSource
    ::
    ( SqlSelect a r
    , MonadIO m1
    , MonadIO m2
    )
    => Mode
    -> SqlQuery a
    -> SqlReadT m1 (Acquire (C.ConduitT () r m2 ()))
rawSelectSource :: Mode -> SqlQuery a -> SqlReadT m1 (Acquire (ConduitT () r m2 ()))
rawSelectSource Mode
mode SqlQuery a
query = do
    SqlBackend
conn <- backend -> SqlBackend
forall sup sub. BackendCompatible sup sub => sub -> sup
projectBackend (backend -> SqlBackend)
-> ReaderT backend m1 backend -> ReaderT backend m1 SqlBackend
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT backend m1 backend
forall (m :: * -> *) r. Monad m => ReaderT r m r
R.ask
    let SqlBackend
_ = SqlBackend
conn :: SqlBackend
    Acquire (ConduitM () [PersistValue] m2 ())
res <- (backend -> SqlBackend)
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () [PersistValue] m2 ()))
-> ReaderT backend m1 (Acquire (ConduitM () [PersistValue] m2 ()))
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
R.withReaderT (SqlBackend -> backend -> SqlBackend
forall a b. a -> b -> a
const SqlBackend
conn) (SqlBackend
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () [PersistValue] m2 ()))
run SqlBackend
conn)
    Acquire (ConduitT () r m2 ())
-> ReaderT backend m1 (Acquire (ConduitT () r m2 ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Acquire (ConduitT () r m2 ())
 -> ReaderT backend m1 (Acquire (ConduitT () r m2 ())))
-> Acquire (ConduitT () r m2 ())
-> ReaderT backend m1 (Acquire (ConduitT () r m2 ()))
forall a b. (a -> b) -> a -> b
$ (ConduitM () [PersistValue] m2 ()
-> ConduitM [PersistValue] r m2 () -> ConduitT () r m2 ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ConduitM [PersistValue] r m2 ()
massage) (ConduitM () [PersistValue] m2 () -> ConduitT () r m2 ())
-> Acquire (ConduitM () [PersistValue] m2 ())
-> Acquire (ConduitT () r m2 ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Acquire (ConduitM () [PersistValue] m2 ())
res
  where
    run :: SqlBackend
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () [PersistValue] m2 ()))
run SqlBackend
conn =
        (Text
 -> [PersistValue]
 -> ReaderT
      SqlBackend m1 (Acquire (ConduitM () [PersistValue] m2 ())))
-> (Text, [PersistValue])
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () [PersistValue] m2 ()))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text
-> [PersistValue]
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () [PersistValue] m2 ()))
forall (m1 :: * -> *) (m2 :: * -> *) env.
(MonadIO m1, MonadIO m2, BackendCompatible SqlBackend env) =>
Text
-> [PersistValue]
-> ReaderT env m1 (Acquire (ConduitM () [PersistValue] m2 ()))
rawQueryRes ((Text, [PersistValue])
 -> ReaderT
      SqlBackend m1 (Acquire (ConduitM () [PersistValue] m2 ())))
-> (Text, [PersistValue])
-> ReaderT
     SqlBackend m1 (Acquire (ConduitM () [PersistValue] m2 ()))
forall a b. (a -> b) -> a -> b
$
        (Builder -> Text)
-> (Builder, [PersistValue]) -> (Text, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Builder -> Text
builderToText ((Builder, [PersistValue]) -> (Text, [PersistValue]))
-> (Builder, [PersistValue]) -> (Text, [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
mode (SqlBackend
conn, IdentState
initialIdentState) SqlQuery a
query

    massage :: ConduitM [PersistValue] r m2 ()
massage = do
        Maybe [PersistValue]
mrow <- ConduitT [PersistValue] r m2 (Maybe [PersistValue])
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
C.await
        case [PersistValue] -> Either Text r
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow ([PersistValue] -> Either Text r)
-> Maybe [PersistValue] -> Maybe (Either Text r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [PersistValue]
mrow of
            Just (Right r
r)  -> r -> ConduitM [PersistValue] r m2 ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield r
r ConduitM [PersistValue] r m2 ()
-> ConduitM [PersistValue] r m2 ()
-> ConduitM [PersistValue] r m2 ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitM [PersistValue] r m2 ()
massage
            Just (Left Text
err) -> IO () -> ConduitM [PersistValue] r m2 ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitM [PersistValue] r m2 ())
-> IO () -> ConduitM [PersistValue] r m2 ()
forall a b. (a -> b) -> a -> b
$ PersistException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (PersistException -> IO ()) -> PersistException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> PersistException
PersistMarshalError Text
err
            Maybe (Either Text r)
Nothing         -> () -> ConduitM [PersistValue] r m2 ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s
-- 'SqlPersistT' monad and return a 'C.Source' of rows.
selectSource
    ::
    ( SqlSelect a r
    , BackendCompatible SqlBackend backend
    , IsPersistBackend backend
    , PersistQueryRead backend
    , PersistStoreRead backend, PersistUniqueRead backend
    , MonadResource m
    )
    => SqlQuery a
    -> C.ConduitT () r (R.ReaderT backend m) ()
selectSource :: SqlQuery a -> ConduitT () r (ReaderT backend m) ()
selectSource SqlQuery a
query = do
    Acquire (ConduitT () r (ReaderT backend m) ())
res <- ReaderT backend m (Acquire (ConduitT () r (ReaderT backend m) ()))
-> ConduitT
     ()
     r
     (ReaderT backend m)
     (Acquire (ConduitT () r (ReaderT backend m) ()))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT backend m (Acquire (ConduitT () r (ReaderT backend m) ()))
 -> ConduitT
      ()
      r
      (ReaderT backend m)
      (Acquire (ConduitT () r (ReaderT backend m) ())))
-> ReaderT
     backend m (Acquire (ConduitT () r (ReaderT backend m) ()))
-> ConduitT
     ()
     r
     (ReaderT backend m)
     (Acquire (ConduitT () r (ReaderT backend m) ()))
forall a b. (a -> b) -> a -> b
$ Mode
-> SqlQuery a
-> SqlReadT m (Acquire (ConduitT () r (ReaderT backend m) ()))
forall a r (m1 :: * -> *) (m2 :: * -> *).
(SqlSelect a r, MonadIO m1, MonadIO m2) =>
Mode -> SqlQuery a -> SqlReadT m1 (Acquire (ConduitT () r m2 ()))
rawSelectSource Mode
SELECT SqlQuery a
query
    (ReleaseKey
key, ConduitT () r (ReaderT backend m) ()
src) <- ReaderT
  backend m (ReleaseKey, ConduitT () r (ReaderT backend m) ())
-> ConduitT
     ()
     r
     (ReaderT backend m)
     (ReleaseKey, ConduitT () r (ReaderT backend m) ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT
   backend m (ReleaseKey, ConduitT () r (ReaderT backend m) ())
 -> ConduitT
      ()
      r
      (ReaderT backend m)
      (ReleaseKey, ConduitT () r (ReaderT backend m) ()))
-> ReaderT
     backend m (ReleaseKey, ConduitT () r (ReaderT backend m) ())
-> ConduitT
     ()
     r
     (ReaderT backend m)
     (ReleaseKey, ConduitT () r (ReaderT backend m) ())
forall a b. (a -> b) -> a -> b
$ Acquire (ConduitT () r (ReaderT backend m) ())
-> ReaderT
     backend m (ReleaseKey, ConduitT () r (ReaderT backend m) ())
forall (m :: * -> *) a.
MonadResource m =>
Acquire a -> m (ReleaseKey, a)
allocateAcquire Acquire (ConduitT () r (ReaderT backend m) ())
res
    ConduitT () r (ReaderT backend m) ()
src
    ReaderT backend m () -> ConduitT () r (ReaderT backend m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT backend m () -> ConduitT () r (ReaderT backend m) ())
-> ReaderT backend m () -> ConduitT () r (ReaderT backend m) ()
forall a b. (a -> b) -> a -> b
$ ReleaseKey -> ReaderT backend m ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
release ReleaseKey
key

-- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s
-- 'SqlPersistT' monad and return a list of rows.
--
-- We've seen that 'from' has some magic about which kinds of
-- things you may bring into scope.  This 'select' function also
-- has some magic for which kinds of things you may bring back to
-- Haskell-land by using @SqlQuery@'s @return@:
--
--  * You may return a @SqlExpr ('Entity' v)@ for an entity @v@
--  (i.e., like the @*@ in SQL), which is then returned to
--  Haskell-land as just @Entity v@.
--
--  * You may return a @SqlExpr (Maybe (Entity v))@ for an entity
--  @v@ that may be @NULL@, which is then returned to
--  Haskell-land as @Maybe (Entity v)@.  Used for @OUTER JOIN@s.
--
--  * You may return a @SqlExpr ('Value' t)@ for a value @t@
--  (i.e., a single column), where @t@ is any instance of
--  'PersistField', which is then returned to Haskell-land as
--  @Value t@.  You may use @Value@ to return projections of an
--  @Entity@ (see @('^.')@ and @('?.')@) or to return any other
--  value calculated on the query (e.g., 'countRows' or
--  'subSelect').
--
-- The @SqlSelect a r@ class has functional dependencies that
-- allow type information to flow both from @a@ to @r@ and
-- vice-versa.  This means that you'll almost never have to give
-- any type signatures for @esqueleto@ queries.  For example, the
-- query @'select' $ from $ \\p -> return p@ alone is ambiguous, but
-- in the context of
--
-- @
-- do ps <- 'select' $
--          'from' $ \\p ->
--          return p
--    liftIO $ mapM_ (putStrLn . personName . entityVal) ps
-- @
--
-- we are able to infer from that single @personName . entityVal@
-- function composition that the @p@ inside the query is of type
-- @SqlExpr (Entity Person)@.
select
    ::
    ( SqlSelect a r
    , MonadIO m
    )
    => SqlQuery a
    -> SqlReadT m [r]
select :: SqlQuery a -> SqlReadT m [r]
select SqlQuery a
query = do
    Acquire (ConduitT () r (ReaderT backend IO) ())
res <- Mode
-> SqlQuery a
-> SqlReadT m (Acquire (ConduitT () r (ReaderT backend IO) ()))
forall a r (m1 :: * -> *) (m2 :: * -> *).
(SqlSelect a r, MonadIO m1, MonadIO m2) =>
Mode -> SqlQuery a -> SqlReadT m1 (Acquire (ConduitT () r m2 ()))
rawSelectSource Mode
SELECT SqlQuery a
query
    backend
conn <- ReaderT backend m backend
forall (m :: * -> *) r. Monad m => ReaderT r m r
R.ask
    IO [r] -> ReaderT backend m [r]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [r] -> ReaderT backend m [r])
-> IO [r] -> ReaderT backend m [r]
forall a b. (a -> b) -> a -> b
$ Acquire (ConduitT () r (ReaderT backend IO) ())
-> (ConduitT () r (ReaderT backend IO) () -> IO [r]) -> IO [r]
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
with Acquire (ConduitT () r (ReaderT backend IO) ())
res ((ConduitT () r (ReaderT backend IO) () -> IO [r]) -> IO [r])
-> (ConduitT () r (ReaderT backend IO) () -> IO [r]) -> IO [r]
forall a b. (a -> b) -> a -> b
$ (ReaderT backend IO [r] -> backend -> IO [r])
-> backend -> ReaderT backend IO [r] -> IO [r]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT backend IO [r] -> backend -> IO [r]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT backend
conn (ReaderT backend IO [r] -> IO [r])
-> (ConduitT () r (ReaderT backend IO) ()
    -> ReaderT backend IO [r])
-> ConduitT () r (ReaderT backend IO) ()
-> IO [r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () r (ReaderT backend IO) () -> ReaderT backend IO [r]
forall (m :: * -> *) r backend.
Monad m =>
ConduitT () r (ReaderT backend m) () -> ReaderT backend m [r]
runSource

-- | (Internal) Run a 'C.Source' of rows.
runSource
    :: Monad m
    => C.ConduitT () r (R.ReaderT backend m) ()
    -> R.ReaderT backend m [r]
runSource :: ConduitT () r (ReaderT backend m) () -> ReaderT backend m [r]
runSource ConduitT () r (ReaderT backend m) ()
src = ConduitT () Void (ReaderT backend m) [r] -> ReaderT backend m [r]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
C.runConduit (ConduitT () Void (ReaderT backend m) [r] -> ReaderT backend m [r])
-> ConduitT () Void (ReaderT backend m) [r]
-> ReaderT backend m [r]
forall a b. (a -> b) -> a -> b
$ ConduitT () r (ReaderT backend m) ()
src ConduitT () r (ReaderT backend m) ()
-> ConduitM r Void (ReaderT backend m) [r]
-> ConduitT () Void (ReaderT backend m) [r]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ConduitM r Void (ReaderT backend m) [r]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume

-- | (Internal) Execute an @esqueleto@ statement inside
-- @persistent@'s 'SqlPersistT' monad.
rawEsqueleto
    :: (MonadIO m, SqlSelect a r, BackendCompatible SqlBackend backend)
    => Mode
    -> SqlQuery a
    -> R.ReaderT backend m Int64
rawEsqueleto :: Mode -> SqlQuery a -> ReaderT backend m Int64
rawEsqueleto Mode
mode SqlQuery a
query = do
    backend
conn <- ReaderT backend m backend
forall (m :: * -> *) r. Monad m => ReaderT r m r
R.ask
    (Text -> [PersistValue] -> ReaderT backend m Int64)
-> (Text, [PersistValue]) -> ReaderT backend m Int64
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> [PersistValue] -> ReaderT backend m Int64
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m Int64
rawExecuteCount ((Text, [PersistValue]) -> ReaderT backend m Int64)
-> (Text, [PersistValue]) -> ReaderT backend m Int64
forall a b. (a -> b) -> a -> b
$
        (Builder -> Text)
-> (Builder, [PersistValue]) -> (Text, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Builder -> Text
builderToText ((Builder, [PersistValue]) -> (Text, [PersistValue]))
-> (Builder, [PersistValue]) -> (Text, [PersistValue])
forall a b. (a -> b) -> a -> b
$
        Mode
-> (backend, IdentState) -> SqlQuery a -> (Builder, [PersistValue])
forall a r backend.
(SqlSelect a r, BackendCompatible SqlBackend backend) =>
Mode
-> (backend, IdentState) -> SqlQuery a -> (Builder, [PersistValue])
toRawSql Mode
mode (backend
conn, IdentState
initialIdentState) SqlQuery a
query

-- | Execute an @esqueleto@ @DELETE@ query inside @persistent@'s
-- 'SqlPersistT' monad.  Note that currently there are no type
-- checks for statements that should not appear on a @DELETE@
-- query.
--
-- Example of usage:
--
-- @
-- 'delete' $
-- 'from' $ \\appointment ->
-- 'where_' (appointment '^.' AppointmentDate '<.' 'val' now)
-- @
--
-- Unlike 'select', there is a useful way of using 'delete' that
-- will lead to type ambiguities.  If you want to delete all rows
-- (i.e., no 'where_' clause), you'll have to use a type signature:
--
-- @
-- 'delete' $
-- 'from' $ \\(appointment :: 'SqlExpr' ('Entity' Appointment)) ->
-- return ()
-- @
delete
    :: (MonadIO m)
    => SqlQuery ()
    -> SqlWriteT m ()
delete :: SqlQuery () -> SqlWriteT m ()
delete = ReaderT backend m Int64 -> ReaderT backend m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT backend m Int64 -> ReaderT backend m ())
-> (SqlQuery () -> ReaderT backend m Int64)
-> SqlQuery ()
-> ReaderT backend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlQuery () -> ReaderT backend m Int64
forall (m :: * -> *). MonadIO m => SqlQuery () -> SqlWriteT m Int64
deleteCount

-- | Same as 'delete', but returns the number of rows affected.
deleteCount
    :: (MonadIO m)
    => SqlQuery ()
    -> SqlWriteT m Int64
deleteCount :: SqlQuery () -> SqlWriteT m Int64
deleteCount = Mode -> SqlQuery () -> ReaderT backend m Int64
forall (m :: * -> *) a r backend.
(MonadIO m, SqlSelect a r, BackendCompatible SqlBackend backend) =>
Mode -> SqlQuery a -> ReaderT backend m Int64
rawEsqueleto Mode
DELETE

-- | Execute an @esqueleto@ @UPDATE@ query inside @persistent@'s
-- 'SqlPersistT' monad.  Note that currently there are no type
-- checks for statements that should not appear on a @UPDATE@
-- query.
--
-- Example of usage:
--
-- @
-- 'update' $ \\p -> do
-- 'set' p [ PersonAge '=.' 'just' ('val' thisYear) -. p '^.' PersonBorn ]
-- 'where_' $ isNothing (p '^.' PersonAge)
-- @
update
    ::
    ( MonadIO m, PersistEntity val
    , BackendCompatible SqlBackend (PersistEntityBackend val)
    )
    => (SqlExpr (Entity val) -> SqlQuery ())
    -> SqlWriteT m ()
update :: (SqlExpr (Entity val) -> SqlQuery ()) -> SqlWriteT m ()
update = ReaderT backend m Int64 -> ReaderT backend m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT backend m Int64 -> ReaderT backend m ())
-> ((SqlExpr (Entity val) -> SqlQuery ())
    -> ReaderT backend m Int64)
-> (SqlExpr (Entity val) -> SqlQuery ())
-> ReaderT backend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SqlExpr (Entity val) -> SqlQuery ()) -> ReaderT backend m Int64
forall (m :: * -> *) val.
(MonadIO m, PersistEntity val,
 BackendCompatible SqlBackend (PersistEntityBackend val)) =>
(SqlExpr (Entity val) -> SqlQuery ()) -> SqlWriteT m Int64
updateCount

-- | Same as 'update', but returns the number of rows affected.
updateCount
    ::
    ( MonadIO m, PersistEntity val
    , BackendCompatible SqlBackend (PersistEntityBackend val)
    )
    => (SqlExpr (Entity val) -> SqlQuery ())
    -> SqlWriteT m Int64
updateCount :: (SqlExpr (Entity val) -> SqlQuery ()) -> SqlWriteT m Int64
updateCount = Mode -> SqlQuery () -> ReaderT backend m Int64
forall (m :: * -> *) a r backend.
(MonadIO m, SqlSelect a r, BackendCompatible SqlBackend backend) =>
Mode -> SqlQuery a -> ReaderT backend m Int64
rawEsqueleto Mode
UPDATE (SqlQuery () -> ReaderT backend m Int64)
-> ((SqlExpr (Entity val) -> SqlQuery ()) -> SqlQuery ())
-> (SqlExpr (Entity val) -> SqlQuery ())
-> ReaderT backend m Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SqlExpr (Entity val) -> SqlQuery ()) -> SqlQuery ()
forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
from

builderToText :: TLB.Builder -> T.Text
builderToText :: Builder -> Text
builderToText = Text -> Text
TL.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder -> Text
TLB.toLazyTextWith Int
defaultChunkSize
  where
    defaultChunkSize :: Int
defaultChunkSize = Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32

-- | (Internal) Pretty prints a 'SqlQuery' into a SQL query.
--
-- Note: if you're curious about the SQL query being generated by
-- @esqueleto@, instead of manually using this function (which is
-- possible but tedious), see the 'renderQueryToText' function (along with
-- 'renderQuerySelect', 'renderQueryUpdate', etc).
toRawSql
  :: (SqlSelect a r, BackendCompatible SqlBackend backend)
  => Mode -> (backend, IdentState) -> SqlQuery a -> (TLB.Builder, [PersistValue])
toRawSql :: Mode
-> (backend, IdentState) -> SqlQuery a -> (Builder, [PersistValue])
toRawSql Mode
mode (backend
conn, IdentState
firstIdentState) SqlQuery a
query =
    let ((a
ret, SideData
sd), IdentState
finalIdentState) =
            (State IdentState (a, SideData)
 -> IdentState -> ((a, SideData), IdentState))
-> IdentState
-> State IdentState (a, SideData)
-> ((a, SideData), IdentState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State IdentState (a, SideData)
-> IdentState -> ((a, SideData), IdentState)
forall s a. State s a -> s -> (a, s)
S.runState IdentState
firstIdentState (State IdentState (a, SideData) -> ((a, SideData), IdentState))
-> State IdentState (a, SideData) -> ((a, SideData), IdentState)
forall a b. (a -> b) -> a -> b
$
            WriterT SideData (State IdentState) a
-> State IdentState (a, SideData)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
W.runWriterT (WriterT SideData (State IdentState) a
 -> State IdentState (a, SideData))
-> WriterT SideData (State IdentState) a
-> 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
        SideData DistinctClause
distinctClause
                 [FromClause]
fromClauses
                 [SetClause]
setClauses
                 WhereClause
whereClauses
                 GroupByClause
groupByClause
                 WhereClause
havingClause
                 [SqlExpr OrderBy]
orderByClauses
                 LimitClause
limitClause
                 LockingClause
lockingClause
                 [CommonTableExpressionClause]
cteClause = SideData
sd
        -- Pass the finalIdentState (containing all identifiers
        -- that were used) to the subsequent calls.  This ensures
        -- that no name clashes will occur on subqueries that may
        -- appear on the expressions below.
        info :: IdentInfo
info = (backend -> SqlBackend
forall sup sub. BackendCompatible sup sub => sub -> sup
projectBackend backend
conn, IdentState
finalIdentState)
    in [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [a] -> a
mconcat
        [ IdentInfo
-> [CommonTableExpressionClause] -> (Builder, [PersistValue])
makeCte        IdentInfo
info [CommonTableExpressionClause]
cteClause
        , IdentInfo -> Mode -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> Mode -> a -> (Builder, [PersistValue])
makeInsertInto IdentInfo
info Mode
mode a
ret
        , IdentInfo
-> Mode -> DistinctClause -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo
-> Mode -> DistinctClause -> a -> (Builder, [PersistValue])
makeSelect     IdentInfo
info Mode
mode DistinctClause
distinctClause a
ret
        , IdentInfo -> Mode -> [FromClause] -> (Builder, [PersistValue])
makeFrom       IdentInfo
info Mode
mode [FromClause]
fromClauses
        , IdentInfo -> [SetClause] -> (Builder, [PersistValue])
makeSet        IdentInfo
info [SetClause]
setClauses
        , IdentInfo -> WhereClause -> (Builder, [PersistValue])
makeWhere      IdentInfo
info WhereClause
whereClauses
        , IdentInfo -> GroupByClause -> (Builder, [PersistValue])
makeGroupBy    IdentInfo
info GroupByClause
groupByClause
        , IdentInfo -> WhereClause -> (Builder, [PersistValue])
makeHaving     IdentInfo
info WhereClause
havingClause
        , IdentInfo -> [SqlExpr OrderBy] -> (Builder, [PersistValue])
makeOrderBy    IdentInfo
info [SqlExpr OrderBy]
orderByClauses
        , IdentInfo
-> LimitClause -> [SqlExpr OrderBy] -> (Builder, [PersistValue])
makeLimit      IdentInfo
info LimitClause
limitClause [SqlExpr OrderBy]
orderByClauses
        , LockingClause -> (Builder, [PersistValue])
makeLocking         LockingClause
lockingClause
        ]

-- | Renders a 'SqlQuery' into a 'Text' value along with the list of
-- 'PersistValue's that would be supplied to the database for @?@ placeholders.
--
-- You must ensure that the 'Mode' you pass to this function corresponds with
-- the actual 'SqlQuery'. If you pass a query that uses incompatible features
-- (like an @INSERT@ statement with a @SELECT@ mode) then you'll get a weird
-- result.
--
-- @since 3.1.1
renderQueryToText
    :: (SqlSelect a r, BackendCompatible SqlBackend backend, Monad m)
    => Mode
    -- ^ Whether to render as an 'SELECT', 'DELETE', etc.
    -> SqlQuery a
    -- ^ The SQL query you want to render.
    -> R.ReaderT backend m (T.Text, [PersistValue])
renderQueryToText :: Mode -> SqlQuery a -> ReaderT backend m (Text, [PersistValue])
renderQueryToText Mode
mode SqlQuery a
query = do
    backend
backend <- ReaderT backend m backend
forall (m :: * -> *) r. Monad m => ReaderT r m r
R.ask
    let (Builder
builder, [PersistValue]
pvals) = Mode
-> (backend, IdentState) -> SqlQuery a -> (Builder, [PersistValue])
forall a r backend.
(SqlSelect a r, BackendCompatible SqlBackend backend) =>
Mode
-> (backend, IdentState) -> SqlQuery a -> (Builder, [PersistValue])
toRawSql Mode
mode (backend
backend, IdentState
initialIdentState) SqlQuery a
query
    (Text, [PersistValue]) -> ReaderT backend m (Text, [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> Text
builderToText Builder
builder, [PersistValue]
pvals)

-- | Renders a 'SqlQuery' into a 'Text' value along with the list of
-- 'PersistValue's that would be supplied to the database for @?@ placeholders.
--
-- @since 3.1.1
renderQuerySelect
    :: (SqlSelect a r, BackendCompatible SqlBackend backend, Monad m)
    => SqlQuery a
    -- ^ The SQL query you want to render.
    -> R.ReaderT backend m (T.Text, [PersistValue])
renderQuerySelect :: SqlQuery a -> ReaderT backend m (Text, [PersistValue])
renderQuerySelect = Mode -> SqlQuery a -> ReaderT backend m (Text, [PersistValue])
forall a r backend (m :: * -> *).
(SqlSelect a r, BackendCompatible SqlBackend backend, Monad m) =>
Mode -> SqlQuery a -> ReaderT backend m (Text, [PersistValue])
renderQueryToText Mode
SELECT

-- | Renders a 'SqlQuery' into a 'Text' value along with the list of
-- 'PersistValue's that would be supplied to the database for @?@ placeholders.
--
-- @since 3.1.1
renderQueryDelete
    :: (SqlSelect a r, BackendCompatible SqlBackend backend, Monad m)
    => SqlQuery a
    -- ^ The SQL query you want to render.
    -> R.ReaderT backend m (T.Text, [PersistValue])
renderQueryDelete :: SqlQuery a -> ReaderT backend m (Text, [PersistValue])
renderQueryDelete = Mode -> SqlQuery a -> ReaderT backend m (Text, [PersistValue])
forall a r backend (m :: * -> *).
(SqlSelect a r, BackendCompatible SqlBackend backend, Monad m) =>
Mode -> SqlQuery a -> ReaderT backend m (Text, [PersistValue])
renderQueryToText Mode
DELETE

-- | Renders a 'SqlQuery' into a 'Text' value along with the list of
-- 'PersistValue's that would be supplied to the database for @?@ placeholders.
--
-- @since 3.1.1
renderQueryUpdate
    :: (SqlSelect a r, BackendCompatible SqlBackend backend, Monad m)
    => SqlQuery a
    -- ^ The SQL query you want to render.
    -> R.ReaderT backend m (T.Text, [PersistValue])
renderQueryUpdate :: SqlQuery a -> ReaderT backend m (Text, [PersistValue])
renderQueryUpdate = Mode -> SqlQuery a -> ReaderT backend m (Text, [PersistValue])
forall a r backend (m :: * -> *).
(SqlSelect a r, BackendCompatible SqlBackend backend, Monad m) =>
Mode -> SqlQuery a -> ReaderT backend m (Text, [PersistValue])
renderQueryToText Mode
UPDATE

-- | Renders a 'SqlQuery' into a 'Text' value along with the list of
-- 'PersistValue's that would be supplied to the database for @?@ placeholders.
--
-- @since 3.1.1
renderQueryInsertInto
    :: (SqlSelect a r, BackendCompatible SqlBackend backend, Monad m)
    => SqlQuery a
    -- ^ The SQL query you want to render.
    -> R.ReaderT backend m (T.Text, [PersistValue])
renderQueryInsertInto :: SqlQuery a -> ReaderT backend m (Text, [PersistValue])
renderQueryInsertInto = Mode -> SqlQuery a -> ReaderT backend m (Text, [PersistValue])
forall a r backend (m :: * -> *).
(SqlSelect a r, BackendCompatible SqlBackend backend, Monad m) =>
Mode -> SqlQuery a -> ReaderT backend m (Text, [PersistValue])
renderQueryToText Mode
INSERT_INTO

-- | (Internal) Mode of query being converted by 'toRawSql'.
data Mode
    = SELECT
    | DELETE
    | UPDATE
    | INSERT_INTO

uncommas :: [TLB.Builder] -> TLB.Builder
uncommas :: [Builder] -> Builder
uncommas = Builder -> [Builder] -> Builder
intersperseB Builder
", "

intersperseB :: TLB.Builder -> [TLB.Builder] -> TLB.Builder
intersperseB :: Builder -> [Builder] -> Builder
intersperseB Builder
a = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([Builder] -> [Builder]) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
a ([Builder] -> [Builder])
-> ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Bool) -> [Builder] -> [Builder]
forall a. (a -> Bool) -> [a] -> [a]
filter (Builder -> Builder -> Bool
forall a. Eq a => a -> a -> Bool
/= Builder
forall a. Monoid a => a
mempty)

uncommas' :: Monoid a => [(TLB.Builder, a)] -> (TLB.Builder, a)
uncommas' :: [(Builder, a)] -> (Builder, a)
uncommas' = ([Builder] -> Builder
uncommas ([Builder] -> Builder)
-> ([a] -> a) -> ([Builder], [a]) -> (Builder, a)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [a] -> a
forall a. Monoid a => [a] -> a
mconcat) (([Builder], [a]) -> (Builder, a))
-> ([(Builder, a)] -> ([Builder], [a]))
-> [(Builder, a)]
-> (Builder, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Builder, a)] -> ([Builder], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip

makeCte :: IdentInfo -> [CommonTableExpressionClause] -> (TLB.Builder, [PersistValue])
makeCte :: IdentInfo
-> [CommonTableExpressionClause] -> (Builder, [PersistValue])
makeCte IdentInfo
info [CommonTableExpressionClause]
cteClauses =
  let
    withCteText :: Builder
withCteText
        | Bool
hasRecursive = Builder
"WITH RECURSIVE "
        | Bool
otherwise = Builder
"WITH "
      where
        hasRecursive :: Bool
hasRecursive =
            CommonTableExpressionKind -> [CommonTableExpressionKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem CommonTableExpressionKind
RecursiveCommonTableExpression
            ([CommonTableExpressionKind] -> Bool)
-> [CommonTableExpressionKind] -> Bool
forall a b. (a -> b) -> a -> b
$ (CommonTableExpressionClause -> CommonTableExpressionKind)
-> [CommonTableExpressionClause] -> [CommonTableExpressionKind]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(CommonTableExpressionClause CommonTableExpressionKind
cteKind Ident
_ IdentInfo -> (Builder, [PersistValue])
_) -> CommonTableExpressionKind
cteKind)
            ([CommonTableExpressionClause] -> [CommonTableExpressionKind])
-> [CommonTableExpressionClause] -> [CommonTableExpressionKind]
forall a b. (a -> b) -> a -> b
$ [CommonTableExpressionClause]
cteClauses

    cteClauseToText :: CommonTableExpressionClause -> (Builder, [PersistValue])
cteClauseToText (CommonTableExpressionClause CommonTableExpressionKind
_ Ident
cteIdent IdentInfo -> (Builder, [PersistValue])
cteFn) =
        (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first
            (\Builder
tlb -> IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
cteIdent Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" AS " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens Builder
tlb)
            (IdentInfo -> (Builder, [PersistValue])
cteFn IdentInfo
info)

    cteBody :: (Builder, [PersistValue])
cteBody =
        [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [a] -> a
mconcat
        ([(Builder, [PersistValue])] -> (Builder, [PersistValue]))
-> [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ (Builder, [PersistValue])
-> [(Builder, [PersistValue])] -> [(Builder, [PersistValue])]
forall a. a -> [a] -> [a]
intersperse (Builder
",\n", [PersistValue]
forall a. Monoid a => a
mempty)
        ([(Builder, [PersistValue])] -> [(Builder, [PersistValue])])
-> [(Builder, [PersistValue])] -> [(Builder, [PersistValue])]
forall a b. (a -> b) -> a -> b
$ (CommonTableExpressionClause -> (Builder, [PersistValue]))
-> [CommonTableExpressionClause] -> [(Builder, [PersistValue])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CommonTableExpressionClause -> (Builder, [PersistValue])
cteClauseToText [CommonTableExpressionClause]
cteClauses
  in
    case [CommonTableExpressionClause]
cteClauses of
        [] ->
            (Builder, [PersistValue])
forall a. Monoid a => a
mempty
        [CommonTableExpressionClause]
_ ->
          (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (\Builder
tlb -> Builder
withCteText Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
tlb Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") (Builder, [PersistValue])
cteBody

makeInsertInto :: SqlSelect a r => IdentInfo -> Mode -> a -> (TLB.Builder, [PersistValue])
makeInsertInto :: IdentInfo -> Mode -> a -> (Builder, [PersistValue])
makeInsertInto IdentInfo
info Mode
INSERT_INTO a
ret = IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlInsertInto IdentInfo
info a
ret
makeInsertInto IdentInfo
_    Mode
_           a
_   = (Builder, [PersistValue])
forall a. Monoid a => a
mempty

makeSelect :: SqlSelect a r => IdentInfo -> Mode -> DistinctClause -> a -> (TLB.Builder, [PersistValue])
makeSelect :: IdentInfo
-> Mode -> DistinctClause -> a -> (Builder, [PersistValue])
makeSelect IdentInfo
info Mode
mode_ DistinctClause
distinctClause a
ret = Mode -> (Builder, [PersistValue])
process Mode
mode_
  where
    process :: Mode -> (Builder, [PersistValue])
process Mode
mode =
        case Mode
mode of
            Mode
SELECT      -> (Builder, [PersistValue]) -> (Builder, [PersistValue])
withCols (Builder, [PersistValue])
selectKind
            Mode
DELETE      -> Builder -> (Builder, [PersistValue])
forall a a. a -> (a, [a])
plain Builder
"DELETE "
            Mode
UPDATE      -> Builder -> (Builder, [PersistValue])
forall a a. a -> (a, [a])
plain Builder
"UPDATE "
            Mode
INSERT_INTO -> Mode -> (Builder, [PersistValue])
process Mode
SELECT
    selectKind :: (Builder, [PersistValue])
selectKind =
        case DistinctClause
distinctClause of
            DistinctClause
DistinctAll      -> (Builder
"SELECT ", [])
            DistinctClause
DistinctStandard -> (Builder
"SELECT DISTINCT ", [])
            DistinctOn [SqlExpr DistinctOn]
exprs ->
                (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Builder
"SELECT DISTINCT ON (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
") "))
                ((Builder, [PersistValue]) -> (Builder, [PersistValue]))
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas' (SqlExpr DistinctOn -> (Builder, [PersistValue])
processExpr (SqlExpr DistinctOn -> (Builder, [PersistValue]))
-> [SqlExpr DistinctOn] -> [(Builder, [PersistValue])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SqlExpr DistinctOn]
exprs)
      where
        processExpr :: SqlExpr DistinctOn -> (Builder, [PersistValue])
processExpr (EDistinctOn SqlExpr (Value a)
f) = IdentInfo -> SqlExpr (Value a) -> (Builder, [PersistValue])
forall a.
IdentInfo -> SqlExpr (Value a) -> (Builder, [PersistValue])
materializeExpr IdentInfo
info SqlExpr (Value a)
f
    withCols :: (Builder, [PersistValue]) -> (Builder, [PersistValue])
withCols (Builder, [PersistValue])
v = (Builder, [PersistValue])
v (Builder, [PersistValue])
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall a. Semigroup a => a -> a -> a
<> IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
info a
ret
    plain :: a -> (a, [a])
plain    a
v = (a
v, [])

makeFrom
    :: IdentInfo
    -> Mode
    -> [FromClause]
    -> (TLB.Builder, [PersistValue])
makeFrom :: IdentInfo -> Mode -> [FromClause] -> (Builder, [PersistValue])
makeFrom IdentInfo
_    Mode
_    [] = (Builder, [PersistValue])
forall a. Monoid a => a
mempty
makeFrom IdentInfo
info Mode
mode [FromClause]
fs = (Builder, [PersistValue])
ret
  where
    ret :: (Builder, [PersistValue])
ret =
        case SqlBackend
-> [FromClause] -> Either (SqlExpr (Value Bool)) [FromClause]
collectOnClauses (IdentInfo -> SqlBackend
forall a b. (a, b) -> a
fst IdentInfo
info) [FromClause]
fs of
            Left SqlExpr (Value Bool)
expr -> OnClauseWithoutMatchingJoinException -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (OnClauseWithoutMatchingJoinException -> (Builder, [PersistValue]))
-> OnClauseWithoutMatchingJoinException
-> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ SqlExpr (Value Bool) -> OnClauseWithoutMatchingJoinException
mkExc SqlExpr (Value Bool)
expr
            Right [FromClause]
fs' -> (Builder, [PersistValue]) -> (Builder, [PersistValue])
keyword ((Builder, [PersistValue]) -> (Builder, [PersistValue]))
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas' ((FromClause -> (Builder, [PersistValue]))
-> [FromClause] -> [(Builder, [PersistValue])]
forall a b. (a -> b) -> [a] -> [b]
map (NeedParens -> FromClause -> (Builder, [PersistValue])
mk NeedParens
Never) [FromClause]
fs')
    keyword :: (Builder, [PersistValue]) -> (Builder, [PersistValue])
keyword =
        case Mode
mode of
            Mode
UPDATE -> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall a. a -> a
id
            Mode
_      -> (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Builder
"\nFROM " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>)

    mk :: NeedParens -> FromClause -> (Builder, [PersistValue])
mk NeedParens
_     (FromStart Ident
i EntityDef
def) = Ident -> EntityDef -> (Builder, [PersistValue])
base Ident
i EntityDef
def
    mk NeedParens
paren (FromJoin FromClause
lhs JoinKind
kind FromClause
rhs Maybe (SqlExpr (Value Bool))
monClause) =
        (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (NeedParens -> Builder -> Builder
parensM NeedParens
paren) ((Builder, [PersistValue]) -> (Builder, [PersistValue]))
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$
        [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [a] -> a
mconcat [ NeedParens -> FromClause -> (Builder, [PersistValue])
mk NeedParens
Never FromClause
lhs
                , (JoinKind -> Builder
forall p. IsString p => JoinKind -> p
fromKind JoinKind
kind, [PersistValue]
forall a. Monoid a => a
mempty)
                , NeedParens -> FromClause -> (Builder, [PersistValue])
mk NeedParens
Parens FromClause
rhs
                , (Builder, [PersistValue])
-> (SqlExpr (Value Bool) -> (Builder, [PersistValue]))
-> Maybe (SqlExpr (Value Bool))
-> (Builder, [PersistValue])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Builder, [PersistValue])
forall a. Monoid a => a
mempty SqlExpr (Value Bool) -> (Builder, [PersistValue])
makeOnClause Maybe (SqlExpr (Value Bool))
monClause
                ]
    mk NeedParens
_ (OnClause SqlExpr (Value Bool)
_) = EsqueletoError -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (UnexpectedCaseError -> EsqueletoError
UnexpectedCaseErr UnexpectedCaseError
MakeFromError)
    mk NeedParens
_ (FromQuery Ident
ident IdentInfo -> (Builder, [PersistValue])
f SubQueryType
subqueryType) =
        let (Builder
queryText, [PersistValue]
queryVals) = IdentInfo -> (Builder, [PersistValue])
f IdentInfo
info
            lateralKeyword :: Builder
lateralKeyword =
              case SubQueryType
subqueryType of
                SubQueryType
NormalSubQuery -> Builder
""
                SubQueryType
LateralSubQuery -> Builder
"LATERAL "
        in
            ( Builder
lateralKeyword Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Builder -> Builder
parens Builder
queryText) Builder -> Builder -> Builder
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]
queryVals
            )
    mk NeedParens
_ (FromIdent Ident
ident) =
        (IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
ident, [PersistValue]
forall a. Monoid a => a
mempty)

    base :: Ident -> EntityDef -> (Builder, [PersistValue])
base ident :: Ident
ident@(I Text
identText) EntityDef
def =
        let db :: DBName
db@(DBName Text
dbText) = EntityDef -> DBName
entityDB EntityDef
def
        in ( IdentInfo -> DBName -> Builder
fromDBName IdentInfo
info DBName
db Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                 if Text
dbText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
identText
                 then Builder
forall a. Monoid a => a
mempty
                 else 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
           )

    fromKind :: JoinKind -> p
fromKind JoinKind
InnerJoinKind      = p
" INNER JOIN "
    fromKind JoinKind
CrossJoinKind      = p
" CROSS JOIN "
    fromKind JoinKind
LeftOuterJoinKind  = p
" LEFT OUTER JOIN "
    fromKind JoinKind
RightOuterJoinKind = p
" RIGHT OUTER JOIN "
    fromKind JoinKind
FullOuterJoinKind  = p
" FULL OUTER JOIN "

    makeOnClause :: SqlExpr (Value Bool) -> (Builder, [PersistValue])
makeOnClause (ERaw NeedParens
_ IdentInfo -> (Builder, [PersistValue])
f)        = (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Builder
" ON " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (IdentInfo -> (Builder, [PersistValue])
f IdentInfo
info)
    makeOnClause (ECompositeKey IdentInfo -> [Builder]
_) = EsqueletoError -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
MakeOnClauseError)
    makeOnClause (EAliasedValue Ident
_ SqlExpr (Value a)
_) = EsqueletoError -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
AliasedValueErr CompositeKeyError
MakeOnClauseError)
    makeOnClause (EValueReference Ident
_ IdentInfo -> Ident
_) = EsqueletoError -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
AliasedValueErr CompositeKeyError
MakeOnClauseError)

    mkExc :: SqlExpr (Value Bool) -> OnClauseWithoutMatchingJoinException
    mkExc :: SqlExpr (Value Bool) -> OnClauseWithoutMatchingJoinException
mkExc (ERaw NeedParens
_ IdentInfo -> (Builder, [PersistValue])
f) =
        [Char] -> OnClauseWithoutMatchingJoinException
OnClauseWithoutMatchingJoinException ([Char] -> OnClauseWithoutMatchingJoinException)
-> [Char] -> OnClauseWithoutMatchingJoinException
forall a b. (a -> b) -> a -> b
$
            Text -> [Char]
TL.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Builder -> Text
TLB.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ (Builder, [PersistValue]) -> Builder
forall a b. (a, b) -> a
fst (IdentInfo -> (Builder, [PersistValue])
f IdentInfo
info)
    mkExc (ECompositeKey IdentInfo -> [Builder]
_) = EsqueletoError -> OnClauseWithoutMatchingJoinException
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
MakeExcError)
    mkExc (EAliasedValue Ident
_ SqlExpr (Value a)
_) = EsqueletoError -> OnClauseWithoutMatchingJoinException
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
AliasedValueErr CompositeKeyError
MakeExcError)
    mkExc (EValueReference Ident
_ IdentInfo -> Ident
_) = EsqueletoError -> OnClauseWithoutMatchingJoinException
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
AliasedValueErr CompositeKeyError
MakeExcError)

makeSet :: IdentInfo -> [SetClause] -> (TLB.Builder, [PersistValue])
makeSet :: IdentInfo -> [SetClause] -> (Builder, [PersistValue])
makeSet IdentInfo
_    [] = (Builder, [PersistValue])
forall a. Monoid a => a
mempty
makeSet IdentInfo
info [SetClause]
os = (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Builder
"\nSET " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) ((Builder, [PersistValue]) -> (Builder, [PersistValue]))
-> ([(Builder, [PersistValue])] -> (Builder, [PersistValue]))
-> [(Builder, [PersistValue])]
-> (Builder, [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas' ([(Builder, [PersistValue])] -> (Builder, [PersistValue]))
-> [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ (SetClause -> [(Builder, [PersistValue])])
-> [SetClause] -> [(Builder, [PersistValue])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SetClause -> [(Builder, [PersistValue])]
mk [SetClause]
os
  where
    mk :: SetClause -> [(Builder, [PersistValue])]
mk (SetClause (ERaw NeedParens
_ IdentInfo -> (Builder, [PersistValue])
f))             = [IdentInfo -> (Builder, [PersistValue])
f IdentInfo
info]
    mk (SetClause (ECompositeKey IdentInfo -> [Builder]
_))      = EsqueletoError -> [(Builder, [PersistValue])]
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
MakeSetError) -- FIXME
    mk (SetClause (EAliasedValue Ident
i SqlExpr (Value a)
_))    = [Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i IdentInfo
info]
    mk (SetClause (EValueReference Ident
i IdentInfo -> Ident
i')) = [Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i' IdentInfo
info]

makeWhere :: IdentInfo -> WhereClause -> (TLB.Builder, [PersistValue])
makeWhere :: IdentInfo -> WhereClause -> (Builder, [PersistValue])
makeWhere IdentInfo
_    WhereClause
NoWhere                       = (Builder, [PersistValue])
forall a. Monoid a => a
mempty
makeWhere IdentInfo
info (Where SqlExpr (Value Bool)
v) = (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Builder
"\nWHERE " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) ((Builder, [PersistValue]) -> (Builder, [PersistValue]))
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ IdentInfo -> (Builder, [PersistValue])
x IdentInfo
info
  where
    x :: IdentInfo -> (Builder, [PersistValue])
x =
        case SqlExpr (Value Bool)
v of
            ERaw NeedParens
_ IdentInfo -> (Builder, [PersistValue])
f             -> IdentInfo -> (Builder, [PersistValue])
f
            EAliasedValue Ident
i SqlExpr (Value a)
_    -> Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i
            EValueReference Ident
i IdentInfo -> Ident
i' -> Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i'
            ECompositeKey IdentInfo -> [Builder]
_      -> EsqueletoError -> IdentInfo -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
MakeWhereError)

makeGroupBy :: IdentInfo -> GroupByClause -> (TLB.Builder, [PersistValue])
makeGroupBy :: IdentInfo -> GroupByClause -> (Builder, [PersistValue])
makeGroupBy IdentInfo
_ (GroupBy []) = (Builder
forall a. Monoid a => a
mempty, [])
makeGroupBy IdentInfo
info (GroupBy [SomeValue]
fields) = (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Builder
"\nGROUP BY " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder, [PersistValue])
build
  where
    build :: (TLB.Builder, [PersistValue])
    build :: (Builder, [PersistValue])
build = [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas' ([(Builder, [PersistValue])] -> (Builder, [PersistValue]))
-> [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ (SomeValue -> (Builder, [PersistValue]))
-> [SomeValue] -> [(Builder, [PersistValue])]
forall a b. (a -> b) -> [a] -> [b]
map SomeValue -> (Builder, [PersistValue])
match [SomeValue]
fields

    match :: SomeValue -> (TLB.Builder, [PersistValue])
    match :: SomeValue -> (Builder, [PersistValue])
match (SomeValue (ERaw NeedParens
_ IdentInfo -> (Builder, [PersistValue])
f)) = IdentInfo -> (Builder, [PersistValue])
f IdentInfo
info
    match (SomeValue (ECompositeKey IdentInfo -> [Builder]
f)) = ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ IdentInfo -> [Builder]
f IdentInfo
info, [PersistValue]
forall a. Monoid a => a
mempty)
    match (SomeValue (EAliasedValue Ident
i SqlExpr (Value a)
_)) = Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i IdentInfo
info
    match (SomeValue (EValueReference Ident
i IdentInfo -> Ident
i')) = Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i' IdentInfo
info

makeHaving :: IdentInfo -> WhereClause -> (TLB.Builder, [PersistValue])
makeHaving :: IdentInfo -> WhereClause -> (Builder, [PersistValue])
makeHaving IdentInfo
_    WhereClause
NoWhere   = (Builder, [PersistValue])
forall a. Monoid a => a
mempty
makeHaving IdentInfo
info (Where SqlExpr (Value Bool)
v) = (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Builder
"\nHAVING " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) ((Builder, [PersistValue]) -> (Builder, [PersistValue]))
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ IdentInfo -> (Builder, [PersistValue])
x IdentInfo
info
  where
    x :: IdentInfo -> (Builder, [PersistValue])
x =
        case SqlExpr (Value Bool)
v of
            ERaw NeedParens
_ IdentInfo -> (Builder, [PersistValue])
f             -> IdentInfo -> (Builder, [PersistValue])
f
            EAliasedValue Ident
i SqlExpr (Value a)
_    -> Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i
            EValueReference Ident
i IdentInfo -> Ident
i' -> Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i'
            ECompositeKey IdentInfo -> [Builder]
_      -> EsqueletoError -> IdentInfo -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
MakeHavingError)

-- makeHaving, makeWhere and makeOrderBy
makeOrderByNoNewline
    :: IdentInfo -> [OrderByClause] -> (TLB.Builder, [PersistValue])
makeOrderByNoNewline :: IdentInfo -> [SqlExpr OrderBy] -> (Builder, [PersistValue])
makeOrderByNoNewline IdentInfo
_    [] = (Builder, [PersistValue])
forall a. Monoid a => a
mempty
makeOrderByNoNewline IdentInfo
info [SqlExpr OrderBy]
os = (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Builder
"ORDER BY " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) ((Builder, [PersistValue]) -> (Builder, [PersistValue]))
-> ([(Builder, [PersistValue])] -> (Builder, [PersistValue]))
-> [(Builder, [PersistValue])]
-> (Builder, [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas' ([(Builder, [PersistValue])] -> (Builder, [PersistValue]))
-> [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ (SqlExpr OrderBy -> [(Builder, [PersistValue])])
-> [SqlExpr OrderBy] -> [(Builder, [PersistValue])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SqlExpr OrderBy -> [(Builder, [PersistValue])]
mk [SqlExpr OrderBy]
os
  where
    mk :: OrderByClause -> [(TLB.Builder, [PersistValue])]
    mk :: SqlExpr OrderBy -> [(Builder, [PersistValue])]
mk (EOrderBy OrderByType
t (ECompositeKey IdentInfo -> [Builder]
f)) =
        let fs :: [Builder]
fs = IdentInfo -> [Builder]
f IdentInfo
info
            vals :: [[a]]
vals = [a] -> [[a]]
forall a. a -> [a]
repeat []
        in [Builder] -> [[PersistValue]] -> [(Builder, [PersistValue])]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Builder -> Builder) -> [Builder] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OrderByType -> Builder
forall p. IsString p => OrderByType -> p
orderByType OrderByType
t) [Builder]
fs) [[PersistValue]]
forall a. [[a]]
vals
    mk (EOrderBy OrderByType
t SqlExpr (Value a)
v) =
        let x :: IdentInfo -> (Builder, [PersistValue])
x =
                case SqlExpr (Value a)
v of
                    ERaw NeedParens
p IdentInfo -> (Builder, [PersistValue])
f -> ((Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
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]))
-> (IdentInfo -> (Builder, [PersistValue]))
-> IdentInfo
-> (Builder, [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> (Builder, [PersistValue])
f
                    EAliasedValue Ident
i SqlExpr (Value a)
_ -> Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i
                    EValueReference Ident
i IdentInfo -> Ident
i' -> Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i'
                    ECompositeKey IdentInfo -> [Builder]
_ -> IdentInfo -> (Builder, [PersistValue])
forall a. HasCallStack => a
undefined -- defined above
        in [ (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> OrderByType -> Builder
forall p. IsString p => OrderByType -> p
orderByType OrderByType
t) ((Builder, [PersistValue]) -> (Builder, [PersistValue]))
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ IdentInfo -> (Builder, [PersistValue])
x IdentInfo
info ]
    mk SqlExpr OrderBy
EOrderRandom = [(Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"RANDOM()") (Builder, [PersistValue])
forall a. Monoid a => a
mempty]

    orderByType :: OrderByType -> p
orderByType OrderByType
ASC  = p
" ASC"
    orderByType OrderByType
DESC = p
" DESC"

makeOrderBy :: IdentInfo -> [OrderByClause] -> (TLB.Builder, [PersistValue])
makeOrderBy :: IdentInfo -> [SqlExpr OrderBy] -> (Builder, [PersistValue])
makeOrderBy IdentInfo
_ [] = (Builder, [PersistValue])
forall a. Monoid a => a
mempty
makeOrderBy IdentInfo
info [SqlExpr OrderBy]
is =
    let (Builder
tlb, [PersistValue]
vals) = IdentInfo -> [SqlExpr OrderBy] -> (Builder, [PersistValue])
makeOrderByNoNewline IdentInfo
info [SqlExpr OrderBy]
is
    in (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
tlb, [PersistValue]
vals)

{-# DEPRECATED EOrderRandom "Since 2.6.0: `rand` ordering function is not uniform across all databases! To avoid accidental partiality it will be removed in the next major version." #-}

makeLimit :: IdentInfo -> LimitClause -> [OrderByClause] -> (TLB.Builder, [PersistValue])
makeLimit :: IdentInfo
-> LimitClause -> [SqlExpr OrderBy] -> (Builder, [PersistValue])
makeLimit (SqlBackend
conn, IdentState
_) (Limit Maybe Int64
ml Maybe Int64
mo) [SqlExpr OrderBy]
orderByClauses =
    let limitRaw :: Text
limitRaw = SqlBackend -> (Int, Int) -> Bool -> Text -> Text
connLimitOffset SqlBackend
conn (Maybe Int64 -> Int
v Maybe Int64
ml, Maybe Int64 -> Int
v Maybe Int64
mo) Bool
hasOrderClause Text
"\n"
        hasOrderClause :: Bool
hasOrderClause = Bool -> Bool
not ([SqlExpr OrderBy] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SqlExpr OrderBy]
orderByClauses)
        v :: Maybe Int64 -> Int
v = Int -> (Int64 -> Int) -> Maybe Int64 -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    in (Text -> Builder
TLB.fromText Text
limitRaw, [PersistValue]
forall a. Monoid a => a
mempty)

makeLocking :: LockingClause -> (TLB.Builder, [PersistValue])
makeLocking :: LockingClause -> (Builder, [PersistValue])
makeLocking = (Builder -> [PersistValue] -> (Builder, [PersistValue]))
-> [PersistValue] -> Builder -> (Builder, [PersistValue])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [] (Builder -> (Builder, [PersistValue]))
-> (LockingClause -> Builder)
-> LockingClause
-> (Builder, [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> (LockingKind -> Builder) -> Maybe LockingKind -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty LockingKind -> Builder
forall p. IsString p => LockingKind -> p
toTLB (Maybe LockingKind -> Builder)
-> (LockingClause -> Maybe LockingKind) -> LockingClause -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LockingClause -> Maybe LockingKind
forall a. Last a -> Maybe a
Monoid.getLast
  where
    toTLB :: LockingKind -> p
toTLB LockingKind
ForUpdate           = p
"\nFOR UPDATE"
    toTLB LockingKind
ForUpdateSkipLocked = p
"\nFOR UPDATE SKIP LOCKED"
    toTLB LockingKind
ForShare            = p
"\nFOR SHARE"
    toTLB LockingKind
LockInShareMode     = p
"\nLOCK IN SHARE MODE"

parens :: TLB.Builder -> TLB.Builder
parens :: Builder -> Builder
parens Builder
b = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")")

aliasedValueIdentToRawSql :: Ident -> IdentInfo -> (TLB.Builder, [PersistValue])
aliasedValueIdentToRawSql :: Ident -> IdentInfo -> (Builder, [PersistValue])
aliasedValueIdentToRawSql Ident
i IdentInfo
info = (IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
i, [PersistValue]
forall a. Monoid a => a
mempty)

valueReferenceToRawSql ::  Ident -> (IdentInfo -> Ident) -> IdentInfo -> (TLB.Builder, [PersistValue])
valueReferenceToRawSql :: Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
sourceIdent IdentInfo -> Ident
columnIdentF IdentInfo
info =
    (IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
sourceIdent Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IdentInfo -> Ident -> Builder
useIdent IdentInfo
info (IdentInfo -> Ident
columnIdentF IdentInfo
info), [PersistValue]
forall a. Monoid a => a
mempty)

aliasedEntityColumnIdent :: Ident -> FieldDef -> Ident
aliasedEntityColumnIdent :: Ident -> FieldDef -> Ident
aliasedEntityColumnIdent (I Text
baseIdent) FieldDef
field =
    Text -> Ident
I (Text
baseIdent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (DBName -> Text
unDBName (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> DBName
fieldDB FieldDef
field))

aliasedColumnName :: Ident -> IdentInfo -> T.Text -> TLB.Builder
aliasedColumnName :: Ident -> IdentInfo -> Text -> Builder
aliasedColumnName (I Text
baseIdent) IdentInfo
info Text
columnName =
    IdentInfo -> Ident -> Builder
useIdent IdentInfo
info (Text -> Ident
I (Text
baseIdent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
columnName))

-- | (Internal) Class for mapping results coming from 'SqlQuery'
-- into actual results.
--
-- This looks very similar to @RawSql@, and it is!  However,
-- there are some crucial differences and ultimately they're
-- different classes.
class SqlSelect a r | a -> r, r -> a where
    -- | Creates the variable part of the @SELECT@ query and
    -- returns the list of 'PersistValue's that will be given to
    -- 'rawQuery'.
    sqlSelectCols :: IdentInfo -> a -> (TLB.Builder, [PersistValue])

    -- | Number of columns that will be consumed.
    sqlSelectColCount :: Proxy a -> Int

    -- | Transform a row of the result into the data type.
    sqlSelectProcessRow :: [PersistValue] -> Either T.Text r

    -- | Create @INSERT INTO@ clause instead.
    sqlInsertInto :: IdentInfo -> a -> (TLB.Builder, [PersistValue])
    sqlInsertInto = EsqueletoError -> IdentInfo -> a -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (UnexpectedCaseError -> EsqueletoError
UnexpectedCaseErr UnexpectedCaseError
UnsupportedSqlInsertIntoType)


-- | @INSERT INTO@ hack.
instance SqlSelect (SqlExpr InsertFinal) InsertFinal where
    sqlInsertInto :: IdentInfo -> SqlExpr InsertFinal -> (Builder, [PersistValue])
sqlInsertInto IdentInfo
info (EInsertFinal (EInsert Proxy a
p IdentInfo -> (Builder, [PersistValue])
_)) =
        let fields :: Builder
fields =
                [Builder] -> Builder
uncommas ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
                (FieldDef -> Builder) -> [FieldDef] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (IdentInfo -> DBName -> Builder
fromDBName IdentInfo
info (DBName -> Builder) -> (FieldDef -> DBName) -> FieldDef -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> DBName
fieldDB) ([FieldDef] -> [Builder]) -> [FieldDef] -> [Builder]
forall a b. (a -> b) -> a -> b
$
                EntityDef -> [FieldDef]
entityFields (EntityDef -> [FieldDef]) -> EntityDef -> [FieldDef]
forall a b. (a -> b) -> a -> b
$
                Proxy a -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef Proxy a
p
            table :: Builder
table  =
                IdentInfo -> DBName -> Builder
fromDBName IdentInfo
info (DBName -> Builder) -> (Proxy a -> DBName) -> Proxy a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> DBName
entityDB (EntityDef -> DBName)
-> (Proxy a -> EntityDef) -> Proxy a -> DBName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Proxy a -> Builder) -> Proxy a -> Builder
forall a b. (a -> b) -> a -> b
$ Proxy a
p
        in
            (Builder
"INSERT INTO " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
table Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens Builder
fields Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n", [])
    sqlSelectCols :: IdentInfo -> SqlExpr InsertFinal -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
info (EInsertFinal (EInsert Proxy a
_ IdentInfo -> (Builder, [PersistValue])
f)) = IdentInfo -> (Builder, [PersistValue])
f IdentInfo
info
    sqlSelectColCount :: Proxy (SqlExpr InsertFinal) -> Int
sqlSelectColCount   = Int -> Proxy (SqlExpr InsertFinal) -> Int
forall a b. a -> b -> a
const Int
0
    sqlSelectProcessRow :: [PersistValue] -> Either Text InsertFinal
sqlSelectProcessRow =
      Either Text InsertFinal
-> [PersistValue] -> Either Text InsertFinal
forall a b. a -> b -> a
const (InsertFinal -> Either Text InsertFinal
forall a b. b -> Either a b
Right (EsqueletoError -> InsertFinal
forall a e. Exception e => e -> a
throw (UnexpectedCaseError -> EsqueletoError
UnexpectedCaseErr UnexpectedCaseError
InsertionFinalError)))

-- | Not useful for 'select', but used for 'update' and 'delete'.
instance SqlSelect () () where
    sqlSelectCols :: IdentInfo -> () -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
_ ()
_ = (Builder
"1", [])
    sqlSelectColCount :: Proxy () -> Int
sqlSelectColCount Proxy ()
_ = Int
1
    sqlSelectProcessRow :: [PersistValue] -> Either Text ()
sqlSelectProcessRow [PersistValue]
_ = () -> Either Text ()
forall a b. b -> Either a b
Right ()

unescapedColumnNames :: EntityDef -> [DBName]
unescapedColumnNames :: EntityDef -> [DBName]
unescapedColumnNames EntityDef
ent =
    (if EntityDef -> Bool
hasCompositeKey EntityDef
ent then [DBName] -> [DBName]
forall a. a -> a
id else ( FieldDef -> DBName
fieldDB (EntityDef -> FieldDef
entityId EntityDef
ent) DBName -> [DBName] -> [DBName]
forall a. a -> [a] -> [a]
:))
    ([DBName] -> [DBName]) -> [DBName] -> [DBName]
forall a b. (a -> b) -> a -> b
$ (FieldDef -> DBName) -> [FieldDef] -> [DBName]
forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> DBName
fieldDB (EntityDef -> [FieldDef]
entityFields EntityDef
ent)

-- | You may return an 'Entity' from a 'select' query.
instance PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) where
    sqlSelectCols :: IdentInfo -> SqlExpr (Entity a) -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
info expr :: SqlExpr (Entity a)
expr@(EEntity Ident
ident) = (Builder, [PersistValue])
ret
      where
        process :: EntityDef -> Builder
process EntityDef
ed = [Builder] -> Builder
uncommas ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
                     (Text -> Builder) -> [Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map ((Builder
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
TLB.fromText) ([Text] -> [Builder]) -> [Text] -> [Builder]
forall a b. (a -> b) -> a -> b
$
                     EntityDef -> SqlBackend -> [Text]
entityColumnNames EntityDef
ed (IdentInfo -> SqlBackend
forall a b. (a, b) -> a
fst IdentInfo
info)
        -- 'name' is the biggest difference between 'RawSql' and
        -- 'SqlSelect'.  We automatically create names for tables
        -- (since it's not the user who's writing the FROM
        -- clause), while 'rawSql' assumes that it's just the
        -- name of the table (which doesn't allow self-joins, for
        -- example).
        name :: Builder
name = IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
ident Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"."
        ret :: (Builder, [PersistValue])
ret = let ed :: EntityDef
ed = Proxy a -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Proxy a -> EntityDef) -> Proxy a -> EntityDef
forall a b. (a -> b) -> a -> b
$ Proxy (SqlExpr (Entity a)) -> Proxy a
forall a. Proxy (SqlExpr (Entity a)) -> Proxy a
getEntityVal (Proxy (SqlExpr (Entity a)) -> Proxy a)
-> Proxy (SqlExpr (Entity a)) -> Proxy a
forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity a) -> Proxy (SqlExpr (Entity a))
forall (m :: * -> *) a. Monad m => a -> m a
return SqlExpr (Entity a)
expr
              in (EntityDef -> Builder
process EntityDef
ed, [PersistValue]
forall a. Monoid a => a
mempty)
    sqlSelectCols IdentInfo
info expr :: SqlExpr (Entity a)
expr@(EAliasedEntity Ident
aliasIdent Ident
tableIdent) = (Builder, [PersistValue])
ret
      where
        process :: EntityDef -> Builder
process EntityDef
ed = [Builder] -> Builder
uncommas ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
                     (DBName -> Builder) -> [DBName] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map ((Builder
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> (DBName -> Builder) -> DBName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBName -> Builder
aliasName) ([DBName] -> [Builder]) -> [DBName] -> [Builder]
forall a b. (a -> b) -> a -> b
$
                     EntityDef -> [DBName]
unescapedColumnNames EntityDef
ed
        aliasName :: DBName -> Builder
aliasName DBName
columnName = (IdentInfo -> DBName -> Builder
fromDBName IdentInfo
info DBName
columnName) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" AS " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Ident -> IdentInfo -> Text -> Builder
aliasedColumnName Ident
aliasIdent IdentInfo
info (DBName -> Text
unDBName DBName
columnName)
        name :: Builder
name = IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
tableIdent Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"."
        ret :: (Builder, [PersistValue])
ret = let ed :: EntityDef
ed = Proxy a -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Proxy a -> EntityDef) -> Proxy a -> EntityDef
forall a b. (a -> b) -> a -> b
$ Proxy (SqlExpr (Entity a)) -> Proxy a
forall a. Proxy (SqlExpr (Entity a)) -> Proxy a
getEntityVal (Proxy (SqlExpr (Entity a)) -> Proxy a)
-> Proxy (SqlExpr (Entity a)) -> Proxy a
forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity a) -> Proxy (SqlExpr (Entity a))
forall (m :: * -> *) a. Monad m => a -> m a
return SqlExpr (Entity a)
expr
              in (EntityDef -> Builder
process EntityDef
ed, [PersistValue]
forall a. Monoid a => a
mempty)
    sqlSelectCols IdentInfo
info expr :: SqlExpr (Entity a)
expr@(EAliasedEntityReference Ident
sourceIdent Ident
baseIdent) = (Builder, [PersistValue])
ret
      where
        process :: EntityDef -> Builder
process EntityDef
ed = [Builder] -> Builder
uncommas ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
                     (DBName -> Builder) -> [DBName] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map ((Builder
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> (DBName -> Builder) -> DBName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> IdentInfo -> Text -> Builder
aliasedColumnName Ident
baseIdent IdentInfo
info (Text -> Builder) -> (DBName -> Text) -> DBName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBName -> Text
unDBName) ([DBName] -> [Builder]) -> [DBName] -> [Builder]
forall a b. (a -> b) -> a -> b
$
                     EntityDef -> [DBName]
unescapedColumnNames EntityDef
ed
        name :: Builder
name = IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
sourceIdent Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"."
        ret :: (Builder, [PersistValue])
ret = let ed :: EntityDef
ed = Proxy a -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Proxy a -> EntityDef) -> Proxy a -> EntityDef
forall a b. (a -> b) -> a -> b
$ Proxy (SqlExpr (Entity a)) -> Proxy a
forall a. Proxy (SqlExpr (Entity a)) -> Proxy a
getEntityVal (Proxy (SqlExpr (Entity a)) -> Proxy a)
-> Proxy (SqlExpr (Entity a)) -> Proxy a
forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity a) -> Proxy (SqlExpr (Entity a))
forall (m :: * -> *) a. Monad m => a -> m a
return SqlExpr (Entity a)
expr
              in (EntityDef -> Builder
process EntityDef
ed, [PersistValue]
forall a. Monoid a => a
mempty)
    sqlSelectColCount :: Proxy (SqlExpr (Entity a)) -> Int
sqlSelectColCount = EntityDef -> Int
entityColumnCount (EntityDef -> Int)
-> (Proxy (SqlExpr (Entity a)) -> EntityDef)
-> Proxy (SqlExpr (Entity a))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Proxy a -> EntityDef)
-> (Proxy (SqlExpr (Entity a)) -> Proxy a)
-> Proxy (SqlExpr (Entity a))
-> EntityDef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (SqlExpr (Entity a)) -> Proxy a
forall a. Proxy (SqlExpr (Entity a)) -> Proxy a
getEntityVal
    sqlSelectProcessRow :: [PersistValue] -> Either Text (Entity a)
sqlSelectProcessRow = EntityDef -> [PersistValue] -> Either Text (Entity a)
forall record.
PersistEntity record =>
EntityDef -> [PersistValue] -> Either Text (Entity record)
parseEntityValues EntityDef
ed
      where
        ed :: EntityDef
ed = Proxy a -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Proxy a -> EntityDef) -> Proxy a -> EntityDef
forall a b. (a -> b) -> a -> b
$ Proxy (SqlExpr (Entity a)) -> Proxy a
forall a. Proxy (SqlExpr (Entity a)) -> Proxy a
getEntityVal (Proxy (SqlExpr (Entity a))
forall k (t :: k). Proxy t
Proxy :: Proxy (SqlExpr (Entity a)))

getEntityVal :: Proxy (SqlExpr (Entity a)) -> Proxy a
getEntityVal :: Proxy (SqlExpr (Entity a)) -> Proxy a
getEntityVal = Proxy a -> Proxy (SqlExpr (Entity a)) -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall k (t :: k). Proxy t
Proxy

-- | You may return a possibly-@NULL@ 'Entity' from a 'select' query.
instance PersistEntity a => SqlSelect (SqlExpr (Maybe (Entity a))) (Maybe (Entity a)) where
    sqlSelectCols :: IdentInfo
-> SqlExpr (Maybe (Entity a)) -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
info (EMaybe SqlExpr a
ent) = IdentInfo -> SqlExpr a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
info SqlExpr a
ent
    sqlSelectColCount :: Proxy (SqlExpr (Maybe (Entity a))) -> Int
sqlSelectColCount = Proxy (SqlExpr (Entity a)) -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy (SqlExpr (Entity a)) -> Int)
-> (Proxy (SqlExpr (Maybe (Entity a)))
    -> Proxy (SqlExpr (Entity a)))
-> Proxy (SqlExpr (Maybe (Entity a)))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (SqlExpr (Maybe (Entity a))) -> Proxy (SqlExpr (Entity a))
forall e. Proxy (SqlExpr (Maybe e)) -> Proxy (SqlExpr e)
fromEMaybe
      where
        fromEMaybe :: Proxy (SqlExpr (Maybe e)) -> Proxy (SqlExpr e)
        fromEMaybe :: Proxy (SqlExpr (Maybe e)) -> Proxy (SqlExpr e)
fromEMaybe = Proxy (SqlExpr e) -> Proxy (SqlExpr (Maybe e)) -> Proxy (SqlExpr e)
forall a b. a -> b -> a
const Proxy (SqlExpr e)
forall k (t :: k). Proxy t
Proxy
    sqlSelectProcessRow :: [PersistValue] -> Either Text (Maybe (Entity a))
sqlSelectProcessRow [PersistValue]
cols
        | (PersistValue -> Bool) -> [PersistValue] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (PersistValue -> PersistValue -> Bool
forall a. Eq a => a -> a -> Bool
== PersistValue
PersistNull) [PersistValue]
cols = Maybe (Entity a) -> Either Text (Maybe (Entity a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Entity a)
forall a. Maybe a
Nothing
        | Bool
otherwise                 = Entity a -> Maybe (Entity a)
forall a. a -> Maybe a
Just (Entity a -> Maybe (Entity a))
-> Either Text (Entity a) -> Either Text (Maybe (Entity a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PersistValue] -> Either Text (Entity a)
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow [PersistValue]
cols


-- | You may return any single value (i.e. a single column) from
-- a 'select' query.
instance PersistField a => SqlSelect (SqlExpr (Value a)) (Value a) where
    sqlSelectCols :: IdentInfo -> SqlExpr (Value a) -> (Builder, [PersistValue])
sqlSelectCols = IdentInfo -> SqlExpr (Value a) -> (Builder, [PersistValue])
forall a.
IdentInfo -> SqlExpr (Value a) -> (Builder, [PersistValue])
materializeExpr
    sqlSelectColCount :: Proxy (SqlExpr (Value a)) -> Int
sqlSelectColCount = Int -> Proxy (SqlExpr (Value a)) -> Int
forall a b. a -> b -> a
const Int
1
    sqlSelectProcessRow :: [PersistValue] -> Either Text (Value a)
sqlSelectProcessRow [PersistValue
pv] = a -> Value a
forall a. a -> Value a
Value (a -> Value a) -> Either Text a -> Either Text (Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PersistValue -> Either Text a
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
pv
    sqlSelectProcessRow [PersistValue]
pvs  = a -> Value a
forall a. a -> Value a
Value (a -> Value a) -> Either Text a -> Either Text (Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PersistValue -> Either Text a
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue ([PersistValue] -> PersistValue
PersistList [PersistValue]
pvs)

-- | Materialize a @SqlExpr (Value a)@.
materializeExpr :: IdentInfo -> SqlExpr (Value a) -> (TLB.Builder, [PersistValue])
materializeExpr :: IdentInfo -> SqlExpr (Value a) -> (Builder, [PersistValue])
materializeExpr IdentInfo
info (ERaw NeedParens
p IdentInfo -> (Builder, [PersistValue])
f) =
    let (Builder
b, [PersistValue]
vals) = IdentInfo -> (Builder, [PersistValue])
f IdentInfo
info
    in (NeedParens -> Builder -> Builder
parensM NeedParens
p Builder
b, [PersistValue]
vals)
materializeExpr IdentInfo
info (ECompositeKey IdentInfo -> [Builder]
f) =
    let bs :: [Builder]
bs = IdentInfo -> [Builder]
f IdentInfo
info
    in ([Builder] -> Builder
uncommas ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (Builder -> Builder) -> [Builder] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (NeedParens -> Builder -> Builder
parensM NeedParens
Parens) [Builder]
bs, [])
materializeExpr IdentInfo
info (EAliasedValue Ident
ident SqlExpr (Value a)
x) =
    let (Builder
b, [PersistValue]
vals) = IdentInfo -> SqlExpr (Value a) -> (Builder, [PersistValue])
forall a.
IdentInfo -> SqlExpr (Value a) -> (Builder, [PersistValue])
materializeExpr IdentInfo
info SqlExpr (Value a)
x
    in (Builder
b Builder -> Builder -> Builder
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]
vals)
materializeExpr IdentInfo
info (EValueReference Ident
sourceIdent IdentInfo -> Ident
columnIdent) =
    Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
sourceIdent IdentInfo -> Ident
columnIdent IdentInfo
info

-- | You may return tuples (up to 16-tuples) and tuples of tuples
-- from a 'select' query.
instance (SqlSelect a ra, SqlSelect b rb) => SqlSelect (a, b) (ra, rb) where
    sqlSelectCols :: IdentInfo -> (a, b) -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b) =
        [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas'
            [ IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc a
a
            , IdentInfo -> b -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc b
b
            ]
    sqlSelectColCount :: Proxy (a, b) -> Int
sqlSelectColCount = (Int -> Int -> Int) -> (Int, Int) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ((Int, Int) -> Int)
-> (Proxy (a, b) -> (Int, Int)) -> Proxy (a, b) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proxy a -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy a -> Int)
-> (Proxy b -> Int) -> (Proxy a, Proxy b) -> (Int, Int)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Proxy b -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount) ((Proxy a, Proxy b) -> (Int, Int))
-> (Proxy (a, b) -> (Proxy a, Proxy b))
-> Proxy (a, b)
-> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a, b) -> (Proxy a, Proxy b)
fromTuple
      where
        fromTuple :: Proxy (a,b) -> (Proxy a, Proxy b)
        fromTuple :: Proxy (a, b) -> (Proxy a, Proxy b)
fromTuple = (Proxy a, Proxy b) -> Proxy (a, b) -> (Proxy a, Proxy b)
forall a b. a -> b -> a
const (Proxy a
forall k (t :: k). Proxy t
Proxy, Proxy b
forall k (t :: k). Proxy t
Proxy)
    sqlSelectProcessRow :: [PersistValue] -> Either Text (ra, rb)
sqlSelectProcessRow =
      let x :: Proxy a
x = ([PersistValue] -> Either Text (ra, rb)) -> Proxy a
forall r z y x. SqlSelect a r => (z -> Either y (r, x)) -> Proxy a
getType [PersistValue] -> Either Text (ra, rb)
processRow
          getType :: SqlSelect a r => (z -> Either y (r,x)) -> Proxy a
          getType :: (z -> Either y (r, x)) -> Proxy a
getType = Proxy a -> (z -> Either y (r, x)) -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall k (t :: k). Proxy t
Proxy

          colCountFst :: Int
colCountFst = Proxy a -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount Proxy a
x

          processRow :: [PersistValue] -> Either Text (ra, rb)
processRow [PersistValue]
row =
              let ([PersistValue]
rowFst, [PersistValue]
rowSnd) = Int -> [PersistValue] -> ([PersistValue], [PersistValue])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
colCountFst [PersistValue]
row
              in (,) (ra -> rb -> (ra, rb))
-> Either Text ra -> Either Text (rb -> (ra, rb))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PersistValue] -> Either Text ra
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow [PersistValue]
rowFst
                     Either Text (rb -> (ra, rb))
-> Either Text rb -> Either Text (ra, rb)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [PersistValue] -> Either Text rb
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow [PersistValue]
rowSnd

      in Int
colCountFst Int
-> ([PersistValue] -> Either Text (ra, rb))
-> [PersistValue]
-> Either Text (ra, rb)
`seq` [PersistValue] -> Either Text (ra, rb)
processRow
         -- Avoids recalculating 'colCountFst'.

instance ( SqlSelect a ra
         , SqlSelect b rb
         , SqlSelect c rc
         ) => SqlSelect (a, b, c) (ra, rb, rc) where
  sqlSelectCols :: IdentInfo -> (a, b, c) -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b, c
c) =
    [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas'
      [ IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc a
a
      , IdentInfo -> b -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc b
b
      , IdentInfo -> c -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc c
c
      ]
  sqlSelectColCount :: Proxy (a, b, c) -> Int
sqlSelectColCount   = Proxy ((a, b), c) -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy ((a, b), c) -> Int)
-> (Proxy (a, b, c) -> Proxy ((a, b), c)) -> Proxy (a, b, c) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a, b, c) -> Proxy ((a, b), c)
forall a b c. Proxy (a, b, c) -> Proxy ((a, b), c)
from3P
  sqlSelectProcessRow :: [PersistValue] -> Either Text (ra, rb, rc)
sqlSelectProcessRow = (((ra, rb), rc) -> (ra, rb, rc))
-> Either Text ((ra, rb), rc) -> Either Text (ra, rb, rc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ra, rb), rc) -> (ra, rb, rc)
forall a b c. ((a, b), c) -> (a, b, c)
to3 (Either Text ((ra, rb), rc) -> Either Text (ra, rb, rc))
-> ([PersistValue] -> Either Text ((ra, rb), rc))
-> [PersistValue]
-> Either Text (ra, rb, rc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> Either Text ((ra, rb), rc)
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow

from3P :: Proxy (a,b,c) -> Proxy ((a,b),c)
from3P :: Proxy (a, b, c) -> Proxy ((a, b), c)
from3P = Proxy ((a, b), c) -> Proxy (a, b, c) -> Proxy ((a, b), c)
forall a b. a -> b -> a
const Proxy ((a, b), c)
forall k (t :: k). Proxy t
Proxy

from3 :: (a,b,c) -> ((a,b),c)
from3 :: (a, b, c) -> ((a, b), c)
from3 (a
a,b
b,c
c) = ((a
a,b
b),c
c)

to3 :: ((a,b),c) -> (a,b,c)
to3 :: ((a, b), c) -> (a, b, c)
to3 ((a
a,b
b),c
c) = (a
a,b
b,c
c)

instance ( SqlSelect a ra
         , SqlSelect b rb
         , SqlSelect c rc
         , SqlSelect d rd
         ) => SqlSelect (a, b, c, d) (ra, rb, rc, rd) where
  sqlSelectCols :: IdentInfo -> (a, b, c, d) -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b, c
c, d
d) =
    [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas'
      [ IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc a
a
      , IdentInfo -> b -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc b
b
      , IdentInfo -> c -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc c
c
      , IdentInfo -> d -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc d
d
      ]
  sqlSelectColCount :: Proxy (a, b, c, d) -> Int
sqlSelectColCount   = Proxy ((a, b), (c, d)) -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy ((a, b), (c, d)) -> Int)
-> (Proxy (a, b, c, d) -> Proxy ((a, b), (c, d)))
-> Proxy (a, b, c, d)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a, b, c, d) -> Proxy ((a, b), (c, d))
forall a b c d. Proxy (a, b, c, d) -> Proxy ((a, b), (c, d))
from4P
  sqlSelectProcessRow :: [PersistValue] -> Either Text (ra, rb, rc, rd)
sqlSelectProcessRow = (((ra, rb), (rc, rd)) -> (ra, rb, rc, rd))
-> Either Text ((ra, rb), (rc, rd)) -> Either Text (ra, rb, rc, rd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ra, rb), (rc, rd)) -> (ra, rb, rc, rd)
forall a b c d. ((a, b), (c, d)) -> (a, b, c, d)
to4 (Either Text ((ra, rb), (rc, rd)) -> Either Text (ra, rb, rc, rd))
-> ([PersistValue] -> Either Text ((ra, rb), (rc, rd)))
-> [PersistValue]
-> Either Text (ra, rb, rc, rd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> Either Text ((ra, rb), (rc, rd))
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow

from4P :: Proxy (a,b,c,d) -> Proxy ((a,b),(c,d))
from4P :: Proxy (a, b, c, d) -> Proxy ((a, b), (c, d))
from4P = Proxy ((a, b), (c, d))
-> Proxy (a, b, c, d) -> Proxy ((a, b), (c, d))
forall a b. a -> b -> a
const Proxy ((a, b), (c, d))
forall k (t :: k). Proxy t
Proxy

from4 :: (a,b,c,d) -> ((a,b),(c,d))
from4 :: (a, b, c, d) -> ((a, b), (c, d))
from4 (a
a,b
b,c
c,d
d) = ((a
a,b
b),(c
c,d
d))

to4 :: ((a,b),(c,d)) -> (a,b,c,d)
to4 :: ((a, b), (c, d)) -> (a, b, c, d)
to4 ((a
a,b
b),(c
c,d
d)) = (a
a,b
b,c
c,d
d)

instance ( SqlSelect a ra
         , SqlSelect b rb
         , SqlSelect c rc
         , SqlSelect d rd
         , SqlSelect e re
         ) => SqlSelect (a, b, c, d, e) (ra, rb, rc, rd, re) where
  sqlSelectCols :: IdentInfo -> (a, b, c, d, e) -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b, c
c, d
d, e
e) =
    [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas'
      [ IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc a
a
      , IdentInfo -> b -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc b
b
      , IdentInfo -> c -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc c
c
      , IdentInfo -> d -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc d
d
      , IdentInfo -> e -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc e
e
      ]
  sqlSelectColCount :: Proxy (a, b, c, d, e) -> Int
sqlSelectColCount   = Proxy ((a, b), (c, d), e) -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy ((a, b), (c, d), e) -> Int)
-> (Proxy (a, b, c, d, e) -> Proxy ((a, b), (c, d), e))
-> Proxy (a, b, c, d, e)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a, b, c, d, e) -> Proxy ((a, b), (c, d), e)
forall a b c d e.
Proxy (a, b, c, d, e) -> Proxy ((a, b), (c, d), e)
from5P
  sqlSelectProcessRow :: [PersistValue] -> Either Text (ra, rb, rc, rd, re)
sqlSelectProcessRow = (((ra, rb), (rc, rd), re) -> (ra, rb, rc, rd, re))
-> Either Text ((ra, rb), (rc, rd), re)
-> Either Text (ra, rb, rc, rd, re)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ra, rb), (rc, rd), re) -> (ra, rb, rc, rd, re)
forall a b c d e. ((a, b), (c, d), e) -> (a, b, c, d, e)
to5 (Either Text ((ra, rb), (rc, rd), re)
 -> Either Text (ra, rb, rc, rd, re))
-> ([PersistValue] -> Either Text ((ra, rb), (rc, rd), re))
-> [PersistValue]
-> Either Text (ra, rb, rc, rd, re)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> Either Text ((ra, rb), (rc, rd), re)
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow

from5P :: Proxy (a,b,c,d,e) -> Proxy ((a,b),(c,d),e)
from5P :: Proxy (a, b, c, d, e) -> Proxy ((a, b), (c, d), e)
from5P = Proxy ((a, b), (c, d), e)
-> Proxy (a, b, c, d, e) -> Proxy ((a, b), (c, d), e)
forall a b. a -> b -> a
const Proxy ((a, b), (c, d), e)
forall k (t :: k). Proxy t
Proxy

from5 :: (a,b,c,d,e) -> ((a,b),(c,d),e)
from5 :: (a, b, c, d, e) -> ((a, b), (c, d), e)
from5 (a
a,b
b,c
c,d
d,e
e) = ((a
a,b
b),(c
c,d
d),e
e)

to5 :: ((a,b),(c,d),e) -> (a,b,c,d,e)
to5 :: ((a, b), (c, d), e) -> (a, b, c, d, e)
to5 ((a
a,b
b),(c
c,d
d),e
e) = (a
a,b
b,c
c,d
d,e
e)

instance ( SqlSelect a ra
         , SqlSelect b rb
         , SqlSelect c rc
         , SqlSelect d rd
         , SqlSelect e re
         , SqlSelect f rf
         ) => SqlSelect (a, b, c, d, e, f) (ra, rb, rc, rd, re, rf) where
  sqlSelectCols :: IdentInfo -> (a, b, c, d, e, f) -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b, c
c, d
d, e
e, f
f) =
    [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas'
      [ IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc a
a
      , IdentInfo -> b -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc b
b
      , IdentInfo -> c -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc c
c
      , IdentInfo -> d -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc d
d
      , IdentInfo -> e -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc e
e
      , IdentInfo -> f -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc f
f
      ]
  sqlSelectColCount :: Proxy (a, b, c, d, e, f) -> Int
sqlSelectColCount   = Proxy ((a, b), (c, d), (e, f)) -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy ((a, b), (c, d), (e, f)) -> Int)
-> (Proxy (a, b, c, d, e, f) -> Proxy ((a, b), (c, d), (e, f)))
-> Proxy (a, b, c, d, e, f)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a, b, c, d, e, f) -> Proxy ((a, b), (c, d), (e, f))
forall a b c d e f.
Proxy (a, b, c, d, e, f) -> Proxy ((a, b), (c, d), (e, f))
from6P
  sqlSelectProcessRow :: [PersistValue] -> Either Text (ra, rb, rc, rd, re, rf)
sqlSelectProcessRow = (((ra, rb), (rc, rd), (re, rf)) -> (ra, rb, rc, rd, re, rf))
-> Either Text ((ra, rb), (rc, rd), (re, rf))
-> Either Text (ra, rb, rc, rd, re, rf)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ra, rb), (rc, rd), (re, rf)) -> (ra, rb, rc, rd, re, rf)
forall a b c d e f. ((a, b), (c, d), (e, f)) -> (a, b, c, d, e, f)
to6 (Either Text ((ra, rb), (rc, rd), (re, rf))
 -> Either Text (ra, rb, rc, rd, re, rf))
-> ([PersistValue] -> Either Text ((ra, rb), (rc, rd), (re, rf)))
-> [PersistValue]
-> Either Text (ra, rb, rc, rd, re, rf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> Either Text ((ra, rb), (rc, rd), (re, rf))
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow

from6P :: Proxy (a,b,c,d,e,f) -> Proxy ((a,b),(c,d),(e,f))
from6P :: Proxy (a, b, c, d, e, f) -> Proxy ((a, b), (c, d), (e, f))
from6P = Proxy ((a, b), (c, d), (e, f))
-> Proxy (a, b, c, d, e, f) -> Proxy ((a, b), (c, d), (e, f))
forall a b. a -> b -> a
const Proxy ((a, b), (c, d), (e, f))
forall k (t :: k). Proxy t
Proxy

from6 :: (a,b,c,d,e,f) -> ((a,b),(c,d),(e,f))
from6 :: (a, b, c, d, e, f) -> ((a, b), (c, d), (e, f))
from6 (a
a,b
b,c
c,d
d,e
e,f
f) = ((a
a,b
b),(c
c,d
d),(e
e,f
f))

to6 :: ((a,b),(c,d),(e,f)) -> (a,b,c,d,e,f)
to6 :: ((a, b), (c, d), (e, f)) -> (a, b, c, d, e, f)
to6 ((a
a,b
b),(c
c,d
d),(e
e,f
f)) = (a
a,b
b,c
c,d
d,e
e,f
f)

instance ( SqlSelect a ra
         , SqlSelect b rb
         , SqlSelect c rc
         , SqlSelect d rd
         , SqlSelect e re
         , SqlSelect f rf
         , SqlSelect g rg
         ) => SqlSelect (a, b, c, d, e, f, g) (ra, rb, rc, rd, re, rf, rg) where
  sqlSelectCols :: IdentInfo -> (a, b, c, d, e, f, g) -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b, c
c, d
d, e
e, f
f, g
g) =
    [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas'
      [ IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc a
a
      , IdentInfo -> b -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc b
b
      , IdentInfo -> c -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc c
c
      , IdentInfo -> d -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc d
d
      , IdentInfo -> e -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc e
e
      , IdentInfo -> f -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc f
f
      , IdentInfo -> g -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc g
g
      ]
  sqlSelectColCount :: Proxy (a, b, c, d, e, f, g) -> Int
sqlSelectColCount   = Proxy ((a, b), (c, d), (e, f), g) -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy ((a, b), (c, d), (e, f), g) -> Int)
-> (Proxy (a, b, c, d, e, f, g)
    -> Proxy ((a, b), (c, d), (e, f), g))
-> Proxy (a, b, c, d, e, f, g)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a, b, c, d, e, f, g) -> Proxy ((a, b), (c, d), (e, f), g)
forall a b c d e f g.
Proxy (a, b, c, d, e, f, g) -> Proxy ((a, b), (c, d), (e, f), g)
from7P
  sqlSelectProcessRow :: [PersistValue] -> Either Text (ra, rb, rc, rd, re, rf, rg)
sqlSelectProcessRow = (((ra, rb), (rc, rd), (re, rf), rg)
 -> (ra, rb, rc, rd, re, rf, rg))
-> Either Text ((ra, rb), (rc, rd), (re, rf), rg)
-> Either Text (ra, rb, rc, rd, re, rf, rg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ra, rb), (rc, rd), (re, rf), rg) -> (ra, rb, rc, rd, re, rf, rg)
forall a b c d e f g.
((a, b), (c, d), (e, f), g) -> (a, b, c, d, e, f, g)
to7 (Either Text ((ra, rb), (rc, rd), (re, rf), rg)
 -> Either Text (ra, rb, rc, rd, re, rf, rg))
-> ([PersistValue]
    -> Either Text ((ra, rb), (rc, rd), (re, rf), rg))
-> [PersistValue]
-> Either Text (ra, rb, rc, rd, re, rf, rg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> Either Text ((ra, rb), (rc, rd), (re, rf), rg)
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow

from7P :: Proxy (a,b,c,d,e,f,g) -> Proxy ((a,b),(c,d),(e,f),g)
from7P :: Proxy (a, b, c, d, e, f, g) -> Proxy ((a, b), (c, d), (e, f), g)
from7P = Proxy ((a, b), (c, d), (e, f), g)
-> Proxy (a, b, c, d, e, f, g) -> Proxy ((a, b), (c, d), (e, f), g)
forall a b. a -> b -> a
const Proxy ((a, b), (c, d), (e, f), g)
forall k (t :: k). Proxy t
Proxy

from7 :: (a,b,c,d,e,f,g) -> ((a,b),(c,d),(e,f),g)
from7 :: (a, b, c, d, e, f, g) -> ((a, b), (c, d), (e, f), g)
from7 (a
a,b
b,c
c,d
d,e
e,f
f,g
g) = ((a
a,b
b),(c
c,d
d),(e
e,f
f),g
g)

to7 :: ((a,b),(c,d),(e,f),g) -> (a,b,c,d,e,f,g)
to7 :: ((a, b), (c, d), (e, f), g) -> (a, b, c, d, e, f, g)
to7 ((a
a,b
b),(c
c,d
d),(e
e,f
f),g
g) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g)

instance ( SqlSelect a ra
         , SqlSelect b rb
         , SqlSelect c rc
         , SqlSelect d rd
         , SqlSelect e re
         , SqlSelect f rf
         , SqlSelect g rg
         , SqlSelect h rh
         ) => SqlSelect (a, b, c, d, e, f, g, h) (ra, rb, rc, rd, re, rf, rg, rh) where
  sqlSelectCols :: IdentInfo -> (a, b, c, d, e, f, g, h) -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) =
    [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas'
      [ IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc a
a
      , IdentInfo -> b -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc b
b
      , IdentInfo -> c -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc c
c
      , IdentInfo -> d -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc d
d
      , IdentInfo -> e -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc e
e
      , IdentInfo -> f -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc f
f
      , IdentInfo -> g -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc g
g
      , IdentInfo -> h -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc h
h
      ]
  sqlSelectColCount :: Proxy (a, b, c, d, e, f, g, h) -> Int
sqlSelectColCount   = Proxy ((a, b), (c, d), (e, f), (g, h)) -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy ((a, b), (c, d), (e, f), (g, h)) -> Int)
-> (Proxy (a, b, c, d, e, f, g, h)
    -> Proxy ((a, b), (c, d), (e, f), (g, h)))
-> Proxy (a, b, c, d, e, f, g, h)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a, b, c, d, e, f, g, h)
-> Proxy ((a, b), (c, d), (e, f), (g, h))
forall a b c d e f g h.
Proxy (a, b, c, d, e, f, g, h)
-> Proxy ((a, b), (c, d), (e, f), (g, h))
from8P
  sqlSelectProcessRow :: [PersistValue] -> Either Text (ra, rb, rc, rd, re, rf, rg, rh)
sqlSelectProcessRow = (((ra, rb), (rc, rd), (re, rf), (rg, rh))
 -> (ra, rb, rc, rd, re, rf, rg, rh))
-> Either Text ((ra, rb), (rc, rd), (re, rf), (rg, rh))
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ra, rb), (rc, rd), (re, rf), (rg, rh))
-> (ra, rb, rc, rd, re, rf, rg, rh)
forall a b c d e f g h.
((a, b), (c, d), (e, f), (g, h)) -> (a, b, c, d, e, f, g, h)
to8 (Either Text ((ra, rb), (rc, rd), (re, rf), (rg, rh))
 -> Either Text (ra, rb, rc, rd, re, rf, rg, rh))
-> ([PersistValue]
    -> Either Text ((ra, rb), (rc, rd), (re, rf), (rg, rh)))
-> [PersistValue]
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> Either Text ((ra, rb), (rc, rd), (re, rf), (rg, rh))
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow

from8P :: Proxy (a,b,c,d,e,f,g,h) -> Proxy ((a,b),(c,d),(e,f),(g,h))
from8P :: Proxy (a, b, c, d, e, f, g, h)
-> Proxy ((a, b), (c, d), (e, f), (g, h))
from8P = Proxy ((a, b), (c, d), (e, f), (g, h))
-> Proxy (a, b, c, d, e, f, g, h)
-> Proxy ((a, b), (c, d), (e, f), (g, h))
forall a b. a -> b -> a
const Proxy ((a, b), (c, d), (e, f), (g, h))
forall k (t :: k). Proxy t
Proxy

from8 :: (a,b,c,d,e,f,g,h) -> ((a,b),(c,d),(e,f),(g,h))
from8 :: (a, b, c, d, e, f, g, h) -> ((a, b), (c, d), (e, f), (g, h))
from8 (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h))

to8 :: ((a,b),(c,d),(e,f),(g,h)) -> (a,b,c,d,e,f,g,h)
to8 :: ((a, b), (c, d), (e, f), (g, h)) -> (a, b, c, d, e, f, g, h)
to8 ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h)) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h)

instance ( SqlSelect a ra
         , SqlSelect b rb
         , SqlSelect c rc
         , SqlSelect d rd
         , SqlSelect e re
         , SqlSelect f rf
         , SqlSelect g rg
         , SqlSelect h rh
         , SqlSelect i ri
         ) => SqlSelect (a, b, c, d, e, f, g, h, i) (ra, rb, rc, rd, re, rf, rg, rh, ri) where
  sqlSelectCols :: IdentInfo
-> (a, b, c, d, e, f, g, h, i) -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) =
    [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas'
      [ IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc a
a
      , IdentInfo -> b -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc b
b
      , IdentInfo -> c -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc c
c
      , IdentInfo -> d -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc d
d
      , IdentInfo -> e -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc e
e
      , IdentInfo -> f -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc f
f
      , IdentInfo -> g -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc g
g
      , IdentInfo -> h -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc h
h
      , IdentInfo -> i -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc i
i
      ]
  sqlSelectColCount :: Proxy (a, b, c, d, e, f, g, h, i) -> Int
sqlSelectColCount   = Proxy ((a, b), (c, d), (e, f), (g, h), i) -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy ((a, b), (c, d), (e, f), (g, h), i) -> Int)
-> (Proxy (a, b, c, d, e, f, g, h, i)
    -> Proxy ((a, b), (c, d), (e, f), (g, h), i))
-> Proxy (a, b, c, d, e, f, g, h, i)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a, b, c, d, e, f, g, h, i)
-> Proxy ((a, b), (c, d), (e, f), (g, h), i)
forall a b c d e f g h i.
Proxy (a, b, c, d, e, f, g, h, i)
-> Proxy ((a, b), (c, d), (e, f), (g, h), i)
from9P
  sqlSelectProcessRow :: [PersistValue] -> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri)
sqlSelectProcessRow = (((ra, rb), (rc, rd), (re, rf), (rg, rh), ri)
 -> (ra, rb, rc, rd, re, rf, rg, rh, ri))
-> Either Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), ri)
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ra, rb), (rc, rd), (re, rf), (rg, rh), ri)
-> (ra, rb, rc, rd, re, rf, rg, rh, ri)
forall a b c d e f g h i.
((a, b), (c, d), (e, f), (g, h), i) -> (a, b, c, d, e, f, g, h, i)
to9 (Either Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), ri)
 -> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri))
-> ([PersistValue]
    -> Either Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), ri))
-> [PersistValue]
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> Either Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), ri)
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow

from9P :: Proxy (a,b,c,d,e,f,g,h,i) -> Proxy ((a,b),(c,d),(e,f),(g,h),i)
from9P :: Proxy (a, b, c, d, e, f, g, h, i)
-> Proxy ((a, b), (c, d), (e, f), (g, h), i)
from9P = Proxy ((a, b), (c, d), (e, f), (g, h), i)
-> Proxy (a, b, c, d, e, f, g, h, i)
-> Proxy ((a, b), (c, d), (e, f), (g, h), i)
forall a b. a -> b -> a
const Proxy ((a, b), (c, d), (e, f), (g, h), i)
forall k (t :: k). Proxy t
Proxy

from9 :: (a,b,c,d,e,f,g,h,i) -> ((a,b),(c,d),(e,f),(g,h),i)
from9 :: (a, b, c, d, e, f, g, h, i) -> ((a, b), (c, d), (e, f), (g, h), i)
from9 (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),i
i)

to9 :: ((a,b),(c,d),(e,f),(g,h),i) -> (a,b,c,d,e,f,g,h,i)
to9 :: ((a, b), (c, d), (e, f), (g, h), i) -> (a, b, c, d, e, f, g, h, i)
to9 ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),i
i) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i)

instance ( SqlSelect a ra
         , SqlSelect b rb
         , SqlSelect c rc
         , SqlSelect d rd
         , SqlSelect e re
         , SqlSelect f rf
         , SqlSelect g rg
         , SqlSelect h rh
         , SqlSelect i ri
         , SqlSelect j rj
         ) => SqlSelect (a, b, c, d, e, f, g, h, i, j) (ra, rb, rc, rd, re, rf, rg, rh, ri, rj) where
  sqlSelectCols :: IdentInfo
-> (a, b, c, d, e, f, g, h, i, j) -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) =
    [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas'
      [ IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc a
a
      , IdentInfo -> b -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc b
b
      , IdentInfo -> c -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc c
c
      , IdentInfo -> d -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc d
d
      , IdentInfo -> e -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc e
e
      , IdentInfo -> f -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc f
f
      , IdentInfo -> g -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc g
g
      , IdentInfo -> h -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc h
h
      , IdentInfo -> i -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc i
i
      , IdentInfo -> j -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc j
j
      ]
  sqlSelectColCount :: Proxy (a, b, c, d, e, f, g, h, i, j) -> Int
sqlSelectColCount   = Proxy ((a, b), (c, d), (e, f), (g, h), (i, j)) -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy ((a, b), (c, d), (e, f), (g, h), (i, j)) -> Int)
-> (Proxy (a, b, c, d, e, f, g, h, i, j)
    -> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j)))
-> Proxy (a, b, c, d, e, f, g, h, i, j)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a, b, c, d, e, f, g, h, i, j)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j))
forall a b c d e f g h i j.
Proxy (a, b, c, d, e, f, g, h, i, j)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j))
from10P
  sqlSelectProcessRow :: [PersistValue]
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj)
sqlSelectProcessRow = (((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj))
 -> (ra, rb, rc, rd, re, rf, rg, rh, ri, rj))
-> Either Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj))
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj))
-> (ra, rb, rc, rd, re, rf, rg, rh, ri, rj)
forall a b c d e f g h i j.
((a, b), (c, d), (e, f), (g, h), (i, j))
-> (a, b, c, d, e, f, g, h, i, j)
to10 (Either Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj))
 -> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj))
-> ([PersistValue]
    -> Either Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj)))
-> [PersistValue]
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> Either Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj))
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow

from10P :: Proxy (a,b,c,d,e,f,g,h,i,j) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j))
from10P :: Proxy (a, b, c, d, e, f, g, h, i, j)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j))
from10P = Proxy ((a, b), (c, d), (e, f), (g, h), (i, j))
-> Proxy (a, b, c, d, e, f, g, h, i, j)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j))
forall a b. a -> b -> a
const Proxy ((a, b), (c, d), (e, f), (g, h), (i, j))
forall k (t :: k). Proxy t
Proxy

from10 :: (a,b,c,d,e,f,g,h,i,j) -> ((a,b),(c,d),(e,f),(g,h),(i,j))
from10 :: (a, b, c, d, e, f, g, h, i, j)
-> ((a, b), (c, d), (e, f), (g, h), (i, j))
from10 (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j) = ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),(i
i,j
j))

to10 :: ((a,b),(c,d),(e,f),(g,h),(i,j)) -> (a,b,c,d,e,f,g,h,i,j)
to10 :: ((a, b), (c, d), (e, f), (g, h), (i, j))
-> (a, b, c, d, e, f, g, h, i, j)
to10 ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),(i
i,j
j)) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j)

instance ( SqlSelect a ra
         , SqlSelect b rb
         , SqlSelect c rc
         , SqlSelect d rd
         , SqlSelect e re
         , SqlSelect f rf
         , SqlSelect g rg
         , SqlSelect h rh
         , SqlSelect i ri
         , SqlSelect j rj
         , SqlSelect k rk
         ) => SqlSelect (a, b, c, d, e, f, g, h, i, j, k) (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk) where
  sqlSelectCols :: IdentInfo
-> (a, b, c, d, e, f, g, h, i, j, k) -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k) =
    [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas'
      [ IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc a
a
      , IdentInfo -> b -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc b
b
      , IdentInfo -> c -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc c
c
      , IdentInfo -> d -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc d
d
      , IdentInfo -> e -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc e
e
      , IdentInfo -> f -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc f
f
      , IdentInfo -> g -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc g
g
      , IdentInfo -> h -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc h
h
      , IdentInfo -> i -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc i
i
      , IdentInfo -> j -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc j
j
      , IdentInfo -> k -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc k
k
      ]
  sqlSelectColCount :: Proxy (a, b, c, d, e, f, g, h, i, j, k) -> Int
sqlSelectColCount   = Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), k) -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), k) -> Int)
-> (Proxy (a, b, c, d, e, f, g, h, i, j, k)
    -> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), k))
-> Proxy (a, b, c, d, e, f, g, h, i, j, k)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a, b, c, d, e, f, g, h, i, j, k)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), k)
forall a b c d e f g h i j k.
Proxy (a, b, c, d, e, f, g, h, i, j, k)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), k)
from11P
  sqlSelectProcessRow :: [PersistValue]
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk)
sqlSelectProcessRow = (((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), rk)
 -> (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk))
-> Either
     Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), rk)
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), rk)
-> (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk)
forall a b c d e f g h i j k.
((a, b), (c, d), (e, f), (g, h), (i, j), k)
-> (a, b, c, d, e, f, g, h, i, j, k)
to11 (Either Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), rk)
 -> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk))
-> ([PersistValue]
    -> Either
         Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), rk))
-> [PersistValue]
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> Either
     Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), rk)
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow

from11P :: Proxy (a,b,c,d,e,f,g,h,i,j,k) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),k)
from11P :: Proxy (a, b, c, d, e, f, g, h, i, j, k)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), k)
from11P = Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), k)
-> Proxy (a, b, c, d, e, f, g, h, i, j, k)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), k)
forall a b. a -> b -> a
const Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), k)
forall k (t :: k). Proxy t
Proxy

to11 :: ((a,b),(c,d),(e,f),(g,h),(i,j),k) -> (a,b,c,d,e,f,g,h,i,j,k)
to11 :: ((a, b), (c, d), (e, f), (g, h), (i, j), k)
-> (a, b, c, d, e, f, g, h, i, j, k)
to11 ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),(i
i,j
j),k
k) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k)

instance ( SqlSelect a ra
         , SqlSelect b rb
         , SqlSelect c rc
         , SqlSelect d rd
         , SqlSelect e re
         , SqlSelect f rf
         , SqlSelect g rg
         , SqlSelect h rh
         , SqlSelect i ri
         , SqlSelect j rj
         , SqlSelect k rk
         , SqlSelect l rl
         ) => SqlSelect (a, b, c, d, e, f, g, h, i, j, k, l) (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl) where
  sqlSelectCols :: IdentInfo
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l) =
    [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas'
      [ IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc a
a
      , IdentInfo -> b -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc b
b
      , IdentInfo -> c -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc c
c
      , IdentInfo -> d -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc d
d
      , IdentInfo -> e -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc e
e
      , IdentInfo -> f -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc f
f
      , IdentInfo -> g -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc g
g
      , IdentInfo -> h -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc h
h
      , IdentInfo -> i -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc i
i
      , IdentInfo -> j -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc j
j
      , IdentInfo -> k -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc k
k
      , IdentInfo -> l -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc l
l
      ]
  sqlSelectColCount :: Proxy (a, b, c, d, e, f, g, h, i, j, k, l) -> Int
sqlSelectColCount   = Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l)) -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l)) -> Int)
-> (Proxy (a, b, c, d, e, f, g, h, i, j, k, l)
    -> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l)))
-> Proxy (a, b, c, d, e, f, g, h, i, j, k, l)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a, b, c, d, e, f, g, h, i, j, k, l)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
forall a b c d e f g h i j k l.
Proxy (a, b, c, d, e, f, g, h, i, j, k, l)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
from12P
  sqlSelectProcessRow :: [PersistValue]
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl)
sqlSelectProcessRow = (((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl))
 -> (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl))
-> Either
     Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl))
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl))
-> (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl)
forall a b c d e f g h i j k l.
((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
-> (a, b, c, d, e, f, g, h, i, j, k, l)
to12 (Either
   Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl))
 -> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl))
-> ([PersistValue]
    -> Either
         Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl)))
-> [PersistValue]
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> Either
     Text ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl))
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow

from12P :: Proxy (a,b,c,d,e,f,g,h,i,j,k,l) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l))
from12P :: Proxy (a, b, c, d, e, f, g, h, i, j, k, l)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
from12P = Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
-> Proxy (a, b, c, d, e, f, g, h, i, j, k, l)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
forall a b. a -> b -> a
const Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
forall k (t :: k). Proxy t
Proxy

to12 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l)) -> (a,b,c,d,e,f,g,h,i,j,k,l)
to12 :: ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
-> (a, b, c, d, e, f, g, h, i, j, k, l)
to12 ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),(i
i,j
j),(k
k,l
l)) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l)

instance ( SqlSelect a ra
         , SqlSelect b rb
         , SqlSelect c rc
         , SqlSelect d rd
         , SqlSelect e re
         , SqlSelect f rf
         , SqlSelect g rg
         , SqlSelect h rh
         , SqlSelect i ri
         , SqlSelect j rj
         , SqlSelect k rk
         , SqlSelect l rl
         , SqlSelect m rm
         ) => SqlSelect (a, b, c, d, e, f, g, h, i, j, k, l, m) (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm) where
  sqlSelectCols :: IdentInfo
-> (a, b, c, d, e, f, g, h, i, j, k, l, m)
-> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m) =
    [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas'
      [ IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc a
a
      , IdentInfo -> b -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc b
b
      , IdentInfo -> c -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc c
c
      , IdentInfo -> d -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc d
d
      , IdentInfo -> e -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc e
e
      , IdentInfo -> f -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc f
f
      , IdentInfo -> g -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc g
g
      , IdentInfo -> h -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc h
h
      , IdentInfo -> i -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc i
i
      , IdentInfo -> j -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc j
j
      , IdentInfo -> k -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc k
k
      , IdentInfo -> l -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc l
l
      , IdentInfo -> m -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc m
m
      ]
  sqlSelectColCount :: Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m) -> Int
sqlSelectColCount   = Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), m) -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), m) -> Int)
-> (Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m)
    -> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), m))
-> Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), m)
forall a b c d e f g h i j k l m.
Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), m)
from13P
  sqlSelectProcessRow :: [PersistValue]
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm)
sqlSelectProcessRow = (((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl), rm)
 -> (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm))
-> Either
     Text
     ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl), rm)
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl), rm)
-> (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm)
forall a b c d e f g h i j k l m.
((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), m)
-> (a, b, c, d, e, f, g, h, i, j, k, l, m)
to13 (Either
   Text
   ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl), rm)
 -> Either
      Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm))
-> ([PersistValue]
    -> Either
         Text
         ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl), rm))
-> [PersistValue]
-> Either Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> Either
     Text
     ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl), rm)
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow

from13P :: Proxy (a,b,c,d,e,f,g,h,i,j,k,l,m) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),m)
from13P :: Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), m)
from13P = Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), m)
-> Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), m)
forall a b. a -> b -> a
const Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), m)
forall k (t :: k). Proxy t
Proxy

to13 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),m) -> (a,b,c,d,e,f,g,h,i,j,k,l,m)
to13 :: ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), m)
-> (a, b, c, d, e, f, g, h, i, j, k, l, m)
to13 ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),(i
i,j
j),(k
k,l
l),m
m) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m)

instance ( SqlSelect a ra
         , SqlSelect b rb
         , SqlSelect c rc
         , SqlSelect d rd
         , SqlSelect e re
         , SqlSelect f rf
         , SqlSelect g rg
         , SqlSelect h rh
         , SqlSelect i ri
         , SqlSelect j rj
         , SqlSelect k rk
         , SqlSelect l rl
         , SqlSelect m rm
         , SqlSelect n rn
         ) => SqlSelect (a, b, c, d, e, f, g, h, i, j, k, l, m, n) (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn) where
  sqlSelectCols :: IdentInfo
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
-> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n) =
    [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas'
      [ IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc a
a
      , IdentInfo -> b -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc b
b
      , IdentInfo -> c -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc c
c
      , IdentInfo -> d -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc d
d
      , IdentInfo -> e -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc e
e
      , IdentInfo -> f -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc f
f
      , IdentInfo -> g -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc g
g
      , IdentInfo -> h -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc h
h
      , IdentInfo -> i -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc i
i
      , IdentInfo -> j -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc j
j
      , IdentInfo -> k -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc k
k
      , IdentInfo -> l -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc l
l
      , IdentInfo -> m -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc m
m
      , IdentInfo -> n -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc n
n
      ]
  sqlSelectColCount :: Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> Int
sqlSelectColCount   = Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n))
-> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n))
 -> Int)
-> (Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
    -> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n)))
-> Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n))
forall a b c d e f g h i j k l m n.
Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n))
from14P
  sqlSelectProcessRow :: [PersistValue]
-> Either
     Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn)
sqlSelectProcessRow = (((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
  (rm, rn))
 -> (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn))
-> Either
     Text
     ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
      (rm, rn))
-> Either
     Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
 (rm, rn))
-> (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn)
forall a b c d e f g h i j k l m n.
((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n))
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
to14 (Either
   Text
   ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
    (rm, rn))
 -> Either
      Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn))
-> ([PersistValue]
    -> Either
         Text
         ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
          (rm, rn)))
-> [PersistValue]
-> Either
     Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> Either
     Text
     ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
      (rm, rn))
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow

from14P :: Proxy (a,b,c,d,e,f,g,h,i,j,k,l,m,n) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n))
from14P :: Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n))
from14P = Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n))
-> Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
-> Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n))
forall a b. a -> b -> a
const Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n))
forall k (t :: k). Proxy t
Proxy

to14 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n)) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n)
to14 :: ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n))
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
to14 ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),(i
i,j
j),(k
k,l
l),(m
m,n
n)) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n)

instance ( SqlSelect a ra
         , SqlSelect b rb
         , SqlSelect c rc
         , SqlSelect d rd
         , SqlSelect e re
         , SqlSelect f rf
         , SqlSelect g rg
         , SqlSelect h rh
         , SqlSelect i ri
         , SqlSelect j rj
         , SqlSelect k rk
         , SqlSelect l rl
         , SqlSelect m rm
         , SqlSelect n rn
         , SqlSelect o ro
         ) => SqlSelect (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro) where
  sqlSelectCols :: IdentInfo
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
-> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o) =
    [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas'
      [ IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc a
a
      , IdentInfo -> b -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc b
b
      , IdentInfo -> c -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc c
c
      , IdentInfo -> d -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc d
d
      , IdentInfo -> e -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc e
e
      , IdentInfo -> f -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc f
f
      , IdentInfo -> g -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc g
g
      , IdentInfo -> h -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc h
h
      , IdentInfo -> i -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc i
i
      , IdentInfo -> j -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc j
j
      , IdentInfo -> k -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc k
k
      , IdentInfo -> l -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc l
l
      , IdentInfo -> m -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc m
m
      , IdentInfo -> n -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc n
n
      , IdentInfo -> o -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc o
o
      ]
  sqlSelectColCount :: Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> Int
sqlSelectColCount   = Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), o)
-> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), o)
 -> Int)
-> (Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
    -> Proxy
         ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), o))
-> Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
-> Proxy
     ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), o)
forall a b c d e f g h i j k l m n o.
Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
-> Proxy
     ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), o)
from15P
  sqlSelectProcessRow :: [PersistValue]
-> Either
     Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro)
sqlSelectProcessRow = (((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
  (rm, rn), ro)
 -> (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro))
-> Either
     Text
     ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
      (rm, rn), ro)
-> Either
     Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
 (rm, rn), ro)
-> (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro)
forall a b c d e f g h i j k l m n o.
((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), o)
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
to15 (Either
   Text
   ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
    (rm, rn), ro)
 -> Either
      Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro))
-> ([PersistValue]
    -> Either
         Text
         ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
          (rm, rn), ro))
-> [PersistValue]
-> Either
     Text (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> Either
     Text
     ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
      (rm, rn), ro)
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow

from15P :: Proxy (a,b,c,d,e,f,g,h,i,j,k,l,m,n, o) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),o)
from15P :: Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
-> Proxy
     ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), o)
from15P = Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), o)
-> Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
-> Proxy
     ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), o)
forall a b. a -> b -> a
const Proxy ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), o)
forall k (t :: k). Proxy t
Proxy

to15 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),o) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)
to15 :: ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), o)
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
to15 ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),(i
i,j
j),(k
k,l
l),(m
m,n
n),o
o) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o)

instance ( SqlSelect a ra
         , SqlSelect b rb
         , SqlSelect c rc
         , SqlSelect d rd
         , SqlSelect e re
         , SqlSelect f rf
         , SqlSelect g rg
         , SqlSelect h rh
         , SqlSelect i ri
         , SqlSelect j rj
         , SqlSelect k rk
         , SqlSelect l rl
         , SqlSelect m rm
         , SqlSelect n rn
         , SqlSelect o ro
         , SqlSelect p rp
         ) => SqlSelect (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro, rp) where
  sqlSelectCols :: IdentInfo
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
-> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o, p
p) =
    [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas'
      [ IdentInfo -> a -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc a
a
      , IdentInfo -> b -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc b
b
      , IdentInfo -> c -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc c
c
      , IdentInfo -> d -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc d
d
      , IdentInfo -> e -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc e
e
      , IdentInfo -> f -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc f
f
      , IdentInfo -> g -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc g
g
      , IdentInfo -> h -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc h
h
      , IdentInfo -> i -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc i
i
      , IdentInfo -> j -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc j
j
      , IdentInfo -> k -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc k
k
      , IdentInfo -> l -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc l
l
      , IdentInfo -> m -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc m
m
      , IdentInfo -> n -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc n
n
      , IdentInfo -> o -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc o
o
      , IdentInfo -> p -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc p
p
      ]
  sqlSelectColCount :: Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) -> Int
sqlSelectColCount   = Proxy
  ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), (o, p))
-> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy
   ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), (o, p))
 -> Int)
-> (Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
    -> Proxy
         ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), (o, p)))
-> Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
-> Proxy
     ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), (o, p))
forall a b c d e f g h i j k l m n o p.
Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
-> Proxy
     ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), (o, p))
from16P
  sqlSelectProcessRow :: [PersistValue]
-> Either
     Text
     (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro, rp)
sqlSelectProcessRow = (((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
  (rm, rn), (ro, rp))
 -> (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro,
     rp))
-> Either
     Text
     ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
      (rm, rn), (ro, rp))
-> Either
     Text
     (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro, rp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
 (rm, rn), (ro, rp))
-> (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro, rp)
forall a b c d e f g h i j k l m n o p.
((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), (o, p))
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
to16 (Either
   Text
   ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
    (rm, rn), (ro, rp))
 -> Either
      Text
      (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro, rp))
-> ([PersistValue]
    -> Either
         Text
         ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
          (rm, rn), (ro, rp)))
-> [PersistValue]
-> Either
     Text
     (ra, rb, rc, rd, re, rf, rg, rh, ri, rj, rk, rl, rm, rn, ro, rp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> Either
     Text
     ((ra, rb), (rc, rd), (re, rf), (rg, rh), (ri, rj), (rk, rl),
      (rm, rn), (ro, rp))
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow

from16P :: Proxy (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),(o,p))
from16P :: Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
-> Proxy
     ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), (o, p))
from16P = Proxy
  ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), (o, p))
-> Proxy (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
-> Proxy
     ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), (o, p))
forall a b. a -> b -> a
const Proxy
  ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), (o, p))
forall k (t :: k). Proxy t
Proxy

to16 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),(o,p)) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p)
to16 :: ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l), (m, n), (o, p))
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
to16 ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),(i
i,j
j),(k
k,l
l),(m
m,n
n),(o
o,p
p)) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p)

-- | Insert a 'PersistField' for every selected value.
--
-- @since 2.4.2
insertSelect
    :: (MonadIO m, PersistEntity a)
    => SqlQuery (SqlExpr (Insertion a))
    -> SqlWriteT m ()
insertSelect :: SqlQuery (SqlExpr (Insertion a)) -> SqlWriteT m ()
insertSelect = ReaderT backend m Int64 -> ReaderT backend m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT backend m Int64 -> ReaderT backend m ())
-> (SqlQuery (SqlExpr (Insertion a)) -> ReaderT backend m Int64)
-> SqlQuery (SqlExpr (Insertion a))
-> ReaderT backend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlQuery (SqlExpr (Insertion a)) -> ReaderT backend m Int64
forall (m :: * -> *) a.
(MonadIO m, PersistEntity a) =>
SqlQuery (SqlExpr (Insertion a)) -> SqlWriteT m Int64
insertSelectCount

-- | Insert a 'PersistField' for every selected value, return the count afterward
insertSelectCount
    :: (MonadIO m, PersistEntity a)
    => SqlQuery (SqlExpr (Insertion a))
    -> SqlWriteT m Int64
insertSelectCount :: SqlQuery (SqlExpr (Insertion a)) -> SqlWriteT m Int64
insertSelectCount = Mode -> SqlQuery (SqlExpr InsertFinal) -> ReaderT backend m Int64
forall (m :: * -> *) a r backend.
(MonadIO m, SqlSelect a r, BackendCompatible SqlBackend backend) =>
Mode -> SqlQuery a -> ReaderT backend m Int64
rawEsqueleto Mode
INSERT_INTO (SqlQuery (SqlExpr InsertFinal) -> ReaderT backend m Int64)
-> (SqlQuery (SqlExpr (Insertion a))
    -> SqlQuery (SqlExpr InsertFinal))
-> SqlQuery (SqlExpr (Insertion a))
-> ReaderT backend m Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SqlExpr (Insertion a) -> SqlExpr InsertFinal)
-> SqlQuery (SqlExpr (Insertion a))
-> SqlQuery (SqlExpr InsertFinal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SqlExpr (Insertion a) -> SqlExpr InsertFinal
forall a.
PersistEntity a =>
SqlExpr (Insertion a) -> SqlExpr InsertFinal
EInsertFinal

-- | Renders an expression into 'Text'. Only useful for creating a textual
-- representation of the clauses passed to an "On" clause.
--
-- @since 3.2.0
renderExpr :: SqlBackend -> SqlExpr (Value Bool) -> T.Text
renderExpr :: SqlBackend -> SqlExpr (Value Bool) -> Text
renderExpr SqlBackend
sqlBackend SqlExpr (Value Bool)
e = case SqlExpr (Value Bool)
e of
    ERaw NeedParens
_ IdentInfo -> (Builder, [PersistValue])
mkBuilderValues -> do
        let (Builder
builder, [PersistValue]
_) = IdentInfo -> (Builder, [PersistValue])
mkBuilderValues (SqlBackend
sqlBackend, IdentState
initialIdentState)
         in (Builder -> Text
builderToText Builder
builder)
    ECompositeKey IdentInfo -> [Builder]
mkInfo ->
        RenderExprException -> Text
forall a e. Exception e => e -> a
throw
          (RenderExprException -> Text)
-> (IdentInfo -> RenderExprException) -> IdentInfo -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RenderExprException
RenderExprUnexpectedECompositeKey
          (Text -> RenderExprException)
-> (IdentInfo -> Text) -> IdentInfo -> RenderExprException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
builderToText
          (Builder -> Text) -> (IdentInfo -> Builder) -> IdentInfo -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
          ([Builder] -> Builder)
-> (IdentInfo -> [Builder]) -> IdentInfo -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> [Builder]
mkInfo
          (IdentInfo -> Text) -> IdentInfo -> Text
forall a b. (a -> b) -> a -> b
$ (SqlBackend
sqlBackend, IdentState
initialIdentState)
    EAliasedValue Ident
i SqlExpr (Value a)
_   ->
        Builder -> Text
builderToText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ IdentInfo -> Ident -> Builder
useIdent (SqlBackend
sqlBackend, IdentState
initialIdentState) Ident
i
    EValueReference Ident
i IdentInfo -> Ident
i' ->
        let (Builder
builder, [PersistValue]
_) = Ident
-> (IdentInfo -> Ident) -> IdentInfo -> (Builder, [PersistValue])
valueReferenceToRawSql Ident
i IdentInfo -> Ident
i' (SqlBackend
sqlBackend, IdentState
initialIdentState)
         in (Builder -> Text
builderToText Builder
builder)

-- | An exception thrown by 'RenderExpr' - it's not designed to handle composite
-- keys, and will blow up if you give it one.
--
-- @since 3.2.0
data RenderExprException = RenderExprUnexpectedECompositeKey T.Text
    deriving Int -> RenderExprException -> ShowS
[RenderExprException] -> ShowS
RenderExprException -> [Char]
(Int -> RenderExprException -> ShowS)
-> (RenderExprException -> [Char])
-> ([RenderExprException] -> ShowS)
-> Show RenderExprException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RenderExprException] -> ShowS
$cshowList :: [RenderExprException] -> ShowS
show :: RenderExprException -> [Char]
$cshow :: RenderExprException -> [Char]
showsPrec :: Int -> RenderExprException -> ShowS
$cshowsPrec :: Int -> RenderExprException -> ShowS
Show

-- |
--
-- @since 3.2.0
instance Exception RenderExprException

-- | @valkey i = 'val' . 'toSqlKey'@
-- (<https://github.com/prowdsponsor/esqueleto/issues/9>).
valkey
    :: (ToBackendKey SqlBackend entity, PersistField (Key entity))
    => Int64 -> SqlExpr (Value (Key entity))
valkey :: Int64 -> SqlExpr (Value (Key entity))
valkey = Key entity -> SqlExpr (Value (Key entity))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val (Key entity -> SqlExpr (Value (Key entity)))
-> (Int64 -> Key entity) -> Int64 -> SqlExpr (Value (Key entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Key entity
forall record.
ToBackendKey SqlBackend record =>
Int64 -> Key record
toSqlKey

-- | @valJ@ is like @val@ but for something that is already a @Value@. The use
-- case it was written for was, given a @Value@ lift the @Key@ for that @Value@
-- into the query expression in a type safe way. However, the implementation is
-- more generic than that so we call it @valJ@.
--
-- Its important to note that the input entity and the output entity are
-- constrained to be the same by the type signature on the function
-- (<https://github.com/prowdsponsor/esqueleto/pull/69>).
--
-- @since 1.4.2
valJ
    :: (PersistField (Key entity))
    => Value (Key entity)
    -> SqlExpr (Value (Key entity))
valJ :: Value (Key entity) -> SqlExpr (Value (Key entity))
valJ = Key entity -> SqlExpr (Value (Key entity))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val (Key entity -> SqlExpr (Value (Key entity)))
-> (Value (Key entity) -> Key entity)
-> Value (Key entity)
-> SqlExpr (Value (Key entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value (Key entity) -> Key entity
forall a. Value a -> a
unValue


-- | Synonym for 'Database.Persist.Store.delete' that does not
-- clash with @esqueleto@'s 'delete'.
deleteKey
    ::
    ( PersistStore backend
    , BaseBackend backend ~ PersistEntityBackend val
    , MonadIO m
    , PersistEntity val
    )
    => Key val
    -> R.ReaderT backend m ()
deleteKey :: Key val -> ReaderT backend m ()
deleteKey = Key val -> ReaderT backend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
Database.Persist.delete

-- | Avoid N+1 queries and join entities into a map structure
-- @
-- getFoosAndNestedBarsFromParent :: ParentId -> (Map (Key Foo) (Foo, [Maybe (Entity Bar)]))
-- getFoosAndNestedBarsFromParent parentId = 'fmap' associateJoin $ 'select' $
-- 'from' $ \\(foo `'LeftOuterJoin`` bar) -> do
--   'on' (bar '?.' BarFooId '==.' foo '^.' FooId)
--   'where_' (foo '^.' FooParentId '==.' 'val' parentId)
--   'pure' (foo, bar)
-- @
--
-- @since 3.1.2
associateJoin
    :: forall e1 e0.  Ord (Key e0)
    => [(Entity e0, e1)]
    -> Map.Map (Key e0) (e0, [e1])
associateJoin :: [(Entity e0, e1)] -> Map (Key e0) (e0, [e1])
associateJoin = ((Entity e0, e1)
 -> Map (Key e0) (e0, [e1]) -> Map (Key e0) (e0, [e1]))
-> Map (Key e0) (e0, [e1])
-> [(Entity e0, e1)]
-> Map (Key e0) (e0, [e1])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Entity e0, e1)
-> Map (Key e0) (e0, [e1]) -> Map (Key e0) (e0, [e1])
forall a a.
Ord (Key a) =>
(Entity a, a) -> Map (Key a) (a, [a]) -> Map (Key a) (a, [a])
f Map (Key e0) (e0, [e1])
forall k a. Map k a
start
  where
    start :: Map k a
start = Map k a
forall k a. Map k a
Map.empty
    f :: (Entity a, a) -> Map (Key a) (a, [a]) -> Map (Key a) (a, [a])
f (Entity a
one, a
many) =
        ((a, [a]) -> (a, [a]) -> (a, [a]))
-> Key a
-> (a, [a])
-> Map (Key a) (a, [a])
-> Map (Key a) (a, [a])
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith
            (\(a
oneOld, [a]
manyOld) (a
_, [a]
manyNew) -> (a
oneOld, [a]
manyNew [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
manyOld ))
            (Entity a -> Key a
forall record. Entity record -> Key record
entityKey Entity a
one)
            (Entity a -> a
forall record. Entity record -> record
entityVal Entity a
one, [a
many])