{- |

Module "Database.PostgreSQL.PQTypes.SQL.Builder" offers a nice
monadic DSL for building SQL statements on the fly. Some examples:

>>> :{
sqlSelect "documents" $ do
  sqlResult "id"
  sqlResult "title"
  sqlResult "mtime"
  sqlOrderBy "documents.mtime DESC"
  sqlWhereILike "documents.title" "%pattern%"
:}
SQL " SELECT  id, title, mtime FROM documents WHERE (documents.title ILIKE <\"%pattern%\">)    ORDER BY documents.mtime DESC  "

@SQL.Builder@ supports SELECT as 'sqlSelect' and data manipulation using
'sqlInsert', 'sqlInsertSelect', 'sqlDelete' and 'sqlUpdate'.

>>> import Data.Time
>>> let title = "title" :: String
>>> let ctime  = read "2020-01-01 00:00:00 UTC" :: UTCTime
>>> :{
sqlInsert "documents" $ do
  sqlSet "title" title
  sqlSet "ctime" ctime
  sqlResult "id"
:}
SQL " INSERT INTO documents (title, ctime) VALUES (<\"title\">, <2020-01-01 00:00:00 UTC>)  RETURNING id"

The 'sqlInsertSelect' is particulary interesting as it supports INSERT
of values taken from a SELECT clause from same or even different
tables.

There is a possibility to do multiple inserts at once. Data given by
'sqlSetList' will be inserted multiple times, data given by 'sqlSet'
will be multiplied as many times as needed to cover all inserted rows
(it is common to all rows). If you use multiple 'sqlSetList' then
lists will be made equal in length by appending @DEFAULT@ as fill
element.

>>> :{
sqlInsert "documents" $ do
  sqlSet "ctime" ctime
  sqlSetList "title" ["title1", "title2", "title3"]
  sqlResult "id"
:}
SQL " INSERT INTO documents (ctime, title) VALUES (<2020-01-01 00:00:00 UTC>, <\"title1\">) , (<2020-01-01 00:00:00 UTC>, <\"title2\">) , (<2020-01-01 00:00:00 UTC>, <\"title3\">)  RETURNING id"

The above will insert 3 new documents.

@SQL.Builder@ provides quite a lot of SQL magic, including @ORDER BY@ as
'sqlOrderBy', @GROUP BY@ as 'sqlGroupBy'.

>>> :{
sqlSelect "documents" $ do
  sqlResult "id"
  sqlResult "title"
  sqlResult "mtime"
  sqlOrderBy "documents.mtime DESC"
  sqlOrderBy "documents.title"
  sqlGroupBy "documents.status"
  sqlJoinOn "users" "documents.user_id = users.id"
  sqlWhere $ mkSQL "documents.title ILIKE" <?> "%pattern%"
:}
SQL " SELECT  id, title, mtime FROM documents  JOIN  users  ON  documents.user_id = users.id WHERE (documents.title ILIKE <\"%pattern%\">)  GROUP BY documents.status  ORDER BY documents.mtime DESC, documents.title  "

Joins are done by 'sqlJoinOn', 'sqlLeftJoinOn', 'sqlRightJoinOn',
'sqlJoinOn', 'sqlFullJoinOn'. If everything fails use 'sqlJoin' and
'sqlFrom' to set join clause as string. Support for a join grammars as
some kind of abstract syntax data type is lacking.

>>> :{
sqlDelete "mails" $ do
  sqlWhere "id > 67"
:}
SQL " DELETE FROM mails  WHERE (id > 67) "

>>> :{
sqlUpdate "document_tags" $ do
  sqlSet "value" (123 :: Int)
  sqlWhere "name = 'abc'"
:}
SQL " UPDATE document_tags SET value=<123>  WHERE (name = 'abc') "

Exception returning and 'kWhyNot' are a subsystem for querying why a
query did not provide expected results. For example:

> let query = sqlUpdate "documents" $ do
>   sqlSet "deleted" True
>   sqlWhereEq "documents.id" 12345
>   sqlWhereEqE DocumentDeleteFlagMustBe "documents.deleted" False
>   sqlWhereILikeE DocumentTitleMustContain "documents.title" "%important%"
> result <- kRun query

If the result is zero then no document was updated. We would like to
know what happened. In query we have three filtering clauses. One is a
baseline: the one mentioning @documents.id@. Baseline clauses define
what objects we are talking about. Other clauses are correctness
checks and may fail if status of on object is unexpected. Using
'kWhyNot' we can see what is wrong with an object:

> problems <- kWhyNot query

Now @problems@ should contain a list of issues with rows that could be
possibly be affected by weren't due to correctness clauses. For
example it may state:

> problems = [[ DocumentDeleteFlagMustBe { documentDeleteFlagMustBe = False
>                                        , documentDeleteFlagReallyIs = True
>                                        }
>             , DocumentTitleMustContain { documentTitleMustContain = "%important%"
>                                        , documentTitleReallyIs = "Some contract v2"
>                                        }
>             ]]

Note: problems is a nested array, for each object we get a list of
issues pertaining to that object. If that list is empty, then it means
that baseline conditions failed or there is no such object that
fullfills all conditions at the same time although there are some that
fullfill each one separatelly.

Note: @kWhyNot@ is currently disabled. Use 'kWhyNot1' instead, which
returns a single exception.

-}

-- TODO: clean this up, add more documentation.

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(..)
  , DBBaseLineConditionIsFalse(..)

  , kWhyNot1
  , kWhyNot1Ex
  --, DBExceptionCouldNotParseValues(..)
  , kRun1OrThrowWhyNot
  , kRun1OrThrowWhyNotAllowIgnore
  , kRunManyOrThrowWhyNot
  , kRunAndFetch1OrThrowWhyNot

  , 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
")"

-- | 'AscDesc' marks ORDER BY order as ascending or descending.
-- Conversion to SQL adds DESC marker to descending and no marker
-- to ascending order.
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)

-- | 'SqlCondition' are clauses that are part of the WHERE block in
-- SQL statements. Each statement has a list of conditions, all of
-- them must be fulfilled.  Sometimes we need to inspect internal
-- structure of a condition. For now it seems that the only
-- interesting case is EXISTS (SELECT ...), because that internal
-- SELECT can have explainable clauses.
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)

-- | 'SqlWhyNot' contains a recipe for how to query the database for
-- some values we're interested in and construct a proper exception
-- object using that information. For @SqlWhyNot mkException queries@
-- the @mkException@ should take as input a list of the same length
-- list as there are queries. Each query will be run in a JOIN context
-- with all referenced tables, so it can extract values from there.
data SqlWhyNot =
  forall e row. (FromRow row, Exception e) =>
  SqlWhyNot Bool (row -> e) [SQL]

{-
instance Eq SqlCondition where
  (SqlPlainCondition a _) == (SqlPlainCondition b _) = a == b
  (SqlExistsCondition a) == (SqlExistsCondition b) = a == b
  _ == _ = False
  -}

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)]
  }

-- | This is not exported and is used as an implementation detail in
-- 'sqlWhereAll'.
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 there's a union, the result is sorted and has a limit, applying
        -- the order and limit to the main subquery won't reduce the overall
        -- query result, but might reduce its processing time.
        , 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

     -- this is the longest list of values
     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] -> SQL
forall m. (IsString m, Monoid m) => [m] -> m
smconcat
    -- WITH clause needs to be at the top level, so we emit it here and not
    -- include it in the SqlSelect below.
    [ 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) (SqlInsertSelect -> [(SQL, SQL)]
sqlInsertSelectWith SqlInsertSelect
cmd)
    , SQL
"INSERT INTO" SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SqlInsertSelect -> SQL
sqlInsertSelectWhat SqlInsertSelect
cmd
    , SQL -> SQL
parenthesize (SQL -> SQL) -> ([(SQL, SQL)] -> SQL) -> [(SQL, SQL)] -> SQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SQL] -> SQL
sqlConcatComma ([SQL] -> SQL) -> ([(SQL, SQL)] -> [SQL]) -> [(SQL, SQL)] -> SQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SQL, SQL) -> SQL) -> [(SQL, SQL)] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (SQL, SQL) -> SQL
forall a b. (a, b) -> a
fst ([(SQL, SQL)] -> SQL) -> [(SQL, SQL)] -> SQL
forall a b. (a -> b) -> a -> b
$ SqlInsertSelect -> [(SQL, SQL)]
sqlInsertSelectSet SqlInsertSelect
cmd
    , SQL -> SQL
parenthesize (SQL -> SQL) -> (SqlSelect -> SQL) -> SqlSelect -> SQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlSelect -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand (SqlSelect -> SQL) -> SqlSelect -> SQL
forall a b. (a -> b) -> a -> b
$ 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    = []
                                              }
    , SQL -> [SQL] -> SQL
emitClausesSepComma SQL
"RETURNING" ([SQL] -> SQL) -> [SQL] -> SQL
forall a b. (a -> b) -> a -> b
$ 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))

-- | Note: WHERE clause of the main SELECT is treated specially, i.e. it only
-- applies to the main SELECT, not the whole union.
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, Exception 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)))

-- | The @WHERE@ part of an SQL query. See above for a usage
-- example. See also 'SqlCondition'.
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, Exception e) =>
e -> SQL -> m ()
sqlWhereE (SQL -> DBBaseLineConditionIsFalse
DBBaseLineConditionIsFalse SQL
sql) SQL
sql

-- | Like 'sqlWhere', but also takes an exception value that is thrown
-- in case of error. See 'SqlCondition' and 'SqlWhyNot'.
sqlWhereE :: (MonadState v m, SqlWhere v, Exception 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, Exception e) =>
Bool -> (row -> e) -> [SQL] -> SqlWhyNot
SqlWhyNot Bool
True () -> e
exc2 [])))
  where
    exc2 :: () -> e
exc2 (()
_::()) = e
exc

-- | Like 'sqlWhereE', but takes a one-argument function that
-- constructs an exception value plus an SQL fragment for querying the
-- database for the argument that is fed into the exception
-- constructor function. See 'SqlCondition' and 'SqlWhyNot'.
--
-- The SQL fragment should be of form @TABLENAME.COLUMNAME@, as it is
-- executed as part of a @SELECT@ query involving all referenced
-- tables.
sqlWhereEV :: (MonadState v m, SqlWhere v, Exception 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, Exception 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

-- | Like 'sqlWhereEV', but the exception constructor function takes
-- two arguments.
sqlWhereEVV :: (MonadState v m, SqlWhere v, Exception 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, Exception 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

-- | Like 'sqlWhereEV', but the exception constructor function takes
-- three arguments.
sqlWhereEVVV :: (MonadState v m, SqlWhere v, Exception 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, Exception 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

-- | Like 'sqlWhereEV', but the exception constructor function takes
-- four arguments.
sqlWhereEVVVV :: (MonadState v m, SqlWhere v, Exception 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, Exception 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, Exception 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, Exception 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, Exception 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, Exception 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, Exception 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, Exception 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, Exception 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, Exception 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
  -- Unpack the array to give query optimizer more options.
  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, Exception 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, Exception 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, Exception 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, Exception 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, Exception 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, Exception 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, Exception 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, Exception 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, Exception 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, Exception 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"

-- | Add a condition in the WHERE statement that holds if any of the given
-- condition holds.
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

-- | Add a condition just like 'sqlWhereAny' but throw the given exception if
-- none of the given conditions hold.
sqlWhereAnyE :: (Exception 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, Exception 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


-- | The 'sqlTurnIntoWhyNotSelect' turns a failed query into a
-- why-not-query that can explain why query altered zero rows or
-- returned zero results.
--
-- Lets consider an example of explanation:
--
-- > UPDATE t1
-- >    SET a = 1
-- >  WHERE cond1
-- >    AND cond2                       -- with value2
-- >    AND EXISTS (SELECT TRUE
-- >                  FROM t2
-- >                 WHERE cond3        -- with value3a and value3b
-- >                   AND EXISTS (SELECT TRUE
-- >                                 FROM t3
-- >                                WHERE cond4))
--
-- 'sqlTurnIntoWhyNotSelect' will produce a @SELECT@ of the form:
--
-- > SELECT
-- >   EXISTS (SELECT TRUE ... WHERE cond1),
-- >   EXISTS (SELECT TRUE ... WHERE cond1 AND cond2),
-- >   EXISTS (SELECT TRUE ... WHERE cond1 AND cond2 AND cond3),
-- >   EXISTS (SELECT TRUE ... WHERE cond1 AND cond2 AND cond3 AND cond4);
--
-- Now, after this statement is executed we see which of these
-- returned @FALSE@ as the first one. This is the condition that failed
-- the whole query.
--
-- We can get more information at this point. If failed condition was
-- @cond2@, then @value2@ can be extracted by this statement:
--
-- > SELECT value2 ... WHERE cond1;
--
-- If failed condition was @cond3@, then statement executed can be:
--
-- > SELECT value3a, value3b ... WHERE cond1 AND cond2;
--
-- Rationale: @EXISTS@ clauses should pinpoint which @condX@ was the first
-- one to produce zero rows.  @SELECT@ clauses after @EXISTS@ should
-- explain why condX filtered out all rows.
--
-- 'DB.WhyNot.kWhyNot1' looks for first @EXISTS@ clause that is @FALSE@
-- and then tries to construct an @Exception@ object with values that come
-- after. If values that comes after cannot be sensibly parsed
-- (usually they are @NULL@ when a value is expected), this exception is
-- skipped and next one is tried.
--
-- If first @EXISTS@ clause is @TRUE@ but no other exception was properly
-- generated then @DBExceptionCouldNotParseValues@ is thrown with pair
-- of 'typeRef' of first exception that could not be parsed and with
-- list of SqlValues that it could not parse.
--
-- The 'DB.WhyNot.kRun1OrThrowWhyNot' throws first exception on the
-- list.
--
-- We have a theorem to use in this transformation:
--
-- > EXISTS (SELECT t1 WHERE cond1 AND EXISTS (SELECT t2 WHERE cond2))
--
-- is equivalent to
--
-- > EXISTS (SELECT t1, t2 WHERE cond1 AND cond2)
--
-- and it can be used recursivelly.
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 -- this is a bit dangerous because it can contain nested DELETE/UPDATE
                        }

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 -- this is a bit dangerous because it can contain nested DELETE/UPDATE
                        }

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 -- this is a bit dangerous because it can contain nested DELETE/UPDATE
                        }

{- Warning: use kWhyNot1 for now as kWhyNot does not work in expected way.

kWhyNot should return a list of rows, where each row is a list of
exceptions.  Right now we are not able to differentiate between rows
because we do not support a concept of a row identity. kWhyNot can
return rows in any order, returns empty rows for successful hits, does
not return a row if baseline conditions weren't met. This effectivelly
renders it useless.

kWhyNot will be resurrected when we get a row identity concept.

-}

{-
-- | If 'kWhyNot1' returns an empty list of exceptions when none of
-- @EXISTS@ clauses generated by 'sqlTurnIntoWhyNotSelect' was
-- @FALSE@. Should not happen in real life, file a bug report if you see
-- such a case.
kWhyNot :: (SqlTurnIntoSelect s, MonadDB m) => s -> m [[SomeException]]
kWhyNot cmd = do
  let newSelect = sqlTurnIntoWhyNotSelect cmd
  if null (sqlSelectResult newSelect)
     then return [[]]
     else do
       kRun_ newSelect
       kFold2 (decodeListOfExceptionsFromWhere (sqlGetWhereConditions cmd)) []
-}


data ExceptionMaker = forall row. FromRow row => ExceptionMaker (row -> SomeException)

newtype 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 Exception DBKwhyNotInternalError

kWhyNot1Ex :: forall m s. (SqlTurnIntoSelect s, MonadDB m, MonadThrow m)
           => s -> m (Bool, SomeException)
kWhyNot1Ex :: s -> m (Bool, SomeException)
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, SomeException) -> m (Bool, SomeException)
forall (m :: * -> *) a. Monad m => a -> m a
return
      (Bool
True, DBKwhyNotInternalError -> SomeException
forall e. Exception e => e -> SomeException
toException (DBKwhyNotInternalError -> SomeException)
-> (String -> DBKwhyNotInternalError) -> String -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DBKwhyNotInternalError
DBKwhyNotInternalError (String -> SomeException) -> String -> SomeException
forall a b. (a -> b) -> a -> b
$
        String
"list of failed conditions is empty")
    Just (Bool
important, ExceptionMaker row -> SomeException
exception, (SQL, [SqlCondition])
_from, []) ->
      (Bool, SomeException) -> m (Bool, SomeException)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
important, row -> SomeException
exception (row -> SomeException) -> row -> SomeException
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 -> SomeException
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 }
       --Log.debug $ "Explanation SQL:\n" ++ show statement
       SqlSelect -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ SqlSelect
statement
       SomeException
result <- (row -> SomeException) -> m SomeException
forall (m :: * -> *) row t.
(MonadDB m, MonadThrow m, FromRow row) =>
(row -> t) -> m t
fetchOne row -> SomeException
exception
       (Bool, SomeException) -> m (Bool, SomeException)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
important, SomeException
result)

-- | Function 'kWhyNot1' is a workhorse for explainable SQL
-- failures. SQL fails if it did not affect any rows or did not return
-- any rows.  When that happens 'kWhyNot1' should be called. 'kWhyNot1'
-- returns an exception describing why a row could not be
-- returned or affected by a query.
kWhyNot1 :: (SqlTurnIntoSelect s, MonadDB m, MonadThrow m)
         => s -> m SomeException
kWhyNot1 :: s -> m SomeException
kWhyNot1 s
cmd = (Bool, SomeException) -> SomeException
forall a b. (a, b) -> b
snd ((Bool, SomeException) -> SomeException)
-> m (Bool, SomeException) -> m SomeException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` s -> m (Bool, SomeException)
forall (m :: * -> *) s.
(SqlTurnIntoSelect s, MonadDB m, MonadThrow m) =>
s -> m (Bool, SomeException)
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 -> SomeException) -> ExceptionMaker
forall row. FromRow row => (row -> SomeException) -> ExceptionMaker
ExceptionMaker (e -> SomeException
forall e. Exception e => e -> SomeException
SomeException (e -> SomeException) -> (row -> e) -> row -> SomeException
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

-- | Implicit exception for `sqlWhere` combinator family.
newtype 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 Exception DBBaseLineConditionIsFalse where
  fromException :: SomeException -> Maybe DBBaseLineConditionIsFalse
fromException se :: SomeException
se@(SomeException e
e) = [Maybe DBBaseLineConditionIsFalse]
-> Maybe DBBaseLineConditionIsFalse
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
    [ e -> Maybe DBBaseLineConditionIsFalse
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
    , do
      DBException {e
sql
dbeQueryContext :: ()
dbeError :: ()
dbeError :: e
dbeQueryContext :: sql
..} <- SomeException -> Maybe DBException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se
      SomeException -> Maybe DBBaseLineConditionIsFalse
forall e. Exception e => SomeException -> Maybe e
fromException (SomeException -> Maybe DBBaseLineConditionIsFalse)
-> (e -> SomeException) -> e -> Maybe DBBaseLineConditionIsFalse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
toException (e -> Maybe DBBaseLineConditionIsFalse)
-> e -> Maybe DBBaseLineConditionIsFalse
forall a b. (a -> b) -> a -> b
$ e
dbeError
    ]

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
    SomeException e
exception <- s -> m SomeException
forall s (m :: * -> *).
(SqlTurnIntoSelect s, MonadDB m, MonadThrow m) =>
s -> m SomeException
kWhyNot1 s
sqlable
    e -> m ()
forall e (m :: * -> *) a.
(Exception e, MonadDB m, MonadThrow m) =>
e -> m a
throwDB e
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
    SomeException e
exception <- s -> m SomeException
forall s (m :: * -> *).
(SqlTurnIntoSelect s, MonadDB m, MonadThrow m) =>
s -> m SomeException
kWhyNot1 s
sqlable
    e -> m ()
forall e (m :: * -> *) a.
(Exception e, MonadDB m, MonadThrow m) =>
e -> m a
throwDB e
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, SomeException e
exception) <- s -> m (Bool, SomeException)
forall (m :: * -> *) s.
(SqlTurnIntoSelect s, MonadDB m, MonadThrow m) =>
s -> m (Bool, SomeException)
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
$
      e -> m ()
forall e (m :: * -> *) a.
(Exception e, MonadDB m, MonadThrow m) =>
e -> m a
throwDB e
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
      SomeException e
exception <- s -> m SomeException
forall s (m :: * -> *).
(SqlTurnIntoSelect s, MonadDB m, MonadThrow m) =>
s -> m SomeException
kWhyNot1 s
sqlcommand
      e -> m a
forall e (m :: * -> *) a.
(Exception e, MonadDB m, MonadThrow m) =>
e -> m a
throwDB e
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
    }