module Database.PostgreSQL.PQTypes.SQL.Builder
( sqlWhere
, sqlWhereE
, sqlWhereEV
, sqlWhereEVV
, sqlWhereEVVV
, sqlWhereEVVVV
, sqlWhereEq
, sqlWhereEqE
, sqlWhereEqSql
, sqlWhereNotEq
, sqlWhereNotEqE
, sqlWhereIn
, sqlWhereInSql
, sqlWhereInE
, sqlWhereNotIn
, sqlWhereNotInSql
, sqlWhereNotInE
, sqlWhereExists
, sqlWhereNotExists
, sqlWhereLike
, sqlWhereLikeE
, sqlWhereILike
, sqlWhereILikeE
, sqlWhereIsNULL
, sqlWhereIsNotNULL
, sqlWhereIsNULLE
, sqlIgnore
, sqlFrom
, sqlJoin
, sqlJoinOn
, sqlLeftJoinOn
, sqlRightJoinOn
, sqlFullJoinOn
, sqlOnConflictDoNothing
, sqlOnConflictOnColumns
, sqlOnConflictOnColumnsDoNothing
, sqlSet
, sqlSetInc
, sqlSetList
, sqlSetListWithDefaults
, sqlSetCmd
, sqlSetCmdList
, sqlCopyColumn
, sqlResult
, sqlOrderBy
, sqlGroupBy
, sqlHaving
, sqlOffset
, sqlLimit
, sqlDistinct
, sqlWith
, sqlUnion
, SqlTurnIntoSelect
, sqlTurnIntoSelect
, sqlTurnIntoWhyNotSelect
, sqlSelect
, sqlSelect2
, SqlSelect(..)
, sqlInsert
, SqlInsert(..)
, sqlInsertSelect
, SqlInsertSelect(..)
, sqlUpdate
, SqlUpdate(..)
, sqlDelete
, SqlDelete(..)
, sqlWhereAny
, sqlWhereAnyE
, SqlResult
, SqlSet
, SqlFrom
, SqlWhere
, SqlOrderBy
, SqlGroupByHaving
, SqlOffsetLimit
, SqlDistinct
, SqlCondition(..)
, sqlGetWhereConditions
, SqlWhyNot(..)
, kWhyNot1
, kRun1OrThrowWhyNot
, kRun1OrThrowWhyNotAllowIgnore
, kRunManyOrThrowWhyNot
, kRunAndFetch1OrThrowWhyNot
, DBExtraException(..)
, SomeDBExtraException(..)
, catchDBExtraException
, DBBaseLineConditionIsFalse(..)
, Sqlable(..)
, sqlOR
, sqlConcatComma
, sqlConcatAND
, sqlConcatOR
, parenthesize
, AscDesc(..)
)
where
import Control.Exception.Lifted as E
import Control.Monad.Catch
import Control.Monad.State
import Control.Monad.Trans.Control
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Monoid.Utils
import Data.String
import Data.Typeable
import Database.PostgreSQL.PQTypes
import Prelude
import Safe (atMay)
import qualified Text.JSON.Gen as JSON
class Sqlable a where
toSQLCommand :: a -> SQL
instance Sqlable SQL where
toSQLCommand :: SQL -> SQL
toSQLCommand = SQL -> SQL
forall a. a -> a
id
smintercalate :: (IsString m, Monoid m) => m -> [m] -> m
smintercalate :: m -> [m] -> m
smintercalate m
m = m -> [m] -> m
forall m. Monoid m => m -> [m] -> m
mintercalate (m -> [m] -> m) -> m -> [m] -> m
forall a b. (a -> b) -> a -> b
$ [m] -> m
forall a. Monoid a => [a] -> a
mconcat [m
forall m. (IsString m, Monoid m) => m
mspace, m
m, m
forall m. (IsString m, Monoid m) => m
mspace]
sqlOR :: SQL -> SQL -> SQL
sqlOR :: SQL -> SQL -> SQL
sqlOR SQL
s1 SQL
s2 = [SQL] -> SQL
sqlConcatOR [SQL
s1, SQL
s2]
sqlConcatComma :: [SQL] -> SQL
sqlConcatComma :: [SQL] -> SQL
sqlConcatComma = SQL -> [SQL] -> SQL
forall m. Monoid m => m -> [m] -> m
mintercalate SQL
", "
sqlConcatAND :: [SQL] -> SQL
sqlConcatAND :: [SQL] -> SQL
sqlConcatAND = SQL -> [SQL] -> SQL
forall m. (IsString m, Monoid m) => m -> [m] -> m
smintercalate SQL
"AND" ([SQL] -> SQL) -> ([SQL] -> [SQL]) -> [SQL] -> SQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SQL -> SQL) -> [SQL] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map SQL -> SQL
parenthesize
sqlConcatOR :: [SQL] -> SQL
sqlConcatOR :: [SQL] -> SQL
sqlConcatOR = SQL -> [SQL] -> SQL
forall m. (IsString m, Monoid m) => m -> [m] -> m
smintercalate SQL
"OR" ([SQL] -> SQL) -> ([SQL] -> [SQL]) -> [SQL] -> SQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SQL -> SQL) -> [SQL] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map SQL -> SQL
parenthesize
parenthesize :: SQL -> SQL
parenthesize :: SQL -> SQL
parenthesize SQL
s = SQL
"(" SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> SQL
s SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> SQL
")"
data AscDesc a = Asc a | Desc a
deriving (AscDesc a -> AscDesc a -> Bool
(AscDesc a -> AscDesc a -> Bool)
-> (AscDesc a -> AscDesc a -> Bool) -> Eq (AscDesc a)
forall a. Eq a => AscDesc a -> AscDesc a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AscDesc a -> AscDesc a -> Bool
$c/= :: forall a. Eq a => AscDesc a -> AscDesc a -> Bool
== :: AscDesc a -> AscDesc a -> Bool
$c== :: forall a. Eq a => AscDesc a -> AscDesc a -> Bool
Eq, Int -> AscDesc a -> ShowS
[AscDesc a] -> ShowS
AscDesc a -> String
(Int -> AscDesc a -> ShowS)
-> (AscDesc a -> String)
-> ([AscDesc a] -> ShowS)
-> Show (AscDesc a)
forall a. Show a => Int -> AscDesc a -> ShowS
forall a. Show a => [AscDesc a] -> ShowS
forall a. Show a => AscDesc a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AscDesc a] -> ShowS
$cshowList :: forall a. Show a => [AscDesc a] -> ShowS
show :: AscDesc a -> String
$cshow :: forall a. Show a => AscDesc a -> String
showsPrec :: Int -> AscDesc a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AscDesc a -> ShowS
Show)
data Multiplicity a = Single a | Many [a]
deriving (Multiplicity a -> Multiplicity a -> Bool
(Multiplicity a -> Multiplicity a -> Bool)
-> (Multiplicity a -> Multiplicity a -> Bool)
-> Eq (Multiplicity a)
forall a. Eq a => Multiplicity a -> Multiplicity a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Multiplicity a -> Multiplicity a -> Bool
$c/= :: forall a. Eq a => Multiplicity a -> Multiplicity a -> Bool
== :: Multiplicity a -> Multiplicity a -> Bool
$c== :: forall a. Eq a => Multiplicity a -> Multiplicity a -> Bool
Eq, Eq (Multiplicity a)
Eq (Multiplicity a)
-> (Multiplicity a -> Multiplicity a -> Ordering)
-> (Multiplicity a -> Multiplicity a -> Bool)
-> (Multiplicity a -> Multiplicity a -> Bool)
-> (Multiplicity a -> Multiplicity a -> Bool)
-> (Multiplicity a -> Multiplicity a -> Bool)
-> (Multiplicity a -> Multiplicity a -> Multiplicity a)
-> (Multiplicity a -> Multiplicity a -> Multiplicity a)
-> Ord (Multiplicity a)
Multiplicity a -> Multiplicity a -> Bool
Multiplicity a -> Multiplicity a -> Ordering
Multiplicity a -> Multiplicity a -> Multiplicity 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 (Multiplicity a)
forall a. Ord a => Multiplicity a -> Multiplicity a -> Bool
forall a. Ord a => Multiplicity a -> Multiplicity a -> Ordering
forall a.
Ord a =>
Multiplicity a -> Multiplicity a -> Multiplicity a
min :: Multiplicity a -> Multiplicity a -> Multiplicity a
$cmin :: forall a.
Ord a =>
Multiplicity a -> Multiplicity a -> Multiplicity a
max :: Multiplicity a -> Multiplicity a -> Multiplicity a
$cmax :: forall a.
Ord a =>
Multiplicity a -> Multiplicity a -> Multiplicity a
>= :: Multiplicity a -> Multiplicity a -> Bool
$c>= :: forall a. Ord a => Multiplicity a -> Multiplicity a -> Bool
> :: Multiplicity a -> Multiplicity a -> Bool
$c> :: forall a. Ord a => Multiplicity a -> Multiplicity a -> Bool
<= :: Multiplicity a -> Multiplicity a -> Bool
$c<= :: forall a. Ord a => Multiplicity a -> Multiplicity a -> Bool
< :: Multiplicity a -> Multiplicity a -> Bool
$c< :: forall a. Ord a => Multiplicity a -> Multiplicity a -> Bool
compare :: Multiplicity a -> Multiplicity a -> Ordering
$ccompare :: forall a. Ord a => Multiplicity a -> Multiplicity a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Multiplicity a)
Ord, Int -> Multiplicity a -> ShowS
[Multiplicity a] -> ShowS
Multiplicity a -> String
(Int -> Multiplicity a -> ShowS)
-> (Multiplicity a -> String)
-> ([Multiplicity a] -> ShowS)
-> Show (Multiplicity a)
forall a. Show a => Int -> Multiplicity a -> ShowS
forall a. Show a => [Multiplicity a] -> ShowS
forall a. Show a => Multiplicity a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Multiplicity a] -> ShowS
$cshowList :: forall a. Show a => [Multiplicity a] -> ShowS
show :: Multiplicity a -> String
$cshow :: forall a. Show a => Multiplicity a -> String
showsPrec :: Int -> Multiplicity a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Multiplicity a -> ShowS
Show, Typeable)
data SqlCondition = SqlPlainCondition SQL SqlWhyNot
| SqlExistsCondition SqlSelect
deriving (Typeable, Int -> SqlCondition -> ShowS
[SqlCondition] -> ShowS
SqlCondition -> String
(Int -> SqlCondition -> ShowS)
-> (SqlCondition -> String)
-> ([SqlCondition] -> ShowS)
-> Show SqlCondition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SqlCondition] -> ShowS
$cshowList :: [SqlCondition] -> ShowS
show :: SqlCondition -> String
$cshow :: SqlCondition -> String
showsPrec :: Int -> SqlCondition -> ShowS
$cshowsPrec :: Int -> SqlCondition -> ShowS
Show)
data SqlWhyNot =
forall e row. (FromRow row, DBExtraException e) =>
SqlWhyNot Bool (row -> e) [SQL]
instance Show SqlWhyNot where
show :: SqlWhyNot -> String
show (SqlWhyNot Bool
_important row -> e
exc [SQL]
expr) = String
"SqlWhyNot " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show (e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (row -> e
exc (row -> e) -> row -> e
forall a b. (a -> b) -> a -> b
$row
forall a. HasCallStack => a
undefined)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [SQL] -> String
forall a. Show a => a -> String
show [SQL]
expr
instance Sqlable SqlCondition where
toSQLCommand :: SqlCondition -> SQL
toSQLCommand (SqlPlainCondition SQL
a SqlWhyNot
_) = SQL
a
toSQLCommand (SqlExistsCondition SqlSelect
a) = SQL
"EXISTS (" SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> SqlSelect -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand (SqlSelect
a { sqlSelectResult :: [SQL]
sqlSelectResult = [SQL
"TRUE"] }) SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> SQL
")"
data SqlSelect = SqlSelect
{ SqlSelect -> SQL
sqlSelectFrom :: SQL
, SqlSelect -> [SQL]
sqlSelectUnion :: [SQL]
, SqlSelect -> Bool
sqlSelectDistinct :: Bool
, SqlSelect -> [SQL]
sqlSelectResult :: [SQL]
, SqlSelect -> [SqlCondition]
sqlSelectWhere :: [SqlCondition]
, SqlSelect -> [SQL]
sqlSelectOrderBy :: [SQL]
, SqlSelect -> [SQL]
sqlSelectGroupBy :: [SQL]
, SqlSelect -> [SQL]
sqlSelectHaving :: [SQL]
, SqlSelect -> Integer
sqlSelectOffset :: Integer
, SqlSelect -> Integer
sqlSelectLimit :: Integer
, SqlSelect -> [(SQL, SQL)]
sqlSelectWith :: [(SQL, SQL)]
}
data SqlUpdate = SqlUpdate
{ SqlUpdate -> SQL
sqlUpdateWhat :: SQL
, SqlUpdate -> SQL
sqlUpdateFrom :: SQL
, SqlUpdate -> [SqlCondition]
sqlUpdateWhere :: [SqlCondition]
, SqlUpdate -> [(SQL, SQL)]
sqlUpdateSet :: [(SQL,SQL)]
, SqlUpdate -> [SQL]
sqlUpdateResult :: [SQL]
, SqlUpdate -> [(SQL, SQL)]
sqlUpdateWith :: [(SQL, SQL)]
}
data SqlInsert = SqlInsert
{ SqlInsert -> SQL
sqlInsertWhat :: SQL
, SqlInsert -> Maybe (SQL, Maybe SQL)
sqlInsertOnConflict :: Maybe (SQL, Maybe SQL)
, SqlInsert -> [(SQL, Multiplicity SQL)]
sqlInsertSet :: [(SQL, Multiplicity SQL)]
, SqlInsert -> [SQL]
sqlInsertResult :: [SQL]
, SqlInsert -> [(SQL, SQL)]
sqlInsertWith :: [(SQL, SQL)]
}
data SqlInsertSelect = SqlInsertSelect
{ SqlInsertSelect -> SQL
sqlInsertSelectWhat :: SQL
, SqlInsertSelect -> Bool
sqlInsertSelectDistinct :: Bool
, SqlInsertSelect -> [(SQL, SQL)]
sqlInsertSelectSet :: [(SQL, SQL)]
, SqlInsertSelect -> [SQL]
sqlInsertSelectResult :: [SQL]
, SqlInsertSelect -> SQL
sqlInsertSelectFrom :: SQL
, SqlInsertSelect -> [SqlCondition]
sqlInsertSelectWhere :: [SqlCondition]
, SqlInsertSelect -> [SQL]
sqlInsertSelectOrderBy :: [SQL]
, SqlInsertSelect -> [SQL]
sqlInsertSelectGroupBy :: [SQL]
, SqlInsertSelect -> [SQL]
sqlInsertSelectHaving :: [SQL]
, SqlInsertSelect -> Integer
sqlInsertSelectOffset :: Integer
, SqlInsertSelect -> Integer
sqlInsertSelectLimit :: Integer
, SqlInsertSelect -> [(SQL, SQL)]
sqlInsertSelectWith :: [(SQL, SQL)]
}
data SqlDelete = SqlDelete
{ SqlDelete -> SQL
sqlDeleteFrom :: SQL
, SqlDelete -> SQL
sqlDeleteUsing :: SQL
, SqlDelete -> [SqlCondition]
sqlDeleteWhere :: [SqlCondition]
, SqlDelete -> [SQL]
sqlDeleteResult :: [SQL]
, SqlDelete -> [(SQL, SQL)]
sqlDeleteWith :: [(SQL, SQL)]
}
data SqlAll = SqlAll
{ SqlAll -> [SqlCondition]
sqlAllWhere :: [SqlCondition]
}
instance Show SqlSelect where
show :: SqlSelect -> String
show = SQL -> String
forall a. Show a => a -> String
show (SQL -> String) -> (SqlSelect -> SQL) -> SqlSelect -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlSelect -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand
instance Show SqlInsert where
show :: SqlInsert -> String
show = SQL -> String
forall a. Show a => a -> String
show (SQL -> String) -> (SqlInsert -> SQL) -> SqlInsert -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsert -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand
instance Show SqlInsertSelect where
show :: SqlInsertSelect -> String
show = SQL -> String
forall a. Show a => a -> String
show (SQL -> String)
-> (SqlInsertSelect -> SQL) -> SqlInsertSelect -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsertSelect -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand
instance Show SqlUpdate where
show :: SqlUpdate -> String
show = SQL -> String
forall a. Show a => a -> String
show (SQL -> String) -> (SqlUpdate -> SQL) -> SqlUpdate -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand
instance Show SqlDelete where
show :: SqlDelete -> String
show = SQL -> String
forall a. Show a => a -> String
show (SQL -> String) -> (SqlDelete -> SQL) -> SqlDelete -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlDelete -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand
instance Show SqlAll where
show :: SqlAll -> String
show = SQL -> String
forall a. Show a => a -> String
show (SQL -> String) -> (SqlAll -> SQL) -> SqlAll -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlAll -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand
emitClause :: Sqlable sql => SQL -> sql -> SQL
emitClause :: SQL -> sql -> SQL
emitClause SQL
name sql
s = case sql -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand sql
s of
SQL
sql
| SQL -> Bool
isSqlEmpty SQL
sql -> SQL
""
| Bool
otherwise -> SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
sql
emitClausesSep :: SQL -> SQL -> [SQL] -> SQL
emitClausesSep :: SQL -> SQL -> [SQL] -> SQL
emitClausesSep SQL
_name SQL
_sep [] = SQL
forall a. Monoid a => a
mempty
emitClausesSep SQL
name SQL
sep [SQL]
sqls = SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> [SQL] -> SQL
forall m. (IsString m, Monoid m) => m -> [m] -> m
smintercalate SQL
sep ((SQL -> Bool) -> [SQL] -> [SQL]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (SQL -> Bool) -> SQL -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQL -> Bool
isSqlEmpty) ([SQL] -> [SQL]) -> [SQL] -> [SQL]
forall a b. (a -> b) -> a -> b
$ (SQL -> SQL) -> [SQL] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map SQL -> SQL
parenthesize [SQL]
sqls)
emitClausesSepComma :: SQL -> [SQL] -> SQL
emitClausesSepComma :: SQL -> [SQL] -> SQL
emitClausesSepComma SQL
_name [] = SQL
forall a. Monoid a => a
mempty
emitClausesSepComma SQL
name [SQL]
sqls = SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> [SQL] -> SQL
sqlConcatComma ((SQL -> Bool) -> [SQL] -> [SQL]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (SQL -> Bool) -> SQL -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQL -> Bool
isSqlEmpty) [SQL]
sqls)
instance IsSQL SqlSelect where
withSQL :: SqlSelect
-> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
withSQL = SQL -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
forall sql r.
IsSQL sql =>
sql -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
withSQL (SQL -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r)
-> (SqlSelect -> SQL)
-> SqlSelect
-> ParamAllocator
-> (Ptr PGparam -> CString -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlSelect -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand
instance IsSQL SqlInsert where
withSQL :: SqlInsert
-> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
withSQL = SQL -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
forall sql r.
IsSQL sql =>
sql -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
withSQL (SQL -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r)
-> (SqlInsert -> SQL)
-> SqlInsert
-> ParamAllocator
-> (Ptr PGparam -> CString -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsert -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand
instance IsSQL SqlInsertSelect where
withSQL :: SqlInsertSelect
-> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
withSQL = SQL -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
forall sql r.
IsSQL sql =>
sql -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
withSQL (SQL -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r)
-> (SqlInsertSelect -> SQL)
-> SqlInsertSelect
-> ParamAllocator
-> (Ptr PGparam -> CString -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsertSelect -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand
instance IsSQL SqlUpdate where
withSQL :: SqlUpdate
-> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
withSQL = SQL -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
forall sql r.
IsSQL sql =>
sql -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
withSQL (SQL -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r)
-> (SqlUpdate -> SQL)
-> SqlUpdate
-> ParamAllocator
-> (Ptr PGparam -> CString -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand
instance IsSQL SqlDelete where
withSQL :: SqlDelete
-> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
withSQL = SQL -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
forall sql r.
IsSQL sql =>
sql -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r
withSQL (SQL -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r)
-> (SqlDelete -> SQL)
-> SqlDelete
-> ParamAllocator
-> (Ptr PGparam -> CString -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlDelete -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand
instance Sqlable SqlSelect where
toSQLCommand :: SqlSelect -> SQL
toSQLCommand SqlSelect
cmd = [SQL] -> SQL
forall m. (IsString m, Monoid m) => [m] -> m
smconcat
[ SQL -> [SQL] -> SQL
emitClausesSepComma SQL
"WITH" ([SQL] -> SQL) -> [SQL] -> SQL
forall a b. (a -> b) -> a -> b
$
((SQL, SQL) -> SQL) -> [(SQL, SQL)] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (\(SQL
name,SQL
command) -> SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"AS" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> SQL
parenthesize SQL
command) (SqlSelect -> [(SQL, SQL)]
sqlSelectWith SqlSelect
cmd)
, if Bool
hasUnion
then SQL -> SQL -> [SQL] -> SQL
emitClausesSep SQL
"" SQL
"UNION" (SQL
mainSelectClause SQL -> [SQL] -> [SQL]
forall a. a -> [a] -> [a]
: SqlSelect -> [SQL]
sqlSelectUnion SqlSelect
cmd)
else SQL
mainSelectClause
, SQL -> [SQL] -> SQL
emitClausesSepComma SQL
"GROUP BY" (SqlSelect -> [SQL]
sqlSelectGroupBy SqlSelect
cmd)
, SQL -> SQL -> [SQL] -> SQL
emitClausesSep SQL
"HAVING" SQL
"AND" (SqlSelect -> [SQL]
sqlSelectHaving SqlSelect
cmd)
, SQL
orderByClause
, if SqlSelect -> Integer
sqlSelectOffset SqlSelect
cmd Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0
then String -> SQL
forall sql. (IsSQL sql, IsString sql) => String -> sql
unsafeSQL (String
"OFFSET " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (SqlSelect -> Integer
sqlSelectOffset SqlSelect
cmd))
else SQL
""
, if SqlSelect -> Integer
sqlSelectLimit SqlSelect
cmd Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
then SQL
limitClause
else SQL
""
]
where
mainSelectClause :: SQL
mainSelectClause = [SQL] -> SQL
forall m. (IsString m, Monoid m) => [m] -> m
smconcat
[ SQL
"SELECT" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> (if SqlSelect -> Bool
sqlSelectDistinct SqlSelect
cmd then SQL
"DISTINCT" else SQL
forall a. Monoid a => a
mempty)
, [SQL] -> SQL
sqlConcatComma (SqlSelect -> [SQL]
sqlSelectResult SqlSelect
cmd)
, SQL -> SQL -> SQL
forall sql. Sqlable sql => SQL -> sql -> SQL
emitClause SQL
"FROM" (SqlSelect -> SQL
sqlSelectFrom SqlSelect
cmd)
, SQL -> SQL -> [SQL] -> SQL
emitClausesSep SQL
"WHERE" SQL
"AND" ((SqlCondition -> SQL) -> [SqlCondition] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map SqlCondition -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand ([SqlCondition] -> [SQL]) -> [SqlCondition] -> [SQL]
forall a b. (a -> b) -> a -> b
$ SqlSelect -> [SqlCondition]
sqlSelectWhere SqlSelect
cmd)
, if Bool
hasUnion Bool -> Bool -> Bool
&& Bool -> Bool
not ([SQL] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([SQL] -> Bool) -> [SQL] -> Bool
forall a b. (a -> b) -> a -> b
$ SqlSelect -> [SQL]
sqlSelectOrderBy SqlSelect
cmd) Bool -> Bool -> Bool
&& SqlSelect -> Integer
sqlSelectLimit SqlSelect
cmd Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
then [SQL] -> SQL
forall m. (IsString m, Monoid m) => [m] -> m
smconcat [SQL
orderByClause, SQL
limitClause]
else SQL
""
]
hasUnion :: Bool
hasUnion = Bool -> Bool
not (Bool -> Bool) -> ([SQL] -> Bool) -> [SQL] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SQL] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([SQL] -> Bool) -> [SQL] -> Bool
forall a b. (a -> b) -> a -> b
$ SqlSelect -> [SQL]
sqlSelectUnion SqlSelect
cmd
orderByClause :: SQL
orderByClause = SQL -> [SQL] -> SQL
emitClausesSepComma SQL
"ORDER BY" ([SQL] -> SQL) -> [SQL] -> SQL
forall a b. (a -> b) -> a -> b
$ SqlSelect -> [SQL]
sqlSelectOrderBy SqlSelect
cmd
limitClause :: SQL
limitClause = String -> SQL
forall sql. (IsSQL sql, IsString sql) => String -> sql
unsafeSQL (String -> SQL) -> String -> SQL
forall a b. (a -> b) -> a -> b
$ String
"LIMIT" String -> ShowS
forall m. (IsString m, Monoid m) => m -> m -> m
<+> Integer -> String
forall a. Show a => a -> String
show (SqlSelect -> Integer
sqlSelectLimit SqlSelect
cmd)
instance Sqlable SqlInsert where
toSQLCommand :: SqlInsert -> SQL
toSQLCommand SqlInsert
cmd =
SQL -> [SQL] -> SQL
emitClausesSepComma SQL
"WITH" (((SQL, SQL) -> SQL) -> [(SQL, SQL)] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (\(SQL
name,SQL
command) -> SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"AS" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> SQL
parenthesize SQL
command) (SqlInsert -> [(SQL, SQL)]
sqlInsertWith SqlInsert
cmd)) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL
"INSERT INTO" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SqlInsert -> SQL
sqlInsertWhat SqlInsert
cmd SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL -> SQL
parenthesize ([SQL] -> SQL
sqlConcatComma (((SQL, Multiplicity SQL) -> SQL)
-> [(SQL, Multiplicity SQL)] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (SQL, Multiplicity SQL) -> SQL
forall a b. (a, b) -> a
fst (SqlInsert -> [(SQL, Multiplicity SQL)]
sqlInsertSet SqlInsert
cmd))) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL -> SQL -> [SQL] -> SQL
emitClausesSep SQL
"VALUES" SQL
"," (([SQL] -> SQL) -> [[SQL]] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map [SQL] -> SQL
sqlConcatComma ([[SQL]] -> [[SQL]]
forall a. [[a]] -> [[a]]
transpose (((SQL, Multiplicity SQL) -> [SQL])
-> [(SQL, Multiplicity SQL)] -> [[SQL]]
forall a b. (a -> b) -> [a] -> [b]
map (Multiplicity SQL -> [SQL]
makeLongEnough (Multiplicity SQL -> [SQL])
-> ((SQL, Multiplicity SQL) -> Multiplicity SQL)
-> (SQL, Multiplicity SQL)
-> [SQL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SQL, Multiplicity SQL) -> Multiplicity SQL
forall a b. (a, b) -> b
snd) (SqlInsert -> [(SQL, Multiplicity SQL)]
sqlInsertSet SqlInsert
cmd)))) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
Maybe (SQL, Maybe SQL) -> SQL
emitClauseOnConflict (SqlInsert -> Maybe (SQL, Maybe SQL)
sqlInsertOnConflict SqlInsert
cmd) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL -> [SQL] -> SQL
emitClausesSepComma SQL
"RETURNING" (SqlInsert -> [SQL]
sqlInsertResult SqlInsert
cmd)
where
emitClauseOnConflict :: Maybe (SQL, Maybe SQL) -> SQL
emitClauseOnConflict = \case
Maybe (SQL, Maybe SQL)
Nothing -> SQL
""
Just (SQL
condition, Maybe SQL
maction) -> SQL -> SQL -> SQL
forall sql. Sqlable sql => SQL -> sql -> SQL
emitClause SQL
"ON CONFLICT" (SQL -> SQL) -> SQL -> SQL
forall a b. (a -> b) -> a -> b
$
SQL
condition SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"DO" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> Maybe SQL -> SQL
forall a. a -> Maybe a -> a
fromMaybe SQL
"NOTHING" Maybe SQL
maction
longest :: Int
longest = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (((SQL, Multiplicity SQL) -> Int)
-> [(SQL, Multiplicity SQL)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Multiplicity SQL -> Int
forall a. Multiplicity a -> Int
lengthOfEither (Multiplicity SQL -> Int)
-> ((SQL, Multiplicity SQL) -> Multiplicity SQL)
-> (SQL, Multiplicity SQL)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SQL, Multiplicity SQL) -> Multiplicity SQL
forall a b. (a, b) -> b
snd) (SqlInsert -> [(SQL, Multiplicity SQL)]
sqlInsertSet SqlInsert
cmd)))
lengthOfEither :: Multiplicity a -> Int
lengthOfEither (Single a
_) = Int
1
lengthOfEither (Many [a]
x) = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x
makeLongEnough :: Multiplicity SQL -> [SQL]
makeLongEnough (Single SQL
x) = Int -> [SQL] -> [SQL]
forall a. Int -> [a] -> [a]
take Int
longest (SQL -> [SQL]
forall a. a -> [a]
repeat SQL
x)
makeLongEnough (Many [SQL]
x) = Int -> [SQL] -> [SQL]
forall a. Int -> [a] -> [a]
take Int
longest ([SQL]
x [SQL] -> [SQL] -> [SQL]
forall a. [a] -> [a] -> [a]
++ SQL -> [SQL]
forall a. a -> [a]
repeat SQL
"DEFAULT")
instance Sqlable SqlInsertSelect where
toSQLCommand :: SqlInsertSelect -> SQL
toSQLCommand SqlInsertSelect
cmd =
SQL
"INSERT INTO" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SqlInsertSelect -> SQL
sqlInsertSelectWhat SqlInsertSelect
cmd SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL -> SQL
parenthesize ([SQL] -> SQL
sqlConcatComma (((SQL, SQL) -> SQL) -> [(SQL, SQL)] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (SQL, SQL) -> SQL
forall a b. (a, b) -> a
fst (SqlInsertSelect -> [(SQL, SQL)]
sqlInsertSelectSet SqlInsertSelect
cmd))) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL -> SQL
parenthesize (SqlSelect -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand (SqlSelect :: SQL
-> [SQL]
-> Bool
-> [SQL]
-> [SqlCondition]
-> [SQL]
-> [SQL]
-> [SQL]
-> Integer
-> Integer
-> [(SQL, SQL)]
-> SqlSelect
SqlSelect { sqlSelectFrom :: SQL
sqlSelectFrom = SqlInsertSelect -> SQL
sqlInsertSelectFrom SqlInsertSelect
cmd
, sqlSelectUnion :: [SQL]
sqlSelectUnion = []
, sqlSelectDistinct :: Bool
sqlSelectDistinct = SqlInsertSelect -> Bool
sqlInsertSelectDistinct SqlInsertSelect
cmd
, sqlSelectResult :: [SQL]
sqlSelectResult = ((SQL, SQL) -> SQL) -> [(SQL, SQL)] -> [SQL]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SQL, SQL) -> SQL
forall a b. (a, b) -> b
snd ([(SQL, SQL)] -> [SQL]) -> [(SQL, SQL)] -> [SQL]
forall a b. (a -> b) -> a -> b
$ SqlInsertSelect -> [(SQL, SQL)]
sqlInsertSelectSet SqlInsertSelect
cmd
, sqlSelectWhere :: [SqlCondition]
sqlSelectWhere = SqlInsertSelect -> [SqlCondition]
sqlInsertSelectWhere SqlInsertSelect
cmd
, sqlSelectOrderBy :: [SQL]
sqlSelectOrderBy = SqlInsertSelect -> [SQL]
sqlInsertSelectOrderBy SqlInsertSelect
cmd
, sqlSelectGroupBy :: [SQL]
sqlSelectGroupBy = SqlInsertSelect -> [SQL]
sqlInsertSelectGroupBy SqlInsertSelect
cmd
, sqlSelectHaving :: [SQL]
sqlSelectHaving = SqlInsertSelect -> [SQL]
sqlInsertSelectHaving SqlInsertSelect
cmd
, sqlSelectOffset :: Integer
sqlSelectOffset = SqlInsertSelect -> Integer
sqlInsertSelectOffset SqlInsertSelect
cmd
, sqlSelectLimit :: Integer
sqlSelectLimit = SqlInsertSelect -> Integer
sqlInsertSelectLimit SqlInsertSelect
cmd
, sqlSelectWith :: [(SQL, SQL)]
sqlSelectWith = SqlInsertSelect -> [(SQL, SQL)]
sqlInsertSelectWith SqlInsertSelect
cmd
})) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL -> [SQL] -> SQL
emitClausesSepComma SQL
"RETURNING" (SqlInsertSelect -> [SQL]
sqlInsertSelectResult SqlInsertSelect
cmd)
instance Sqlable SqlUpdate where
toSQLCommand :: SqlUpdate -> SQL
toSQLCommand SqlUpdate
cmd =
SQL -> [SQL] -> SQL
emitClausesSepComma SQL
"WITH" (((SQL, SQL) -> SQL) -> [(SQL, SQL)] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (\(SQL
name,SQL
command) -> SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"AS" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> SQL
parenthesize SQL
command) (SqlUpdate -> [(SQL, SQL)]
sqlUpdateWith SqlUpdate
cmd)) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL
"UPDATE" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SqlUpdate -> SQL
sqlUpdateWhat SqlUpdate
cmd SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"SET" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
[SQL] -> SQL
sqlConcatComma (((SQL, SQL) -> SQL) -> [(SQL, SQL)] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (\(SQL
name, SQL
command) -> SQL
name SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> SQL
"=" SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> SQL
command) (SqlUpdate -> [(SQL, SQL)]
sqlUpdateSet SqlUpdate
cmd)) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL -> SQL -> SQL
forall sql. Sqlable sql => SQL -> sql -> SQL
emitClause SQL
"FROM" (SqlUpdate -> SQL
sqlUpdateFrom SqlUpdate
cmd) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL -> SQL -> [SQL] -> SQL
emitClausesSep SQL
"WHERE" SQL
"AND" ((SqlCondition -> SQL) -> [SqlCondition] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map SqlCondition -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand ([SqlCondition] -> [SQL]) -> [SqlCondition] -> [SQL]
forall a b. (a -> b) -> a -> b
$ SqlUpdate -> [SqlCondition]
sqlUpdateWhere SqlUpdate
cmd) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL -> [SQL] -> SQL
emitClausesSepComma SQL
"RETURNING" (SqlUpdate -> [SQL]
sqlUpdateResult SqlUpdate
cmd)
instance Sqlable SqlDelete where
toSQLCommand :: SqlDelete -> SQL
toSQLCommand SqlDelete
cmd =
SQL -> [SQL] -> SQL
emitClausesSepComma SQL
"WITH" (((SQL, SQL) -> SQL) -> [(SQL, SQL)] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (\(SQL
name,SQL
command) -> SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"AS" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> SQL
parenthesize SQL
command) (SqlDelete -> [(SQL, SQL)]
sqlDeleteWith SqlDelete
cmd)) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL
"DELETE FROM" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SqlDelete -> SQL
sqlDeleteFrom SqlDelete
cmd SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL -> SQL -> SQL
forall sql. Sqlable sql => SQL -> sql -> SQL
emitClause SQL
"USING" (SqlDelete -> SQL
sqlDeleteUsing SqlDelete
cmd) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL -> SQL -> [SQL] -> SQL
emitClausesSep SQL
"WHERE" SQL
"AND" ((SqlCondition -> SQL) -> [SqlCondition] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map SqlCondition -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand ([SqlCondition] -> [SQL]) -> [SqlCondition] -> [SQL]
forall a b. (a -> b) -> a -> b
$ SqlDelete -> [SqlCondition]
sqlDeleteWhere SqlDelete
cmd) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL -> [SQL] -> SQL
emitClausesSepComma SQL
"RETURNING" (SqlDelete -> [SQL]
sqlDeleteResult SqlDelete
cmd)
instance Sqlable SqlAll where
toSQLCommand :: SqlAll -> SQL
toSQLCommand SqlAll
cmd | [SqlCondition] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (SqlAll -> [SqlCondition]
sqlAllWhere SqlAll
cmd) = SQL
"TRUE"
toSQLCommand SqlAll
cmd =
SQL
"(" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> [SQL] -> SQL
forall m. (IsString m, Monoid m) => m -> [m] -> m
smintercalate SQL
"AND" ((SqlCondition -> SQL) -> [SqlCondition] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (SQL -> SQL
parenthesize (SQL -> SQL) -> (SqlCondition -> SQL) -> SqlCondition -> SQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlCondition -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand) (SqlAll -> [SqlCondition]
sqlAllWhere SqlAll
cmd)) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
")"
sqlSelect :: SQL -> State SqlSelect () -> SqlSelect
sqlSelect :: SQL -> State SqlSelect () -> SqlSelect
sqlSelect SQL
table State SqlSelect ()
refine =
State SqlSelect () -> SqlSelect -> SqlSelect
forall s a. State s a -> s -> s
execState State SqlSelect ()
refine (SQL
-> [SQL]
-> Bool
-> [SQL]
-> [SqlCondition]
-> [SQL]
-> [SQL]
-> [SQL]
-> Integer
-> Integer
-> [(SQL, SQL)]
-> SqlSelect
SqlSelect SQL
table [] Bool
False [] [] [] [] [] Integer
0 (-Integer
1) [])
sqlSelect2 :: SQL -> State SqlSelect () -> SqlSelect
sqlSelect2 :: SQL -> State SqlSelect () -> SqlSelect
sqlSelect2 SQL
from State SqlSelect ()
refine =
State SqlSelect () -> SqlSelect -> SqlSelect
forall s a. State s a -> s -> s
execState State SqlSelect ()
refine (SQL
-> [SQL]
-> Bool
-> [SQL]
-> [SqlCondition]
-> [SQL]
-> [SQL]
-> [SQL]
-> Integer
-> Integer
-> [(SQL, SQL)]
-> SqlSelect
SqlSelect SQL
from [] Bool
False [] [] [] [] [] Integer
0 (-Integer
1) [])
sqlInsert :: SQL -> State SqlInsert () -> SqlInsert
sqlInsert :: SQL -> State SqlInsert () -> SqlInsert
sqlInsert SQL
table State SqlInsert ()
refine =
State SqlInsert () -> SqlInsert -> SqlInsert
forall s a. State s a -> s -> s
execState State SqlInsert ()
refine (SQL
-> Maybe (SQL, Maybe SQL)
-> [(SQL, Multiplicity SQL)]
-> [SQL]
-> [(SQL, SQL)]
-> SqlInsert
SqlInsert SQL
table Maybe (SQL, Maybe SQL)
forall a. Maybe a
Nothing [(SQL, Multiplicity SQL)]
forall a. Monoid a => a
mempty [] [])
sqlInsertSelect :: SQL -> SQL -> State SqlInsertSelect () -> SqlInsertSelect
sqlInsertSelect :: SQL -> SQL -> State SqlInsertSelect () -> SqlInsertSelect
sqlInsertSelect SQL
table SQL
from State SqlInsertSelect ()
refine =
State SqlInsertSelect () -> SqlInsertSelect -> SqlInsertSelect
forall s a. State s a -> s -> s
execState State SqlInsertSelect ()
refine (SqlInsertSelect :: SQL
-> Bool
-> [(SQL, SQL)]
-> [SQL]
-> SQL
-> [SqlCondition]
-> [SQL]
-> [SQL]
-> [SQL]
-> Integer
-> Integer
-> [(SQL, SQL)]
-> SqlInsertSelect
SqlInsertSelect
{ sqlInsertSelectWhat :: SQL
sqlInsertSelectWhat = SQL
table
, sqlInsertSelectDistinct :: Bool
sqlInsertSelectDistinct = Bool
False
, sqlInsertSelectSet :: [(SQL, SQL)]
sqlInsertSelectSet = []
, sqlInsertSelectResult :: [SQL]
sqlInsertSelectResult = []
, sqlInsertSelectFrom :: SQL
sqlInsertSelectFrom = SQL
from
, sqlInsertSelectWhere :: [SqlCondition]
sqlInsertSelectWhere = []
, sqlInsertSelectOrderBy :: [SQL]
sqlInsertSelectOrderBy = []
, sqlInsertSelectGroupBy :: [SQL]
sqlInsertSelectGroupBy = []
, sqlInsertSelectHaving :: [SQL]
sqlInsertSelectHaving = []
, sqlInsertSelectOffset :: Integer
sqlInsertSelectOffset = Integer
0
, sqlInsertSelectLimit :: Integer
sqlInsertSelectLimit = -Integer
1
, sqlInsertSelectWith :: [(SQL, SQL)]
sqlInsertSelectWith = []
})
sqlUpdate :: SQL -> State SqlUpdate () -> SqlUpdate
sqlUpdate :: SQL -> State SqlUpdate () -> SqlUpdate
sqlUpdate SQL
table State SqlUpdate ()
refine =
State SqlUpdate () -> SqlUpdate -> SqlUpdate
forall s a. State s a -> s -> s
execState State SqlUpdate ()
refine (SQL
-> SQL
-> [SqlCondition]
-> [(SQL, SQL)]
-> [SQL]
-> [(SQL, SQL)]
-> SqlUpdate
SqlUpdate SQL
table SQL
forall a. Monoid a => a
mempty [] [] [] [])
sqlDelete :: SQL -> State SqlDelete () -> SqlDelete
sqlDelete :: SQL -> State SqlDelete () -> SqlDelete
sqlDelete SQL
table State SqlDelete ()
refine =
State SqlDelete () -> SqlDelete -> SqlDelete
forall s a. State s a -> s -> s
execState State SqlDelete ()
refine (SqlDelete :: SQL -> SQL -> [SqlCondition] -> [SQL] -> [(SQL, SQL)] -> SqlDelete
SqlDelete { sqlDeleteFrom :: SQL
sqlDeleteFrom = SQL
table
, sqlDeleteUsing :: SQL
sqlDeleteUsing = SQL
forall a. Monoid a => a
mempty
, sqlDeleteWhere :: [SqlCondition]
sqlDeleteWhere = []
, sqlDeleteResult :: [SQL]
sqlDeleteResult = []
, sqlDeleteWith :: [(SQL, SQL)]
sqlDeleteWith = []
})
class SqlWith a where
sqlWith1 :: a -> SQL -> SQL -> a
instance SqlWith SqlSelect where
sqlWith1 :: SqlSelect -> SQL -> SQL -> SqlSelect
sqlWith1 SqlSelect
cmd SQL
name SQL
sql = SqlSelect
cmd { sqlSelectWith :: [(SQL, SQL)]
sqlSelectWith = SqlSelect -> [(SQL, SQL)]
sqlSelectWith SqlSelect
cmd [(SQL, SQL)] -> [(SQL, SQL)] -> [(SQL, SQL)]
forall a. [a] -> [a] -> [a]
++ [(SQL
name,SQL
sql)] }
instance SqlWith SqlInsertSelect where
sqlWith1 :: SqlInsertSelect -> SQL -> SQL -> SqlInsertSelect
sqlWith1 SqlInsertSelect
cmd SQL
name SQL
sql = SqlInsertSelect
cmd { sqlInsertSelectWith :: [(SQL, SQL)]
sqlInsertSelectWith = SqlInsertSelect -> [(SQL, SQL)]
sqlInsertSelectWith SqlInsertSelect
cmd [(SQL, SQL)] -> [(SQL, SQL)] -> [(SQL, SQL)]
forall a. [a] -> [a] -> [a]
++ [(SQL
name,SQL
sql)] }
instance SqlWith SqlUpdate where
sqlWith1 :: SqlUpdate -> SQL -> SQL -> SqlUpdate
sqlWith1 SqlUpdate
cmd SQL
name SQL
sql = SqlUpdate
cmd { sqlUpdateWith :: [(SQL, SQL)]
sqlUpdateWith = SqlUpdate -> [(SQL, SQL)]
sqlUpdateWith SqlUpdate
cmd [(SQL, SQL)] -> [(SQL, SQL)] -> [(SQL, SQL)]
forall a. [a] -> [a] -> [a]
++ [(SQL
name,SQL
sql)] }
instance SqlWith SqlDelete where
sqlWith1 :: SqlDelete -> SQL -> SQL -> SqlDelete
sqlWith1 SqlDelete
cmd SQL
name SQL
sql = SqlDelete
cmd { sqlDeleteWith :: [(SQL, SQL)]
sqlDeleteWith = SqlDelete -> [(SQL, SQL)]
sqlDeleteWith SqlDelete
cmd [(SQL, SQL)] -> [(SQL, SQL)] -> [(SQL, SQL)]
forall a. [a] -> [a] -> [a]
++ [(SQL
name,SQL
sql)] }
sqlWith :: (MonadState v m, SqlWith v, Sqlable s) => SQL -> s -> m ()
sqlWith :: SQL -> s -> m ()
sqlWith SQL
name s
sql = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> SQL -> SQL -> v
forall a. SqlWith a => a -> SQL -> SQL -> a
sqlWith1 v
cmd SQL
name (s -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand s
sql))
sqlUnion :: (MonadState SqlSelect m, Sqlable sql) => [sql] -> m ()
sqlUnion :: [sql] -> m ()
sqlUnion [sql]
sqls = (SqlSelect -> SqlSelect) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\SqlSelect
cmd -> SqlSelect
cmd { sqlSelectUnion :: [SQL]
sqlSelectUnion = (sql -> SQL) -> [sql] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map sql -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand [sql]
sqls })
class SqlWhere a where
sqlWhere1 :: a -> SqlCondition -> a
sqlGetWhereConditions :: a -> [SqlCondition]
instance SqlWhere SqlSelect where
sqlWhere1 :: SqlSelect -> SqlCondition -> SqlSelect
sqlWhere1 SqlSelect
cmd SqlCondition
cond = SqlSelect
cmd { sqlSelectWhere :: [SqlCondition]
sqlSelectWhere = SqlSelect -> [SqlCondition]
sqlSelectWhere SqlSelect
cmd [SqlCondition] -> [SqlCondition] -> [SqlCondition]
forall a. [a] -> [a] -> [a]
++ [SqlCondition
cond] }
sqlGetWhereConditions :: SqlSelect -> [SqlCondition]
sqlGetWhereConditions = SqlSelect -> [SqlCondition]
sqlSelectWhere
instance SqlWhere SqlInsertSelect where
sqlWhere1 :: SqlInsertSelect -> SqlCondition -> SqlInsertSelect
sqlWhere1 SqlInsertSelect
cmd SqlCondition
cond = SqlInsertSelect
cmd { sqlInsertSelectWhere :: [SqlCondition]
sqlInsertSelectWhere = SqlInsertSelect -> [SqlCondition]
sqlInsertSelectWhere SqlInsertSelect
cmd [SqlCondition] -> [SqlCondition] -> [SqlCondition]
forall a. [a] -> [a] -> [a]
++ [SqlCondition
cond] }
sqlGetWhereConditions :: SqlInsertSelect -> [SqlCondition]
sqlGetWhereConditions = SqlInsertSelect -> [SqlCondition]
sqlInsertSelectWhere
instance SqlWhere SqlUpdate where
sqlWhere1 :: SqlUpdate -> SqlCondition -> SqlUpdate
sqlWhere1 SqlUpdate
cmd SqlCondition
cond = SqlUpdate
cmd { sqlUpdateWhere :: [SqlCondition]
sqlUpdateWhere = SqlUpdate -> [SqlCondition]
sqlUpdateWhere SqlUpdate
cmd [SqlCondition] -> [SqlCondition] -> [SqlCondition]
forall a. [a] -> [a] -> [a]
++ [SqlCondition
cond] }
sqlGetWhereConditions :: SqlUpdate -> [SqlCondition]
sqlGetWhereConditions = SqlUpdate -> [SqlCondition]
sqlUpdateWhere
instance SqlWhere SqlDelete where
sqlWhere1 :: SqlDelete -> SqlCondition -> SqlDelete
sqlWhere1 SqlDelete
cmd SqlCondition
cond = SqlDelete
cmd { sqlDeleteWhere :: [SqlCondition]
sqlDeleteWhere = SqlDelete -> [SqlCondition]
sqlDeleteWhere SqlDelete
cmd [SqlCondition] -> [SqlCondition] -> [SqlCondition]
forall a. [a] -> [a] -> [a]
++ [SqlCondition
cond] }
sqlGetWhereConditions :: SqlDelete -> [SqlCondition]
sqlGetWhereConditions = SqlDelete -> [SqlCondition]
sqlDeleteWhere
instance SqlWhere SqlAll where
sqlWhere1 :: SqlAll -> SqlCondition -> SqlAll
sqlWhere1 SqlAll
cmd SqlCondition
cond = SqlAll
cmd { sqlAllWhere :: [SqlCondition]
sqlAllWhere = SqlAll -> [SqlCondition]
sqlAllWhere SqlAll
cmd [SqlCondition] -> [SqlCondition] -> [SqlCondition]
forall a. [a] -> [a] -> [a]
++ [SqlCondition
cond] }
sqlGetWhereConditions :: SqlAll -> [SqlCondition]
sqlGetWhereConditions = SqlAll -> [SqlCondition]
sqlAllWhere
newtype SqlWhereIgnore a = SqlWhereIgnore { SqlWhereIgnore a -> a
unSqlWhereIgnore :: a }
ignoreWhereClause :: SqlCondition -> SqlCondition
ignoreWhereClause :: SqlCondition -> SqlCondition
ignoreWhereClause (SqlPlainCondition SQL
sql (SqlWhyNot Bool
_b row -> e
f [SQL]
s)) =
SQL -> SqlWhyNot -> SqlCondition
SqlPlainCondition SQL
sql (Bool -> (row -> e) -> [SQL] -> SqlWhyNot
forall e row.
(FromRow row, DBExtraException e) =>
Bool -> (row -> e) -> [SQL] -> SqlWhyNot
SqlWhyNot Bool
False row -> e
f [SQL]
s)
ignoreWhereClause (SqlExistsCondition SqlSelect
sql) =
SqlSelect -> SqlCondition
SqlExistsCondition (SqlSelect
sql { sqlSelectWhere :: [SqlCondition]
sqlSelectWhere = (SqlCondition -> SqlCondition) -> [SqlCondition] -> [SqlCondition]
forall a b. (a -> b) -> [a] -> [b]
map SqlCondition -> SqlCondition
ignoreWhereClause (SqlSelect -> [SqlCondition]
sqlSelectWhere SqlSelect
sql)})
instance (SqlWhere a) => SqlWhere (SqlWhereIgnore a) where
sqlWhere1 :: SqlWhereIgnore a -> SqlCondition -> SqlWhereIgnore a
sqlWhere1 (SqlWhereIgnore a
cmd) SqlCondition
cond =
a -> SqlWhereIgnore a
forall a. a -> SqlWhereIgnore a
SqlWhereIgnore (a -> SqlCondition -> a
forall a. SqlWhere a => a -> SqlCondition -> a
sqlWhere1 a
cmd (SqlCondition -> SqlCondition
ignoreWhereClause SqlCondition
cond))
sqlGetWhereConditions :: SqlWhereIgnore a -> [SqlCondition]
sqlGetWhereConditions (SqlWhereIgnore a
cmd) = a -> [SqlCondition]
forall a. SqlWhere a => a -> [SqlCondition]
sqlGetWhereConditions a
cmd
sqlIgnore :: (MonadState s m)
=> State (SqlWhereIgnore s) a
-> m ()
sqlIgnore :: State (SqlWhereIgnore s) a -> m ()
sqlIgnore State (SqlWhereIgnore s) a
clauses = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s
cmd -> SqlWhereIgnore s -> s
forall a. SqlWhereIgnore a -> a
unSqlWhereIgnore (State (SqlWhereIgnore s) a -> SqlWhereIgnore s -> SqlWhereIgnore s
forall s a. State s a -> s -> s
execState State (SqlWhereIgnore s) a
clauses (s -> SqlWhereIgnore s
forall a. a -> SqlWhereIgnore a
SqlWhereIgnore s
cmd)))
sqlWhere :: (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere :: SQL -> m ()
sqlWhere SQL
sql = DBBaseLineConditionIsFalse -> SQL -> m ()
forall v (m :: * -> *) e.
(MonadState v m, SqlWhere v, DBExtraException e) =>
e -> SQL -> m ()
sqlWhereE (SQL -> DBBaseLineConditionIsFalse
DBBaseLineConditionIsFalse SQL
sql) SQL
sql
sqlWhereE :: (MonadState v m, SqlWhere v, DBExtraException e) => e -> SQL -> m ()
sqlWhereE :: e -> SQL -> m ()
sqlWhereE e
exc SQL
sql = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> SqlCondition -> v
forall a. SqlWhere a => a -> SqlCondition -> a
sqlWhere1 v
cmd (SQL -> SqlWhyNot -> SqlCondition
SqlPlainCondition SQL
sql (Bool -> (() -> e) -> [SQL] -> SqlWhyNot
forall e row.
(FromRow row, DBExtraException e) =>
Bool -> (row -> e) -> [SQL] -> SqlWhyNot
SqlWhyNot Bool
True () -> e
exc2 [])))
where
exc2 :: () -> e
exc2 (()
_::()) = e
exc
sqlWhereEV :: (MonadState v m, SqlWhere v, DBExtraException e, FromSQL a) => (a -> e, SQL) -> SQL -> m ()
sqlWhereEV :: (a -> e, SQL) -> SQL -> m ()
sqlWhereEV (a -> e
exc, SQL
vsql) SQL
sql = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> SqlCondition -> v
forall a. SqlWhere a => a -> SqlCondition -> a
sqlWhere1 v
cmd (SQL -> SqlWhyNot -> SqlCondition
SqlPlainCondition SQL
sql (Bool -> (Identity a -> e) -> [SQL] -> SqlWhyNot
forall e row.
(FromRow row, DBExtraException e) =>
Bool -> (row -> e) -> [SQL] -> SqlWhyNot
SqlWhyNot Bool
True Identity a -> e
exc2 [SQL
vsql])))
where
exc2 :: Identity a -> e
exc2 (Identity a
v1) = a -> e
exc a
v1
sqlWhereEVV :: (MonadState v m, SqlWhere v, DBExtraException e, FromSQL a, FromSQL b) => (a -> b -> e, SQL, SQL) -> SQL -> m ()
sqlWhereEVV :: (a -> b -> e, SQL, SQL) -> SQL -> m ()
sqlWhereEVV (a -> b -> e
exc, SQL
vsql1, SQL
vsql2) SQL
sql = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> SqlCondition -> v
forall a. SqlWhere a => a -> SqlCondition -> a
sqlWhere1 v
cmd (SQL -> SqlWhyNot -> SqlCondition
SqlPlainCondition SQL
sql (Bool -> ((a, b) -> e) -> [SQL] -> SqlWhyNot
forall e row.
(FromRow row, DBExtraException e) =>
Bool -> (row -> e) -> [SQL] -> SqlWhyNot
SqlWhyNot Bool
True (a, b) -> e
exc2 [SQL
vsql1, SQL
vsql2])))
where
exc2 :: (a, b) -> e
exc2 (a
v1, b
v2) = a -> b -> e
exc a
v1 b
v2
sqlWhereEVVV :: (MonadState v m, SqlWhere v, DBExtraException e, FromSQL a, FromSQL b, FromSQL c) => (a -> b -> c -> e, SQL, SQL, SQL) -> SQL -> m ()
sqlWhereEVVV :: (a -> b -> c -> e, SQL, SQL, SQL) -> SQL -> m ()
sqlWhereEVVV (a -> b -> c -> e
exc, SQL
vsql1, SQL
vsql2, SQL
vsql3) SQL
sql = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> SqlCondition -> v
forall a. SqlWhere a => a -> SqlCondition -> a
sqlWhere1 v
cmd (SQL -> SqlWhyNot -> SqlCondition
SqlPlainCondition SQL
sql (Bool -> ((a, b, c) -> e) -> [SQL] -> SqlWhyNot
forall e row.
(FromRow row, DBExtraException e) =>
Bool -> (row -> e) -> [SQL] -> SqlWhyNot
SqlWhyNot Bool
True (a, b, c) -> e
exc2 [SQL
vsql1, SQL
vsql2, SQL
vsql3])))
where
exc2 :: (a, b, c) -> e
exc2 (a
v1, b
v2, c
v3) = a -> b -> c -> e
exc a
v1 b
v2 c
v3
sqlWhereEVVVV :: (MonadState v m, SqlWhere v, DBExtraException e, FromSQL a, FromSQL b, FromSQL c, FromSQL d) => (a -> b -> c -> d -> e, SQL, SQL, SQL, SQL) -> SQL -> m ()
sqlWhereEVVVV :: (a -> b -> c -> d -> e, SQL, SQL, SQL, SQL) -> SQL -> m ()
sqlWhereEVVVV (a -> b -> c -> d -> e
exc, SQL
vsql1, SQL
vsql2, SQL
vsql3, SQL
vsql4) SQL
sql = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> SqlCondition -> v
forall a. SqlWhere a => a -> SqlCondition -> a
sqlWhere1 v
cmd (SQL -> SqlWhyNot -> SqlCondition
SqlPlainCondition SQL
sql (Bool -> ((a, b, c, d) -> e) -> [SQL] -> SqlWhyNot
forall e row.
(FromRow row, DBExtraException e) =>
Bool -> (row -> e) -> [SQL] -> SqlWhyNot
SqlWhyNot Bool
True (a, b, c, d) -> e
exc2 [SQL
vsql1, SQL
vsql2, SQL
vsql3, SQL
vsql4])))
where
exc2 :: (a, b, c, d) -> e
exc2 (a
v1, b
v2, c
v3, d
v4) = a -> b -> c -> d -> e
exc a
v1 b
v2 c
v3 d
v4
sqlWhereEq :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> a -> m ()
sqlWhereEq :: SQL -> a -> m ()
sqlWhereEq SQL
name a
value = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"=" SQL -> a -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> a
value
sqlWhereEqE :: (MonadState v m, SqlWhere v, DBExtraException e, Show a, FromSQL a, ToSQL a)
=> (a -> a -> e) -> SQL -> a -> m ()
sqlWhereEqE :: (a -> a -> e) -> SQL -> a -> m ()
sqlWhereEqE a -> a -> e
exc SQL
name a
value = (a -> e, SQL) -> SQL -> m ()
forall v (m :: * -> *) e a.
(MonadState v m, SqlWhere v, DBExtraException e, FromSQL a) =>
(a -> e, SQL) -> SQL -> m ()
sqlWhereEV (a -> a -> e
exc a
value, SQL
name) (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"=" SQL -> a -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> a
value
sqlWhereEqSql :: (MonadState v m, SqlWhere v, Sqlable sql) => SQL -> sql -> m ()
sqlWhereEqSql :: SQL -> sql -> m ()
sqlWhereEqSql SQL
name1 sql
name2 = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name1 SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"=" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> sql -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand sql
name2
sqlWhereNotEq :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> a -> m ()
sqlWhereNotEq :: SQL -> a -> m ()
sqlWhereNotEq SQL
name a
value = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"<>" SQL -> a -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> a
value
sqlWhereNotEqE :: (MonadState v m, SqlWhere v, DBExtraException e, Show a, ToSQL a, FromSQL a)
=> (a -> a -> e) -> SQL -> a -> m ()
sqlWhereNotEqE :: (a -> a -> e) -> SQL -> a -> m ()
sqlWhereNotEqE a -> a -> e
exc SQL
name a
value = (a -> e, SQL) -> SQL -> m ()
forall v (m :: * -> *) e a.
(MonadState v m, SqlWhere v, DBExtraException e, FromSQL a) =>
(a -> e, SQL) -> SQL -> m ()
sqlWhereEV (a -> a -> e
exc a
value, SQL
name) (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"<>" SQL -> a -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> a
value
sqlWhereLike :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> a -> m ()
sqlWhereLike :: SQL -> a -> m ()
sqlWhereLike SQL
name a
value = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"LIKE" SQL -> a -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> a
value
sqlWhereLikeE :: (MonadState v m, SqlWhere v, DBExtraException e, Show a, ToSQL a, FromSQL a)
=> (a -> a -> e) -> SQL -> a -> m ()
sqlWhereLikeE :: (a -> a -> e) -> SQL -> a -> m ()
sqlWhereLikeE a -> a -> e
exc SQL
name a
value = (a -> e, SQL) -> SQL -> m ()
forall v (m :: * -> *) e a.
(MonadState v m, SqlWhere v, DBExtraException e, FromSQL a) =>
(a -> e, SQL) -> SQL -> m ()
sqlWhereEV (a -> a -> e
exc a
value, SQL
name) (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"LIKE" SQL -> a -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> a
value
sqlWhereILike :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> a -> m ()
sqlWhereILike :: SQL -> a -> m ()
sqlWhereILike SQL
name a
value = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"ILIKE" SQL -> a -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> a
value
sqlWhereILikeE :: (MonadState v m, SqlWhere v, DBExtraException e, Show a, ToSQL a, FromSQL a)
=> (a -> a -> e) -> SQL -> a -> m ()
sqlWhereILikeE :: (a -> a -> e) -> SQL -> a -> m ()
sqlWhereILikeE a -> a -> e
exc SQL
name a
value = (a -> e, SQL) -> SQL -> m ()
forall v (m :: * -> *) e a.
(MonadState v m, SqlWhere v, DBExtraException e, FromSQL a) =>
(a -> e, SQL) -> SQL -> m ()
sqlWhereEV (a -> a -> e
exc a
value, SQL
name) (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"ILIKE" SQL -> a -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> a
value
sqlWhereIn :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> [a] -> m ()
sqlWhereIn :: SQL -> [a] -> m ()
sqlWhereIn SQL
_name [] = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere SQL
"FALSE"
sqlWhereIn SQL
name [a
value] = SQL -> a -> m ()
forall v (m :: * -> *) a.
(MonadState v m, SqlWhere v, Show a, ToSQL a) =>
SQL -> a -> m ()
sqlWhereEq SQL
name a
value
sqlWhereIn SQL
name [a]
values = do
SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"IN (SELECT UNNEST(" SQL -> Array1 a -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> [a] -> Array1 a
forall a. [a] -> Array1 a
Array1 [a]
values SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"))"
sqlWhereInSql :: (MonadState v m, Sqlable a, SqlWhere v) => SQL -> a -> m ()
sqlWhereInSql :: SQL -> a -> m ()
sqlWhereInSql SQL
name a
sql = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"IN" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> SQL
parenthesize (a -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand a
sql)
sqlWhereInE :: (MonadState v m, SqlWhere v, DBExtraException e, Show a, ToSQL a, FromSQL a)
=> ([a] -> a -> e) -> SQL -> [a] -> m ()
sqlWhereInE :: ([a] -> a -> e) -> SQL -> [a] -> m ()
sqlWhereInE [a] -> a -> e
exc SQL
name [] = (a -> e, SQL) -> SQL -> m ()
forall v (m :: * -> *) e a.
(MonadState v m, SqlWhere v, DBExtraException e, FromSQL a) =>
(a -> e, SQL) -> SQL -> m ()
sqlWhereEV ([a] -> a -> e
exc [], SQL
name) SQL
"FALSE"
sqlWhereInE [a] -> a -> e
exc SQL
name [a
value] = (a -> a -> e) -> SQL -> a -> m ()
forall v (m :: * -> *) e a.
(MonadState v m, SqlWhere v, DBExtraException e, Show a, FromSQL a,
ToSQL a) =>
(a -> a -> e) -> SQL -> a -> m ()
sqlWhereEqE ([a] -> a -> e
exc ([a] -> a -> e) -> (a -> [a]) -> a -> a -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\a
x -> [a
x])) SQL
name a
value
sqlWhereInE [a] -> a -> e
exc SQL
name [a]
values =
(a -> e, SQL) -> SQL -> m ()
forall v (m :: * -> *) e a.
(MonadState v m, SqlWhere v, DBExtraException e, FromSQL a) =>
(a -> e, SQL) -> SQL -> m ()
sqlWhereEV ([a] -> a -> e
exc [a]
values, SQL
name) (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"IN (SELECT UNNEST(" SQL -> Array1 a -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> [a] -> Array1 a
forall a. [a] -> Array1 a
Array1 [a]
values SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"))"
sqlWhereNotIn :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> [a] -> m ()
sqlWhereNotIn :: SQL -> [a] -> m ()
sqlWhereNotIn SQL
_name [] = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere SQL
"TRUE"
sqlWhereNotIn SQL
name [a
value] = SQL -> a -> m ()
forall v (m :: * -> *) a.
(MonadState v m, SqlWhere v, Show a, ToSQL a) =>
SQL -> a -> m ()
sqlWhereNotEq SQL
name a
value
sqlWhereNotIn SQL
name [a]
values = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"NOT IN (SELECT UNNEST(" SQL -> Array1 a -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> [a] -> Array1 a
forall a. [a] -> Array1 a
Array1 [a]
values SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"))"
sqlWhereNotInSql :: (MonadState v m, Sqlable a, SqlWhere v) => SQL -> a -> m ()
sqlWhereNotInSql :: SQL -> a -> m ()
sqlWhereNotInSql SQL
name a
sql = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"NOT IN" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> SQL
parenthesize (a -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand a
sql)
sqlWhereNotInE :: (MonadState v m, SqlWhere v, DBExtraException e, Show a, ToSQL a, FromSQL a)
=> ([a] -> a -> e) -> SQL -> [a] -> m ()
sqlWhereNotInE :: ([a] -> a -> e) -> SQL -> [a] -> m ()
sqlWhereNotInE [a] -> a -> e
exc SQL
name [] = (a -> e, SQL) -> SQL -> m ()
forall v (m :: * -> *) e a.
(MonadState v m, SqlWhere v, DBExtraException e, FromSQL a) =>
(a -> e, SQL) -> SQL -> m ()
sqlWhereEV ([a] -> a -> e
exc [], SQL
name) SQL
"TRUE"
sqlWhereNotInE [a] -> a -> e
exc SQL
name [a
value] = (a -> a -> e) -> SQL -> a -> m ()
forall v (m :: * -> *) e a.
(MonadState v m, SqlWhere v, DBExtraException e, Show a, ToSQL a,
FromSQL a) =>
(a -> a -> e) -> SQL -> a -> m ()
sqlWhereNotEqE ([a] -> a -> e
exc ([a] -> a -> e) -> (a -> [a]) -> a -> a -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\a
x -> [a
x])) SQL
name a
value
sqlWhereNotInE [a] -> a -> e
exc SQL
name [a]
values =
(a -> e, SQL) -> SQL -> m ()
forall v (m :: * -> *) e a.
(MonadState v m, SqlWhere v, DBExtraException e, FromSQL a) =>
(a -> e, SQL) -> SQL -> m ()
sqlWhereEV ([a] -> a -> e
exc [a]
values, SQL
name) (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"NOT IN (SELECT UNNEST(" SQL -> Array1 a -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> [a] -> Array1 a
forall a. [a] -> Array1 a
Array1 [a]
values SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"))"
sqlWhereExists :: (MonadState v m, SqlWhere v) => SqlSelect -> m ()
sqlWhereExists :: SqlSelect -> m ()
sqlWhereExists SqlSelect
sql = do
(v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> SqlCondition -> v
forall a. SqlWhere a => a -> SqlCondition -> a
sqlWhere1 v
cmd (SqlSelect -> SqlCondition
SqlExistsCondition SqlSelect
sql))
sqlWhereNotExists :: (MonadState v m, SqlWhere v) => SqlSelect -> m ()
sqlWhereNotExists :: SqlSelect -> m ()
sqlWhereNotExists SqlSelect
sqlSelectD = do
SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere (SQL
"NOT EXISTS (" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SqlSelect -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand (SqlSelect
sqlSelectD { sqlSelectResult :: [SQL]
sqlSelectResult = [SQL
"TRUE"] }) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
")")
sqlWhereIsNULL :: (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhereIsNULL :: SQL -> m ()
sqlWhereIsNULL SQL
col = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
col SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"IS NULL"
sqlWhereIsNotNULL :: (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhereIsNotNULL :: SQL -> m ()
sqlWhereIsNotNULL SQL
col = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
col SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"IS NOT NULL"
sqlWhereIsNULLE :: (MonadState v m, SqlWhere v, DBExtraException e, FromSQL a)
=> (a -> e) -> SQL -> m ()
sqlWhereIsNULLE :: (a -> e) -> SQL -> m ()
sqlWhereIsNULLE a -> e
exc SQL
col = (a -> e, SQL) -> SQL -> m ()
forall v (m :: * -> *) e a.
(MonadState v m, SqlWhere v, DBExtraException e, FromSQL a) =>
(a -> e, SQL) -> SQL -> m ()
sqlWhereEV (a -> e
exc, SQL
col) (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
col SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"IS NULL"
sqlWhereAny :: (MonadState v m, SqlWhere v) => [State SqlAll ()] -> m ()
sqlWhereAny :: [State SqlAll ()] -> m ()
sqlWhereAny = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere (SQL -> m ())
-> ([State SqlAll ()] -> SQL) -> [State SqlAll ()] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [State SqlAll ()] -> SQL
sqlWhereAnyImpl
sqlWhereAnyE :: (DBExtraException e, MonadState v m, SqlWhere v)
=> e -> [State SqlAll ()] -> m ()
sqlWhereAnyE :: e -> [State SqlAll ()] -> m ()
sqlWhereAnyE e
e = e -> SQL -> m ()
forall v (m :: * -> *) e.
(MonadState v m, SqlWhere v, DBExtraException e) =>
e -> SQL -> m ()
sqlWhereE e
e (SQL -> m ())
-> ([State SqlAll ()] -> SQL) -> [State SqlAll ()] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [State SqlAll ()] -> SQL
sqlWhereAnyImpl
sqlWhereAnyImpl :: [State SqlAll ()] -> SQL
sqlWhereAnyImpl :: [State SqlAll ()] -> SQL
sqlWhereAnyImpl [] = SQL
"FALSE"
sqlWhereAnyImpl [State SqlAll ()]
l =
SQL
"(" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> [SQL] -> SQL
forall m. (IsString m, Monoid m) => m -> [m] -> m
smintercalate SQL
"OR" ((State SqlAll () -> SQL) -> [State SqlAll ()] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (SQL -> SQL
parenthesize (SQL -> SQL) -> (State SqlAll () -> SQL) -> State SqlAll () -> SQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlAll -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand
(SqlAll -> SQL)
-> (State SqlAll () -> SqlAll) -> State SqlAll () -> SQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State SqlAll () -> SqlAll -> SqlAll)
-> SqlAll -> State SqlAll () -> SqlAll
forall a b c. (a -> b -> c) -> b -> a -> c
flip State SqlAll () -> SqlAll -> SqlAll
forall s a. State s a -> s -> s
execState ([SqlCondition] -> SqlAll
SqlAll [])) [State SqlAll ()]
l) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
")"
class SqlFrom a where
sqlFrom1 :: a -> SQL -> a
instance SqlFrom SqlSelect where
sqlFrom1 :: SqlSelect -> SQL -> SqlSelect
sqlFrom1 SqlSelect
cmd SQL
sql = SqlSelect
cmd { sqlSelectFrom :: SQL
sqlSelectFrom = SqlSelect -> SQL
sqlSelectFrom SqlSelect
cmd SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
sql }
instance SqlFrom SqlInsertSelect where
sqlFrom1 :: SqlInsertSelect -> SQL -> SqlInsertSelect
sqlFrom1 SqlInsertSelect
cmd SQL
sql = SqlInsertSelect
cmd { sqlInsertSelectFrom :: SQL
sqlInsertSelectFrom = SqlInsertSelect -> SQL
sqlInsertSelectFrom SqlInsertSelect
cmd SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
sql }
instance SqlFrom SqlUpdate where
sqlFrom1 :: SqlUpdate -> SQL -> SqlUpdate
sqlFrom1 SqlUpdate
cmd SQL
sql = SqlUpdate
cmd { sqlUpdateFrom :: SQL
sqlUpdateFrom = SqlUpdate -> SQL
sqlUpdateFrom SqlUpdate
cmd SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
sql }
instance SqlFrom SqlDelete where
sqlFrom1 :: SqlDelete -> SQL -> SqlDelete
sqlFrom1 SqlDelete
cmd SQL
sql = SqlDelete
cmd { sqlDeleteUsing :: SQL
sqlDeleteUsing = SqlDelete -> SQL
sqlDeleteUsing SqlDelete
cmd SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
sql }
sqlFrom :: (MonadState v m, SqlFrom v) => SQL -> m ()
sqlFrom :: SQL -> m ()
sqlFrom SQL
sql = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> SQL -> v
forall a. SqlFrom a => a -> SQL -> a
sqlFrom1 v
cmd SQL
sql)
sqlJoin :: (MonadState v m, SqlFrom v) => SQL -> m ()
sqlJoin :: SQL -> m ()
sqlJoin SQL
table = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlFrom v) => SQL -> m ()
sqlFrom (SQL
", " SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
table)
sqlJoinOn :: (MonadState v m, SqlFrom v) => SQL -> SQL -> m ()
sqlJoinOn :: SQL -> SQL -> m ()
sqlJoinOn SQL
table SQL
condition = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlFrom v) => SQL -> m ()
sqlFrom (SQL
" JOIN " SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL
table SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL
" ON " SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL
condition)
sqlLeftJoinOn :: (MonadState v m, SqlFrom v) => SQL -> SQL -> m ()
sqlLeftJoinOn :: SQL -> SQL -> m ()
sqlLeftJoinOn SQL
table SQL
condition = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlFrom v) => SQL -> m ()
sqlFrom (SQL
" LEFT JOIN " SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL
table SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL
" ON " SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL
condition)
sqlRightJoinOn :: (MonadState v m, SqlFrom v) => SQL -> SQL -> m ()
sqlRightJoinOn :: SQL -> SQL -> m ()
sqlRightJoinOn SQL
table SQL
condition = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlFrom v) => SQL -> m ()
sqlFrom (SQL
" RIGHT JOIN " SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL
table SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL
" ON " SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL
condition)
sqlFullJoinOn :: (MonadState v m, SqlFrom v) => SQL -> SQL -> m ()
sqlFullJoinOn :: SQL -> SQL -> m ()
sqlFullJoinOn SQL
table SQL
condition = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlFrom v) => SQL -> m ()
sqlFrom (SQL
" FULL JOIN " SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL
table SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL
" ON " SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+>
SQL
condition)
class SqlSet a where
sqlSet1 :: a -> SQL -> SQL -> a
instance SqlSet SqlUpdate where
sqlSet1 :: SqlUpdate -> SQL -> SQL -> SqlUpdate
sqlSet1 SqlUpdate
cmd SQL
name SQL
v = SqlUpdate
cmd { sqlUpdateSet :: [(SQL, SQL)]
sqlUpdateSet = SqlUpdate -> [(SQL, SQL)]
sqlUpdateSet SqlUpdate
cmd [(SQL, SQL)] -> [(SQL, SQL)] -> [(SQL, SQL)]
forall a. [a] -> [a] -> [a]
++ [(SQL
name, SQL
v)] }
instance SqlSet SqlInsert where
sqlSet1 :: SqlInsert -> SQL -> SQL -> SqlInsert
sqlSet1 SqlInsert
cmd SQL
name SQL
v = SqlInsert
cmd { sqlInsertSet :: [(SQL, Multiplicity SQL)]
sqlInsertSet = SqlInsert -> [(SQL, Multiplicity SQL)]
sqlInsertSet SqlInsert
cmd [(SQL, Multiplicity SQL)]
-> [(SQL, Multiplicity SQL)] -> [(SQL, Multiplicity SQL)]
forall a. [a] -> [a] -> [a]
++ [(SQL
name, SQL -> Multiplicity SQL
forall a. a -> Multiplicity a
Single SQL
v)] }
instance SqlSet SqlInsertSelect where
sqlSet1 :: SqlInsertSelect -> SQL -> SQL -> SqlInsertSelect
sqlSet1 SqlInsertSelect
cmd SQL
name SQL
v = SqlInsertSelect
cmd { sqlInsertSelectSet :: [(SQL, SQL)]
sqlInsertSelectSet = SqlInsertSelect -> [(SQL, SQL)]
sqlInsertSelectSet SqlInsertSelect
cmd [(SQL, SQL)] -> [(SQL, SQL)] -> [(SQL, SQL)]
forall a. [a] -> [a] -> [a]
++ [(SQL
name, SQL
v)] }
sqlOnConflictDoNothing :: MonadState SqlInsert m => m ()
sqlOnConflictDoNothing :: m ()
sqlOnConflictDoNothing = (SqlInsert -> SqlInsert) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SqlInsert -> SqlInsert) -> m ())
-> (SqlInsert -> SqlInsert) -> m ()
forall a b. (a -> b) -> a -> b
$ \SqlInsert
cmd -> SqlInsert
cmd
{ sqlInsertOnConflict :: Maybe (SQL, Maybe SQL)
sqlInsertOnConflict = (SQL, Maybe SQL) -> Maybe (SQL, Maybe SQL)
forall a. a -> Maybe a
Just (SQL
"", Maybe SQL
forall a. Maybe a
Nothing)
}
sqlOnConflictOnColumns
:: Sqlable sql => MonadState SqlInsert m => [SQL] -> sql -> m ()
sqlOnConflictOnColumns :: [SQL] -> sql -> m ()
sqlOnConflictOnColumns [SQL]
columns sql
sql = (SqlInsert -> SqlInsert) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SqlInsert -> SqlInsert) -> m ())
-> (SqlInsert -> SqlInsert) -> m ()
forall a b. (a -> b) -> a -> b
$ \SqlInsert
cmd -> SqlInsert
cmd
{ sqlInsertOnConflict :: Maybe (SQL, Maybe SQL)
sqlInsertOnConflict = (SQL, Maybe SQL) -> Maybe (SQL, Maybe SQL)
forall a. a -> Maybe a
Just (SQL -> SQL
parenthesize (SQL -> SQL) -> SQL -> SQL
forall a b. (a -> b) -> a -> b
$ [SQL] -> SQL
sqlConcatComma [SQL]
columns, SQL -> Maybe SQL
forall a. a -> Maybe a
Just (SQL -> Maybe SQL) -> SQL -> Maybe SQL
forall a b. (a -> b) -> a -> b
$ sql -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand sql
sql)
}
sqlOnConflictOnColumnsDoNothing :: MonadState SqlInsert m => [SQL] -> m ()
sqlOnConflictOnColumnsDoNothing :: [SQL] -> m ()
sqlOnConflictOnColumnsDoNothing [SQL]
columns = (SqlInsert -> SqlInsert) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SqlInsert -> SqlInsert) -> m ())
-> (SqlInsert -> SqlInsert) -> m ()
forall a b. (a -> b) -> a -> b
$ \SqlInsert
cmd -> SqlInsert
cmd
{ sqlInsertOnConflict :: Maybe (SQL, Maybe SQL)
sqlInsertOnConflict = (SQL, Maybe SQL) -> Maybe (SQL, Maybe SQL)
forall a. a -> Maybe a
Just (SQL -> SQL
parenthesize (SQL -> SQL) -> SQL -> SQL
forall a b. (a -> b) -> a -> b
$ [SQL] -> SQL
sqlConcatComma [SQL]
columns, Maybe SQL
forall a. Maybe a
Nothing)
}
sqlSetCmd :: (MonadState v m, SqlSet v) => SQL -> SQL -> m ()
sqlSetCmd :: SQL -> SQL -> m ()
sqlSetCmd SQL
name SQL
sql = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> SQL -> SQL -> v
forall a. SqlSet a => a -> SQL -> SQL -> a
sqlSet1 v
cmd SQL
name SQL
sql)
sqlSetCmdList :: (MonadState SqlInsert m) => SQL -> [SQL] -> m ()
sqlSetCmdList :: SQL -> [SQL] -> m ()
sqlSetCmdList SQL
name [SQL]
as = (SqlInsert -> SqlInsert) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\SqlInsert
cmd -> SqlInsert
cmd { sqlInsertSet :: [(SQL, Multiplicity SQL)]
sqlInsertSet = SqlInsert -> [(SQL, Multiplicity SQL)]
sqlInsertSet SqlInsert
cmd [(SQL, Multiplicity SQL)]
-> [(SQL, Multiplicity SQL)] -> [(SQL, Multiplicity SQL)]
forall a. [a] -> [a] -> [a]
++ [(SQL
name, [SQL] -> Multiplicity SQL
forall a. [a] -> Multiplicity a
Many [SQL]
as)] })
sqlSet :: (MonadState v m, SqlSet v, Show a, ToSQL a) => SQL -> a -> m ()
sqlSet :: SQL -> a -> m ()
sqlSet SQL
name a
a = SQL -> SQL -> m ()
forall v (m :: * -> *).
(MonadState v m, SqlSet v) =>
SQL -> SQL -> m ()
sqlSetCmd SQL
name (a -> SQL
forall t. (Show t, ToSQL t) => t -> SQL
sqlParam a
a)
sqlSetInc :: (MonadState v m, SqlSet v) => SQL -> m ()
sqlSetInc :: SQL -> m ()
sqlSetInc SQL
name = SQL -> SQL -> m ()
forall v (m :: * -> *).
(MonadState v m, SqlSet v) =>
SQL -> SQL -> m ()
sqlSetCmd SQL
name (SQL -> m ()) -> SQL -> m ()
forall a b. (a -> b) -> a -> b
$ SQL
name SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"+ 1"
sqlSetList :: (MonadState SqlInsert m, Show a, ToSQL a) => SQL -> [a] -> m ()
sqlSetList :: SQL -> [a] -> m ()
sqlSetList SQL
name [a]
as = SQL -> [SQL] -> m ()
forall (m :: * -> *).
MonadState SqlInsert m =>
SQL -> [SQL] -> m ()
sqlSetCmdList SQL
name ((a -> SQL) -> [a] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map a -> SQL
forall t. (Show t, ToSQL t) => t -> SQL
sqlParam [a]
as)
sqlSetListWithDefaults :: (MonadState SqlInsert m, Show a, ToSQL a) => SQL -> [Maybe a] -> m ()
sqlSetListWithDefaults :: SQL -> [Maybe a] -> m ()
sqlSetListWithDefaults SQL
name [Maybe a]
as = SQL -> [SQL] -> m ()
forall (m :: * -> *).
MonadState SqlInsert m =>
SQL -> [SQL] -> m ()
sqlSetCmdList SQL
name ((Maybe a -> SQL) -> [Maybe a] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (SQL -> (a -> SQL) -> Maybe a -> SQL
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SQL
"DEFAULT" a -> SQL
forall t. (Show t, ToSQL t) => t -> SQL
sqlParam) [Maybe a]
as)
sqlCopyColumn :: (MonadState v m, SqlSet v) => SQL -> m ()
sqlCopyColumn :: SQL -> m ()
sqlCopyColumn SQL
column = SQL -> SQL -> m ()
forall v (m :: * -> *).
(MonadState v m, SqlSet v) =>
SQL -> SQL -> m ()
sqlSetCmd SQL
column SQL
column
class SqlResult a where
sqlResult1 :: a -> SQL -> a
instance SqlResult SqlSelect where
sqlResult1 :: SqlSelect -> SQL -> SqlSelect
sqlResult1 SqlSelect
cmd SQL
sql = SqlSelect
cmd { sqlSelectResult :: [SQL]
sqlSelectResult = SqlSelect -> [SQL]
sqlSelectResult SqlSelect
cmd [SQL] -> [SQL] -> [SQL]
forall a. [a] -> [a] -> [a]
++ [SQL
sql] }
instance SqlResult SqlInsert where
sqlResult1 :: SqlInsert -> SQL -> SqlInsert
sqlResult1 SqlInsert
cmd SQL
sql = SqlInsert
cmd { sqlInsertResult :: [SQL]
sqlInsertResult = SqlInsert -> [SQL]
sqlInsertResult SqlInsert
cmd [SQL] -> [SQL] -> [SQL]
forall a. [a] -> [a] -> [a]
++ [SQL
sql] }
instance SqlResult SqlInsertSelect where
sqlResult1 :: SqlInsertSelect -> SQL -> SqlInsertSelect
sqlResult1 SqlInsertSelect
cmd SQL
sql = SqlInsertSelect
cmd { sqlInsertSelectResult :: [SQL]
sqlInsertSelectResult = SqlInsertSelect -> [SQL]
sqlInsertSelectResult SqlInsertSelect
cmd [SQL] -> [SQL] -> [SQL]
forall a. [a] -> [a] -> [a]
++ [SQL
sql] }
instance SqlResult SqlUpdate where
sqlResult1 :: SqlUpdate -> SQL -> SqlUpdate
sqlResult1 SqlUpdate
cmd SQL
sql = SqlUpdate
cmd { sqlUpdateResult :: [SQL]
sqlUpdateResult = SqlUpdate -> [SQL]
sqlUpdateResult SqlUpdate
cmd [SQL] -> [SQL] -> [SQL]
forall a. [a] -> [a] -> [a]
++ [SQL
sql] }
sqlResult :: (MonadState v m, SqlResult v) => SQL -> m ()
sqlResult :: SQL -> m ()
sqlResult SQL
sql = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> SQL -> v
forall a. SqlResult a => a -> SQL -> a
sqlResult1 v
cmd SQL
sql)
class SqlOrderBy a where
sqlOrderBy1 :: a -> SQL -> a
instance SqlOrderBy SqlSelect where
sqlOrderBy1 :: SqlSelect -> SQL -> SqlSelect
sqlOrderBy1 SqlSelect
cmd SQL
sql = SqlSelect
cmd { sqlSelectOrderBy :: [SQL]
sqlSelectOrderBy = SqlSelect -> [SQL]
sqlSelectOrderBy SqlSelect
cmd [SQL] -> [SQL] -> [SQL]
forall a. [a] -> [a] -> [a]
++ [SQL
sql] }
instance SqlOrderBy SqlInsertSelect where
sqlOrderBy1 :: SqlInsertSelect -> SQL -> SqlInsertSelect
sqlOrderBy1 SqlInsertSelect
cmd SQL
sql = SqlInsertSelect
cmd { sqlInsertSelectOrderBy :: [SQL]
sqlInsertSelectOrderBy = SqlInsertSelect -> [SQL]
sqlInsertSelectOrderBy SqlInsertSelect
cmd [SQL] -> [SQL] -> [SQL]
forall a. [a] -> [a] -> [a]
++ [SQL
sql] }
sqlOrderBy :: (MonadState v m, SqlOrderBy v) => SQL -> m ()
sqlOrderBy :: SQL -> m ()
sqlOrderBy SQL
sql = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> SQL -> v
forall a. SqlOrderBy a => a -> SQL -> a
sqlOrderBy1 v
cmd SQL
sql)
class SqlGroupByHaving a where
sqlGroupBy1 :: a -> SQL -> a
sqlHaving1 :: a -> SQL -> a
instance SqlGroupByHaving SqlSelect where
sqlGroupBy1 :: SqlSelect -> SQL -> SqlSelect
sqlGroupBy1 SqlSelect
cmd SQL
sql = SqlSelect
cmd { sqlSelectGroupBy :: [SQL]
sqlSelectGroupBy = SqlSelect -> [SQL]
sqlSelectGroupBy SqlSelect
cmd [SQL] -> [SQL] -> [SQL]
forall a. [a] -> [a] -> [a]
++ [SQL
sql] }
sqlHaving1 :: SqlSelect -> SQL -> SqlSelect
sqlHaving1 SqlSelect
cmd SQL
sql = SqlSelect
cmd { sqlSelectHaving :: [SQL]
sqlSelectHaving = SqlSelect -> [SQL]
sqlSelectHaving SqlSelect
cmd [SQL] -> [SQL] -> [SQL]
forall a. [a] -> [a] -> [a]
++ [SQL
sql] }
instance SqlGroupByHaving SqlInsertSelect where
sqlGroupBy1 :: SqlInsertSelect -> SQL -> SqlInsertSelect
sqlGroupBy1 SqlInsertSelect
cmd SQL
sql = SqlInsertSelect
cmd { sqlInsertSelectGroupBy :: [SQL]
sqlInsertSelectGroupBy = SqlInsertSelect -> [SQL]
sqlInsertSelectGroupBy SqlInsertSelect
cmd [SQL] -> [SQL] -> [SQL]
forall a. [a] -> [a] -> [a]
++ [SQL
sql] }
sqlHaving1 :: SqlInsertSelect -> SQL -> SqlInsertSelect
sqlHaving1 SqlInsertSelect
cmd SQL
sql = SqlInsertSelect
cmd { sqlInsertSelectHaving :: [SQL]
sqlInsertSelectHaving = SqlInsertSelect -> [SQL]
sqlInsertSelectHaving SqlInsertSelect
cmd [SQL] -> [SQL] -> [SQL]
forall a. [a] -> [a] -> [a]
++ [SQL
sql] }
sqlGroupBy :: (MonadState v m, SqlGroupByHaving v) => SQL -> m ()
sqlGroupBy :: SQL -> m ()
sqlGroupBy SQL
sql = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> SQL -> v
forall a. SqlGroupByHaving a => a -> SQL -> a
sqlGroupBy1 v
cmd SQL
sql)
sqlHaving :: (MonadState v m, SqlGroupByHaving v) => SQL -> m ()
sqlHaving :: SQL -> m ()
sqlHaving SQL
sql = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> SQL -> v
forall a. SqlGroupByHaving a => a -> SQL -> a
sqlHaving1 v
cmd SQL
sql)
class SqlOffsetLimit a where
sqlOffset1 :: a -> Integer -> a
sqlLimit1 :: a -> Integer -> a
instance SqlOffsetLimit SqlSelect where
sqlOffset1 :: SqlSelect -> Integer -> SqlSelect
sqlOffset1 SqlSelect
cmd Integer
num = SqlSelect
cmd { sqlSelectOffset :: Integer
sqlSelectOffset = Integer
num }
sqlLimit1 :: SqlSelect -> Integer -> SqlSelect
sqlLimit1 SqlSelect
cmd Integer
num = SqlSelect
cmd { sqlSelectLimit :: Integer
sqlSelectLimit = Integer
num }
instance SqlOffsetLimit SqlInsertSelect where
sqlOffset1 :: SqlInsertSelect -> Integer -> SqlInsertSelect
sqlOffset1 SqlInsertSelect
cmd Integer
num = SqlInsertSelect
cmd { sqlInsertSelectOffset :: Integer
sqlInsertSelectOffset = Integer
num }
sqlLimit1 :: SqlInsertSelect -> Integer -> SqlInsertSelect
sqlLimit1 SqlInsertSelect
cmd Integer
num = SqlInsertSelect
cmd { sqlInsertSelectLimit :: Integer
sqlInsertSelectLimit = Integer
num }
sqlOffset :: (MonadState v m, SqlOffsetLimit v, Integral int) => int -> m ()
sqlOffset :: int -> m ()
sqlOffset int
val = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> Integer -> v
forall a. SqlOffsetLimit a => a -> Integer -> a
sqlOffset1 v
cmd (Integer -> v) -> Integer -> v
forall a b. (a -> b) -> a -> b
$ int -> Integer
forall a. Integral a => a -> Integer
toInteger int
val)
sqlLimit :: (MonadState v m, SqlOffsetLimit v, Integral int) => int -> m ()
sqlLimit :: int -> m ()
sqlLimit int
val = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> Integer -> v
forall a. SqlOffsetLimit a => a -> Integer -> a
sqlLimit1 v
cmd (Integer -> v) -> Integer -> v
forall a b. (a -> b) -> a -> b
$ int -> Integer
forall a. Integral a => a -> Integer
toInteger int
val)
class SqlDistinct a where
sqlDistinct1 :: a -> a
instance SqlDistinct SqlSelect where
sqlDistinct1 :: SqlSelect -> SqlSelect
sqlDistinct1 SqlSelect
cmd = SqlSelect
cmd { sqlSelectDistinct :: Bool
sqlSelectDistinct = Bool
True }
instance SqlDistinct SqlInsertSelect where
sqlDistinct1 :: SqlInsertSelect -> SqlInsertSelect
sqlDistinct1 SqlInsertSelect
cmd = SqlInsertSelect
cmd { sqlInsertSelectDistinct :: Bool
sqlInsertSelectDistinct = Bool
True }
sqlDistinct :: (MonadState v m, SqlDistinct v) => m ()
sqlDistinct :: m ()
sqlDistinct = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> v
forall a. SqlDistinct a => a -> a
sqlDistinct1 v
cmd)
class (SqlWhere a, Sqlable a) => SqlTurnIntoSelect a where
sqlTurnIntoSelect :: a -> SqlSelect
instance SqlTurnIntoSelect SqlSelect where
sqlTurnIntoSelect :: SqlSelect -> SqlSelect
sqlTurnIntoSelect = SqlSelect -> SqlSelect
forall a. a -> a
id
sqlTurnIntoWhyNotSelect :: (SqlTurnIntoSelect a) => a -> SqlSelect
sqlTurnIntoWhyNotSelect :: a -> SqlSelect
sqlTurnIntoWhyNotSelect a
command =
SQL -> State SqlSelect () -> SqlSelect
sqlSelect SQL
"" (State SqlSelect () -> SqlSelect)
-> (SQL -> State SqlSelect ()) -> SQL -> SqlSelect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlResult v) =>
SQL -> m ()
sqlResult (SQL -> SqlSelect) -> SQL -> SqlSelect
forall a b. (a -> b) -> a -> b
$ [SQL] -> SQL
forall a. Monoid a => [a] -> a
mconcat [
SQL
"ARRAY["
, SQL -> [SQL] -> SQL
forall m. Monoid m => m -> [m] -> m
mintercalate SQL
", " ([SQL] -> SQL) -> [SQL] -> SQL
forall a b. (a -> b) -> a -> b
$ (Int -> SQL) -> [Int] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map Int -> SQL
emitExists [Int
0..(Int
countInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
, SQL
"]::boolean[]"
]
where select :: SqlSelect
select = a -> SqlSelect
forall a. SqlTurnIntoSelect a => a -> SqlSelect
sqlTurnIntoSelect a
command
count :: Int
count :: Int
count = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((SqlCondition -> Int) -> [SqlCondition] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map SqlCondition -> Int
forall p. Num p => SqlCondition -> p
count' (SqlSelect -> [SqlCondition]
sqlSelectWhere SqlSelect
select))
count' :: SqlCondition -> p
count' (SqlPlainCondition {}) = p
1
count' (SqlExistsCondition SqlSelect
select') = [p] -> p
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((SqlCondition -> p) -> [SqlCondition] -> [p]
forall a b. (a -> b) -> [a] -> [b]
map SqlCondition -> p
count' (SqlSelect -> [SqlCondition]
sqlSelectWhere SqlSelect
select'))
emitExists :: Int -> SQL
emitExists :: Int -> SQL
emitExists Int
current =
case State Int SqlSelect -> Int -> (SqlSelect, Int)
forall s a. State s a -> s -> (a, s)
runState (Int -> SqlSelect -> State Int SqlSelect
forall (m :: * -> *).
MonadState Int m =>
Int -> SqlSelect -> m SqlSelect
run Int
current SqlSelect
select) Int
0 of
(SqlSelect
s, Int
_) -> if [SqlCondition] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (SqlSelect -> [SqlCondition]
sqlSelectWhere SqlSelect
s)
then SQL
"TRUE"
else SQL
"EXISTS (" SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> (SqlSelect -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand (SqlSelect -> SQL) -> SqlSelect -> SQL
forall a b. (a -> b) -> a -> b
$ SqlSelect
s { sqlSelectResult :: [SQL]
sqlSelectResult = [ SQL
"TRUE" ]}) SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> SQL
")"
run :: (MonadState Int m) => Int -> SqlSelect -> m SqlSelect
run :: Int -> SqlSelect -> m SqlSelect
run Int
current SqlSelect
select' = do
[[SqlCondition]]
new <- (SqlCondition -> m [SqlCondition])
-> [SqlCondition] -> m [[SqlCondition]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> SqlCondition -> m [SqlCondition]
forall (m :: * -> *).
MonadState Int m =>
Int -> SqlCondition -> m [SqlCondition]
around Int
current) (SqlSelect -> [SqlCondition]
sqlSelectWhere SqlSelect
select')
SqlSelect -> m SqlSelect
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlSelect
select' { sqlSelectWhere :: [SqlCondition]
sqlSelectWhere = [[SqlCondition]] -> [SqlCondition]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[SqlCondition]]
new })
around :: (MonadState Int m) => Int -> SqlCondition -> m [SqlCondition]
around :: Int -> SqlCondition -> m [SqlCondition]
around Int
current cond :: SqlCondition
cond@(SqlPlainCondition{}) = do
Int
index <- m Int
forall s (m :: * -> *). MonadState s m => m s
get
(Int -> Int) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
if Int
current Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
index
then [SqlCondition] -> m [SqlCondition]
forall (m :: * -> *) a. Monad m => a -> m a
return [SqlCondition
cond]
else [SqlCondition] -> m [SqlCondition]
forall (m :: * -> *) a. Monad m => a -> m a
return []
around Int
current (SqlExistsCondition SqlSelect
subSelect) = do
SqlSelect
subSelect' <- Int -> SqlSelect -> m SqlSelect
forall (m :: * -> *).
MonadState Int m =>
Int -> SqlSelect -> m SqlSelect
run Int
current SqlSelect
subSelect
[SqlCondition] -> m [SqlCondition]
forall (m :: * -> *) a. Monad m => a -> m a
return [SqlSelect -> SqlCondition
SqlExistsCondition SqlSelect
subSelect']
instance SqlTurnIntoSelect SqlUpdate where
sqlTurnIntoSelect :: SqlUpdate -> SqlSelect
sqlTurnIntoSelect SqlUpdate
s = SqlSelect :: SQL
-> [SQL]
-> Bool
-> [SQL]
-> [SqlCondition]
-> [SQL]
-> [SQL]
-> [SQL]
-> Integer
-> Integer
-> [(SQL, SQL)]
-> SqlSelect
SqlSelect
{ sqlSelectFrom :: SQL
sqlSelectFrom = SqlUpdate -> SQL
sqlUpdateWhat SqlUpdate
s SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<>
if SQL -> Bool
isSqlEmpty (SqlUpdate -> SQL
sqlUpdateFrom SqlUpdate
s)
then SQL
""
else SQL
"," SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SqlUpdate -> SQL
sqlUpdateFrom SqlUpdate
s
, sqlSelectUnion :: [SQL]
sqlSelectUnion = []
, sqlSelectDistinct :: Bool
sqlSelectDistinct = Bool
False
, sqlSelectResult :: [SQL]
sqlSelectResult = if [SQL] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (SqlUpdate -> [SQL]
sqlUpdateResult SqlUpdate
s)
then [SQL
"TRUE"]
else SqlUpdate -> [SQL]
sqlUpdateResult SqlUpdate
s
, sqlSelectWhere :: [SqlCondition]
sqlSelectWhere = SqlUpdate -> [SqlCondition]
sqlUpdateWhere SqlUpdate
s
, sqlSelectOrderBy :: [SQL]
sqlSelectOrderBy = []
, sqlSelectGroupBy :: [SQL]
sqlSelectGroupBy = []
, sqlSelectHaving :: [SQL]
sqlSelectHaving = []
, sqlSelectOffset :: Integer
sqlSelectOffset = Integer
0
, sqlSelectLimit :: Integer
sqlSelectLimit = -Integer
1
, sqlSelectWith :: [(SQL, SQL)]
sqlSelectWith = SqlUpdate -> [(SQL, SQL)]
sqlUpdateWith SqlUpdate
s
}
instance SqlTurnIntoSelect SqlDelete where
sqlTurnIntoSelect :: SqlDelete -> SqlSelect
sqlTurnIntoSelect SqlDelete
s = SqlSelect :: SQL
-> [SQL]
-> Bool
-> [SQL]
-> [SqlCondition]
-> [SQL]
-> [SQL]
-> [SQL]
-> Integer
-> Integer
-> [(SQL, SQL)]
-> SqlSelect
SqlSelect
{ sqlSelectFrom :: SQL
sqlSelectFrom = SqlDelete -> SQL
sqlDeleteFrom SqlDelete
s SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<>
if SQL -> Bool
isSqlEmpty (SqlDelete -> SQL
sqlDeleteUsing SqlDelete
s)
then SQL
""
else SQL
"," SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SqlDelete -> SQL
sqlDeleteUsing SqlDelete
s
, sqlSelectUnion :: [SQL]
sqlSelectUnion = []
, sqlSelectDistinct :: Bool
sqlSelectDistinct = Bool
False
, sqlSelectResult :: [SQL]
sqlSelectResult = if [SQL] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (SqlDelete -> [SQL]
sqlDeleteResult SqlDelete
s)
then [SQL
"TRUE"]
else SqlDelete -> [SQL]
sqlDeleteResult SqlDelete
s
, sqlSelectWhere :: [SqlCondition]
sqlSelectWhere = SqlDelete -> [SqlCondition]
sqlDeleteWhere SqlDelete
s
, sqlSelectOrderBy :: [SQL]
sqlSelectOrderBy = []
, sqlSelectGroupBy :: [SQL]
sqlSelectGroupBy = []
, sqlSelectHaving :: [SQL]
sqlSelectHaving = []
, sqlSelectOffset :: Integer
sqlSelectOffset = Integer
0
, sqlSelectLimit :: Integer
sqlSelectLimit = -Integer
1
, sqlSelectWith :: [(SQL, SQL)]
sqlSelectWith = SqlDelete -> [(SQL, SQL)]
sqlDeleteWith SqlDelete
s
}
instance SqlTurnIntoSelect SqlInsertSelect where
sqlTurnIntoSelect :: SqlInsertSelect -> SqlSelect
sqlTurnIntoSelect SqlInsertSelect
s = SqlSelect :: SQL
-> [SQL]
-> Bool
-> [SQL]
-> [SqlCondition]
-> [SQL]
-> [SQL]
-> [SQL]
-> Integer
-> Integer
-> [(SQL, SQL)]
-> SqlSelect
SqlSelect
{ sqlSelectFrom :: SQL
sqlSelectFrom = SqlInsertSelect -> SQL
sqlInsertSelectFrom SqlInsertSelect
s
, sqlSelectUnion :: [SQL]
sqlSelectUnion = []
, sqlSelectDistinct :: Bool
sqlSelectDistinct = Bool
False
, sqlSelectResult :: [SQL]
sqlSelectResult = SqlInsertSelect -> [SQL]
sqlInsertSelectResult SqlInsertSelect
s
, sqlSelectWhere :: [SqlCondition]
sqlSelectWhere = SqlInsertSelect -> [SqlCondition]
sqlInsertSelectWhere SqlInsertSelect
s
, sqlSelectOrderBy :: [SQL]
sqlSelectOrderBy = SqlInsertSelect -> [SQL]
sqlInsertSelectOrderBy SqlInsertSelect
s
, sqlSelectGroupBy :: [SQL]
sqlSelectGroupBy = SqlInsertSelect -> [SQL]
sqlInsertSelectGroupBy SqlInsertSelect
s
, sqlSelectHaving :: [SQL]
sqlSelectHaving = SqlInsertSelect -> [SQL]
sqlInsertSelectHaving SqlInsertSelect
s
, sqlSelectOffset :: Integer
sqlSelectOffset = SqlInsertSelect -> Integer
sqlInsertSelectOffset SqlInsertSelect
s
, sqlSelectLimit :: Integer
sqlSelectLimit = SqlInsertSelect -> Integer
sqlInsertSelectLimit SqlInsertSelect
s
, sqlSelectWith :: [(SQL, SQL)]
sqlSelectWith = SqlInsertSelect -> [(SQL, SQL)]
sqlInsertSelectWith SqlInsertSelect
s
}
data DBBaseLineConditionIsFalse = DBBaseLineConditionIsFalse SQL
deriving (Int -> DBBaseLineConditionIsFalse -> ShowS
[DBBaseLineConditionIsFalse] -> ShowS
DBBaseLineConditionIsFalse -> String
(Int -> DBBaseLineConditionIsFalse -> ShowS)
-> (DBBaseLineConditionIsFalse -> String)
-> ([DBBaseLineConditionIsFalse] -> ShowS)
-> Show DBBaseLineConditionIsFalse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DBBaseLineConditionIsFalse] -> ShowS
$cshowList :: [DBBaseLineConditionIsFalse] -> ShowS
show :: DBBaseLineConditionIsFalse -> String
$cshow :: DBBaseLineConditionIsFalse -> String
showsPrec :: Int -> DBBaseLineConditionIsFalse -> ShowS
$cshowsPrec :: Int -> DBBaseLineConditionIsFalse -> ShowS
Show, Typeable)
instance DBExtraException DBBaseLineConditionIsFalse
instance JSON.ToJSValue DBBaseLineConditionIsFalse where
toJSValue :: DBBaseLineConditionIsFalse -> JSValue
toJSValue DBBaseLineConditionIsFalse
_sql = JSONGen () -> JSValue
JSON.runJSONGen (JSONGen () -> JSValue) -> JSONGen () -> JSValue
forall a b. (a -> b) -> a -> b
$ do
String -> String -> JSONGen ()
forall (m :: * -> *) a.
(Monad m, ToJSValue a) =>
String -> a -> JSONGenT m ()
JSON.value String
"message" (String
"DBBaseLineConditionIsFalse"::String)
class (Show e, Typeable e, JSON.ToJSValue e) => e where
:: e -> SomeDBExtraException
toDBExtraException = e -> SomeDBExtraException
forall e. (Show e, DBExtraException e) => e -> SomeDBExtraException
SomeDBExtraException
:: SomeDBExtraException -> Maybe e
fromDBExtraException (SomeDBExtraException e
e) = e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
catchDBExtraException :: (MonadBaseControl IO m, DBExtraException e) => m a -> (e -> m a) -> m a
m a
m e -> m a
f = m a
m m a -> (SomeDBExtraException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
`E.catch` (\SomeDBExtraException
e -> case SomeDBExtraException -> Maybe e
forall e. DBExtraException e => SomeDBExtraException -> Maybe e
fromDBExtraException SomeDBExtraException
e of
Just e
ke -> e -> m a
f e
ke
Maybe e
Nothing -> SomeDBExtraException -> m a
forall a e. Exception e => e -> a
throw SomeDBExtraException
e)
data = forall e. (Show e, DBExtraException e) => e
deriving Typeable
deriving instance Show SomeDBExtraException
instance Exception SomeDBExtraException where
toException :: SomeDBExtraException -> SomeException
toException = SomeDBExtraException -> SomeException
forall e. Exception e => e -> SomeException
SomeException
fromException :: SomeException -> Maybe SomeDBExtraException
fromException (SomeException e
e) = [Maybe SomeDBExtraException] -> Maybe SomeDBExtraException
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ e -> Maybe SomeDBExtraException
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
, do
DBException {dbeError :: ()
dbeError = e
e'} <- e -> Maybe DBException
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
e -> Maybe SomeDBExtraException
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e'
]
data ExceptionMaker = forall row. FromRow row => ExceptionMaker (row -> SomeDBExtraException)
data DBKwhyNotInternalError = DBKwhyNotInternalError String
deriving (Int -> DBKwhyNotInternalError -> ShowS
[DBKwhyNotInternalError] -> ShowS
DBKwhyNotInternalError -> String
(Int -> DBKwhyNotInternalError -> ShowS)
-> (DBKwhyNotInternalError -> String)
-> ([DBKwhyNotInternalError] -> ShowS)
-> Show DBKwhyNotInternalError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DBKwhyNotInternalError] -> ShowS
$cshowList :: [DBKwhyNotInternalError] -> ShowS
show :: DBKwhyNotInternalError -> String
$cshow :: DBKwhyNotInternalError -> String
showsPrec :: Int -> DBKwhyNotInternalError -> ShowS
$cshowsPrec :: Int -> DBKwhyNotInternalError -> ShowS
Show, Typeable)
instance DBExtraException DBKwhyNotInternalError
instance JSON.ToJSValue DBKwhyNotInternalError where
toJSValue :: DBKwhyNotInternalError -> JSValue
toJSValue (DBKwhyNotInternalError String
msg) = JSONGen () -> JSValue
JSON.runJSONGen (JSONGen () -> JSValue) -> JSONGen () -> JSValue
forall a b. (a -> b) -> a -> b
$
String -> String -> JSONGen ()
forall (m :: * -> *) a.
(Monad m, ToJSValue a) =>
String -> a -> JSONGenT m ()
JSON.value String
"message"
(String
"Internal error in Database.PostgreSQL.PQTypes.SQL.Builder.kWhyNot1Ex: "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)
kWhyNot1Ex :: forall m s. (SqlTurnIntoSelect s, MonadDB m, MonadThrow m)
=> s -> m (Bool, SomeDBExtraException)
kWhyNot1Ex :: s -> m (Bool, SomeDBExtraException)
kWhyNot1Ex s
cmd = do
let newSelect :: SqlSelect
newSelect = s -> SqlSelect
forall a. SqlTurnIntoSelect a => a -> SqlSelect
sqlTurnIntoSelect s
cmd
newWhyNotSelect :: SqlSelect
newWhyNotSelect = SqlSelect -> SqlSelect
forall a. SqlTurnIntoSelect a => a -> SqlSelect
sqlTurnIntoWhyNotSelect SqlSelect
newSelect
let findFirstFalse :: Identity (Array1 Bool) -> Int
findFirstFalse :: Identity (Array1 Bool) -> Int
findFirstFalse (Identity (Array1 [Bool]
row)) = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 ((Bool -> Bool) -> [Bool] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False) [Bool]
row)
SqlSelect -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ (SqlSelect
newWhyNotSelect { sqlSelectLimit :: Integer
sqlSelectLimit = Integer
1 })
Int
indexOfFirstFailedCondition <- (Identity (Array1 Bool) -> Int) -> m Int
forall (m :: * -> *) row t.
(MonadDB m, MonadThrow m, FromRow row) =>
(row -> t) -> m t
fetchOne Identity (Array1 Bool) -> Int
findFirstFalse
let logics :: [(Bool, ExceptionMaker, (SQL, [SqlCondition]), [SQL])]
logics = (SQL, [SqlCondition])
-> [SqlCondition]
-> [(Bool, ExceptionMaker, (SQL, [SqlCondition]), [SQL])]
enumerateWhyNotExceptions ((SqlSelect -> SQL
sqlSelectFrom SqlSelect
newSelect),[]) (SqlSelect -> [SqlCondition]
forall a. SqlWhere a => a -> [SqlCondition]
sqlGetWhereConditions SqlSelect
newSelect)
let mcondition :: Maybe (Bool, ExceptionMaker, (SQL, [SqlCondition]), [SQL])
mcondition = [(Bool, ExceptionMaker, (SQL, [SqlCondition]), [SQL])]
logics [(Bool, ExceptionMaker, (SQL, [SqlCondition]), [SQL])]
-> Int
-> Maybe (Bool, ExceptionMaker, (SQL, [SqlCondition]), [SQL])
forall a. [a] -> Int -> Maybe a
`atMay` Int
indexOfFirstFailedCondition
case Maybe (Bool, ExceptionMaker, (SQL, [SqlCondition]), [SQL])
mcondition of
Maybe (Bool, ExceptionMaker, (SQL, [SqlCondition]), [SQL])
Nothing -> (Bool, SomeDBExtraException) -> m (Bool, SomeDBExtraException)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Bool
True, DBKwhyNotInternalError -> SomeDBExtraException
forall e. DBExtraException e => e -> SomeDBExtraException
toDBExtraException (DBKwhyNotInternalError -> SomeDBExtraException)
-> (String -> DBKwhyNotInternalError)
-> String
-> SomeDBExtraException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DBKwhyNotInternalError
DBKwhyNotInternalError (String -> SomeDBExtraException) -> String -> SomeDBExtraException
forall a b. (a -> b) -> a -> b
$
String
"list of failed conditions is empty")
Just (Bool
important, ExceptionMaker row -> SomeDBExtraException
exception, (SQL, [SqlCondition])
_from, []) ->
(Bool, SomeDBExtraException) -> m (Bool, SomeDBExtraException)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
important, row -> SomeDBExtraException
exception (row -> SomeDBExtraException) -> row -> SomeDBExtraException
forall a b. (a -> b) -> a -> b
$ String -> row
forall a. HasCallStack => String -> a
error String
"this argument should've been ignored")
Just (Bool
important, ExceptionMaker row -> SomeDBExtraException
exception, (SQL
from, [SqlCondition]
conds), [SQL]
sqls) -> do
let statement' :: SqlSelect
statement' = SQL -> State SqlSelect () -> SqlSelect
sqlSelect2 SQL
from (State SqlSelect () -> SqlSelect)
-> State SqlSelect () -> SqlSelect
forall a b. (a -> b) -> a -> b
$ do
(SQL -> State SqlSelect ()) -> [SQL] -> State SqlSelect ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlResult v) =>
SQL -> m ()
sqlResult [SQL]
sqls
Int -> State SqlSelect ()
forall v (m :: * -> *) int.
(MonadState v m, SqlOffsetLimit v, Integral int) =>
int -> m ()
sqlLimit (Int
1::Int)
Int -> State SqlSelect ()
forall v (m :: * -> *) int.
(MonadState v m, SqlOffsetLimit v, Integral int) =>
int -> m ()
sqlOffset (Int
0::Int)
statement :: SqlSelect
statement = SqlSelect
statement' { sqlSelectWhere :: [SqlCondition]
sqlSelectWhere = [SqlCondition]
conds }
SqlSelect -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ SqlSelect
statement
SomeDBExtraException
result <- (row -> SomeDBExtraException) -> m SomeDBExtraException
forall (m :: * -> *) row t.
(MonadDB m, MonadThrow m, FromRow row) =>
(row -> t) -> m t
fetchOne row -> SomeDBExtraException
exception
(Bool, SomeDBExtraException) -> m (Bool, SomeDBExtraException)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
important, SomeDBExtraException
result)
kWhyNot1 :: (SqlTurnIntoSelect s, MonadDB m, MonadThrow m)
=> s -> m SomeDBExtraException
kWhyNot1 :: s -> m SomeDBExtraException
kWhyNot1 s
cmd = (Bool, SomeDBExtraException) -> SomeDBExtraException
forall a b. (a, b) -> b
snd ((Bool, SomeDBExtraException) -> SomeDBExtraException)
-> m (Bool, SomeDBExtraException) -> m SomeDBExtraException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` s -> m (Bool, SomeDBExtraException)
forall (m :: * -> *) s.
(SqlTurnIntoSelect s, MonadDB m, MonadThrow m) =>
s -> m (Bool, SomeDBExtraException)
kWhyNot1Ex s
cmd
enumerateWhyNotExceptions :: (SQL, [SqlCondition])
-> [SqlCondition]
-> [( Bool
, ExceptionMaker
, (SQL, [SqlCondition])
, [SQL]
)]
enumerateWhyNotExceptions :: (SQL, [SqlCondition])
-> [SqlCondition]
-> [(Bool, ExceptionMaker, (SQL, [SqlCondition]), [SQL])]
enumerateWhyNotExceptions (SQL
from,[SqlCondition]
condsUpTillNow) [SqlCondition]
conds = ((SqlCondition, [SqlCondition])
-> [(Bool, ExceptionMaker, (SQL, [SqlCondition]), [SQL])])
-> [(SqlCondition, [SqlCondition])]
-> [(Bool, ExceptionMaker, (SQL, [SqlCondition]), [SQL])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SqlCondition, [SqlCondition])
-> [(Bool, ExceptionMaker, (SQL, [SqlCondition]), [SQL])]
worker ([SqlCondition]
-> [[SqlCondition]] -> [(SqlCondition, [SqlCondition])]
forall a b. [a] -> [b] -> [(a, b)]
zip [SqlCondition]
conds ([SqlCondition] -> [[SqlCondition]]
forall a. [a] -> [[a]]
inits [SqlCondition]
conds))
where
worker :: (SqlCondition, [SqlCondition])
-> [(Bool, ExceptionMaker, (SQL, [SqlCondition]), [SQL])]
worker (SqlPlainCondition SQL
_ (SqlWhyNot Bool
b row -> e
f [SQL]
s), [SqlCondition]
condsUpTillNow2) =
[(Bool
b, (row -> SomeDBExtraException) -> ExceptionMaker
forall row.
FromRow row =>
(row -> SomeDBExtraException) -> ExceptionMaker
ExceptionMaker (e -> SomeDBExtraException
forall e. (Show e, DBExtraException e) => e -> SomeDBExtraException
SomeDBExtraException (e -> SomeDBExtraException)
-> (row -> e) -> row -> SomeDBExtraException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. row -> e
f), (SQL
from, [SqlCondition]
condsUpTillNow [SqlCondition] -> [SqlCondition] -> [SqlCondition]
forall a. [a] -> [a] -> [a]
++ [SqlCondition]
condsUpTillNow2), [SQL]
s)]
worker (SqlExistsCondition SqlSelect
s, [SqlCondition]
condsUpTillNow2) =
(SQL, [SqlCondition])
-> [SqlCondition]
-> [(Bool, ExceptionMaker, (SQL, [SqlCondition]), [SQL])]
enumerateWhyNotExceptions (SQL
newFrom, [SqlCondition]
condsUpTillNow [SqlCondition] -> [SqlCondition] -> [SqlCondition]
forall a. [a] -> [a] -> [a]
++ [SqlCondition]
condsUpTillNow2)
(SqlSelect -> [SqlCondition]
forall a. SqlWhere a => a -> [SqlCondition]
sqlGetWhereConditions SqlSelect
s)
where
newFrom :: SQL
newFrom = if SQL -> Bool
isSqlEmpty SQL
from
then SqlSelect -> SQL
sqlSelectFrom SqlSelect
s
else if SQL -> Bool
isSqlEmpty (SqlSelect -> SQL
sqlSelectFrom SqlSelect
s)
then SQL
from
else SQL
from SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> SQL
", " SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> SqlSelect -> SQL
sqlSelectFrom SqlSelect
s
kRunManyOrThrowWhyNot :: (SqlTurnIntoSelect s, MonadDB m, MonadThrow m)
=> s -> m ()
kRunManyOrThrowWhyNot :: s -> m ()
kRunManyOrThrowWhyNot s
sqlable = do
Int
success <- SQL -> m Int
forall (m :: * -> *) sql. (MonadDB m, IsSQL sql) => sql -> m Int
runQuery (SQL -> m Int) -> SQL -> m Int
forall a b. (a -> b) -> a -> b
$ s -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand s
sqlable
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
success Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
SomeDBExtraException
exception <- s -> m SomeDBExtraException
forall s (m :: * -> *).
(SqlTurnIntoSelect s, MonadDB m, MonadThrow m) =>
s -> m SomeDBExtraException
kWhyNot1 s
sqlable
SomeDBExtraException -> m ()
forall e (m :: * -> *) a.
(Exception e, MonadDB m, MonadThrow m) =>
e -> m a
throwDB SomeDBExtraException
exception
kRun1OrThrowWhyNot :: (SqlTurnIntoSelect s, MonadDB m, MonadThrow m)
=> s -> m ()
kRun1OrThrowWhyNot :: s -> m ()
kRun1OrThrowWhyNot s
sqlable = do
Bool
success <- SQL -> m Bool
forall sql (m :: * -> *).
(IsSQL sql, MonadDB m, MonadThrow m) =>
sql -> m Bool
runQuery01 (SQL -> m Bool) -> SQL -> m Bool
forall a b. (a -> b) -> a -> b
$ s -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand s
sqlable
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
success) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
SomeDBExtraException
exception <- s -> m SomeDBExtraException
forall s (m :: * -> *).
(SqlTurnIntoSelect s, MonadDB m, MonadThrow m) =>
s -> m SomeDBExtraException
kWhyNot1 s
sqlable
SomeDBExtraException -> m ()
forall e (m :: * -> *) a.
(Exception e, MonadDB m, MonadThrow m) =>
e -> m a
throwDB SomeDBExtraException
exception
kRun1OrThrowWhyNotAllowIgnore :: (SqlTurnIntoSelect s, MonadDB m, MonadThrow m)
=> s -> m ()
kRun1OrThrowWhyNotAllowIgnore :: s -> m ()
kRun1OrThrowWhyNotAllowIgnore s
sqlable = do
Bool
success <- SQL -> m Bool
forall sql (m :: * -> *).
(IsSQL sql, MonadDB m, MonadThrow m) =>
sql -> m Bool
runQuery01 (SQL -> m Bool) -> SQL -> m Bool
forall a b. (a -> b) -> a -> b
$ s -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand s
sqlable
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
success) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
(Bool
important, SomeDBExtraException
exception) <- s -> m (Bool, SomeDBExtraException)
forall (m :: * -> *) s.
(SqlTurnIntoSelect s, MonadDB m, MonadThrow m) =>
s -> m (Bool, SomeDBExtraException)
kWhyNot1Ex s
sqlable
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
important) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
SomeDBExtraException -> m ()
forall e (m :: * -> *) a.
(Exception e, MonadDB m, MonadThrow m) =>
e -> m a
throwDB SomeDBExtraException
exception
kRunAndFetch1OrThrowWhyNot :: (IsSQL s, FromRow row, MonadDB m, MonadThrow m, SqlTurnIntoSelect s)
=> (row -> a) -> s -> m a
kRunAndFetch1OrThrowWhyNot :: (row -> a) -> s -> m a
kRunAndFetch1OrThrowWhyNot row -> a
decoder s
sqlcommand = do
s -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ s
sqlcommand
[a]
results <- (row -> a) -> m [a]
forall (m :: * -> *) row t.
(MonadDB m, FromRow row) =>
(row -> t) -> m [t]
fetchMany row -> a
decoder
case [a]
results of
[] -> do
SomeDBExtraException
exception <- s -> m SomeDBExtraException
forall s (m :: * -> *).
(SqlTurnIntoSelect s, MonadDB m, MonadThrow m) =>
s -> m SomeDBExtraException
kWhyNot1 s
sqlcommand
SomeDBExtraException -> m a
forall e (m :: * -> *) a.
(Exception e, MonadDB m, MonadThrow m) =>
e -> m a
throwDB SomeDBExtraException
exception
[a
r] -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
[a]
_ -> AffectedRowsMismatch -> m a
forall e (m :: * -> *) a.
(Exception e, MonadDB m, MonadThrow m) =>
e -> m a
throwDB AffectedRowsMismatch :: [(Int, Int)] -> Int -> AffectedRowsMismatch
AffectedRowsMismatch {
rowsExpected :: [(Int, Int)]
rowsExpected = [(Int
1, Int
1)]
, rowsDelivered :: Int
rowsDelivered = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
results
}