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

-- |
--
-- 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') "
module Database.PostgreSQL.PQTypes.SQL.Builder
  ( sqlWhere
  , sqlWhereEq
  , sqlWhereEqSql
  , sqlWhereNotEq
  , sqlWhereEqualsAny
  , sqlWhereIn
  , sqlWhereInSql
  , sqlWhereNotIn
  , sqlWhereNotInSql
  , sqlWhereExists
  , sqlWhereNotExists
  , sqlWhereLike
  , sqlWhereILike
  , sqlWhereIsNULL
  , sqlWhereIsNotNULL
  , sqlFrom
  , sqlJoin
  , sqlJoinOn
  , sqlLeftJoinOn
  , sqlRightJoinOn
  , sqlFullJoinOn
  , sqlOnConflictDoNothing
  , sqlOnConflictOnColumns
  , sqlOnConflictOnColumnsDoNothing
  , sqlSet
  , sqlSetInc
  , sqlSetList
  , sqlSetListWithDefaults
  , sqlSetCmd
  , sqlSetCmdList
  , sqlCopyColumn
  , sqlResult
  , sqlOrderBy
  , sqlGroupBy
  , sqlHaving
  , sqlOffset
  , sqlLimit
  , sqlDistinct
  , sqlWith
  , sqlWithRecursive
  , sqlWithMaterialized
  , sqlUnion
  , sqlUnionAll
  , checkAndRememberMaterializationSupport
  , sqlSelect
  , sqlSelect2
  , SqlSelect (..)
  , sqlInsert
  , SqlInsert (..)
  , sqlInsertSelect
  , SqlInsertSelect (..)
  , sqlUpdate
  , SqlUpdate (..)
  , sqlDelete
  , SqlDelete (..)
  , SqlWhereAll (..)
  , sqlAll
  , SqlWhereAny (..)
  , sqlAny
  , sqlWhereAny
  , SqlResult
  , SqlSet
  , SqlFrom
  , SqlWhere
  , SqlWith
  , SqlOrderBy
  , SqlGroupByHaving
  , SqlOffsetLimit
  , SqlDistinct
  , SqlCondition (..)
  , sqlGetWhereConditions
  , Sqlable (..)
  , sqlOR
  , sqlConcatComma
  , sqlConcatAND
  , sqlConcatOR
  , parenthesize
  , AscDesc (..)
  )
where

import Control.Monad.Catch
import Control.Monad.State
import Data.Either
import Data.IORef
import Data.Int
import Data.List
import Data.Maybe
import Data.Monoid.Utils
import Data.String
import Data.Typeable
import Database.PostgreSQL.PQTypes
import System.IO.Unsafe

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 :: forall m. (IsString m, Monoid m) => 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
$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
/= :: 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
$cshowsPrec :: forall a. Show a => Int -> AscDesc a -> ShowS
showsPrec :: Int -> AscDesc a -> ShowS
$cshow :: forall a. Show a => AscDesc a -> String
show :: AscDesc a -> String
$cshowList :: forall a. Show a => [AscDesc a] -> ShowS
showList :: [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
$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
/= :: 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
$ccompare :: forall a. Ord a => Multiplicity a -> Multiplicity a -> Ordering
compare :: Multiplicity a -> Multiplicity a -> Ordering
$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
>= :: Multiplicity a -> Multiplicity a -> Bool
$cmax :: forall a.
Ord a =>
Multiplicity a -> Multiplicity a -> Multiplicity a
max :: Multiplicity a -> Multiplicity a -> Multiplicity a
$cmin :: forall a.
Ord a =>
Multiplicity a -> Multiplicity a -> Multiplicity a
min :: Multiplicity a -> Multiplicity a -> 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
$cshowsPrec :: forall a. Show a => Int -> Multiplicity a -> ShowS
showsPrec :: Int -> Multiplicity a -> ShowS
$cshow :: forall a. Show a => Multiplicity a -> String
show :: Multiplicity a -> String
$cshowList :: forall a. Show a => [Multiplicity a] -> ShowS
showList :: [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
  | 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
$cshowsPrec :: Int -> SqlCondition -> ShowS
showsPrec :: Int -> SqlCondition -> ShowS
$cshow :: SqlCondition -> String
show :: SqlCondition -> String
$cshowList :: [SqlCondition] -> ShowS
showList :: [SqlCondition] -> ShowS
Show)

instance Sqlable SqlCondition where
  toSQLCommand :: SqlCondition -> SQL
toSQLCommand (SqlPlainCondition SQL
a) = 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 = ["TRUE"]}) SQL -> SQL -> SQL
forall a. Semigroup a => a -> a -> a
<> SQL
")"

data SqlSelect = SqlSelect
  { SqlSelect -> SQL
sqlSelectFrom :: SQL
  , SqlSelect -> [SQL]
sqlSelectUnion :: [SQL]
  , SqlSelect -> [SQL]
sqlSelectUnionAll :: [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, Materialized)]
sqlSelectWith :: [(SQL, SQL, Materialized)]
  , SqlSelect -> Recursive
sqlSelectRecursiveWith :: Recursive
  }

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, Materialized)]
sqlUpdateWith :: [(SQL, SQL, Materialized)]
  , SqlUpdate -> Recursive
sqlUpdateRecursiveWith :: Recursive
  }

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, Materialized)]
sqlInsertWith :: [(SQL, SQL, Materialized)]
  , SqlInsert -> Recursive
sqlInsertRecursiveWith :: Recursive
  }

data SqlInsertSelect = SqlInsertSelect
  { SqlInsertSelect -> SQL
sqlInsertSelectWhat :: SQL
  , SqlInsertSelect -> Maybe (SQL, Maybe SQL)
sqlInsertSelectOnConflict :: Maybe (SQL, Maybe 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, Materialized)]
sqlInsertSelectWith :: [(SQL, SQL, Materialized)]
  , SqlInsertSelect -> Recursive
sqlInsertSelectRecursiveWith :: Recursive
  }

data SqlDelete = SqlDelete
  { SqlDelete -> SQL
sqlDeleteFrom :: SQL
  , SqlDelete -> SQL
sqlDeleteUsing :: SQL
  , SqlDelete -> [SqlCondition]
sqlDeleteWhere :: [SqlCondition]
  , SqlDelete -> [SQL]
sqlDeleteResult :: [SQL]
  , SqlDelete -> [(SQL, SQL, Materialized)]
sqlDeleteWith :: [(SQL, SQL, Materialized)]
  , SqlDelete -> Recursive
sqlDeleteRecursiveWith :: Recursive
  }

-- | Type representing a set of conditions that are joined by 'AND'.
--
-- When no conditions are given, the result is 'TRUE'.
newtype SqlWhereAll = SqlWhereAll
  { SqlWhereAll -> [SqlCondition]
sqlWhereAllWhere :: [SqlCondition]
  }

-- | Type representing a set of conditions that are joined by 'OR'.
--
-- When no conditions are given, the result is 'FALSE'.
newtype SqlWhereAny = SqlWhereAny
  { SqlWhereAny -> [SqlCondition]
sqlWhereAnyWhere :: [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 SqlWhereAll where
  show :: SqlWhereAll -> String
show = SQL -> String
forall a. Show a => a -> String
show (SQL -> String) -> (SqlWhereAll -> SQL) -> SqlWhereAll -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlWhereAll -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand

instance Show SqlWhereAny where
  show :: SqlWhereAny -> String
show = SQL -> String
forall a. Show a => a -> String
show (SQL -> String) -> (SqlWhereAny -> SQL) -> SqlWhereAny -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlWhereAny -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand

emitClause :: Sqlable sql => SQL -> sql -> SQL
emitClause :: forall sql. Sqlable sql => 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 :: forall r.
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
forall r.
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 :: forall r.
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
forall r.
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 :: forall r.
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
forall r.
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 :: forall r.
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
forall r.
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 :: forall r.
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
forall r.
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 (Recursive -> SQL
recursiveClause (Recursive -> SQL) -> Recursive -> SQL
forall a b. (a -> b) -> a -> b
$ SqlSelect -> Recursive
sqlSelectRecursiveWith SqlSelect
cmd) ([SQL] -> SQL) -> [SQL] -> SQL
forall a b. (a -> b) -> a -> b
$
          ((SQL, SQL, Materialized) -> SQL)
-> [(SQL, SQL, Materialized)] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (\(SQL
name, SQL
command, Materialized
mat) -> 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
<+> Materialized -> SQL
materializedClause Materialized
mat SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> SQL
parenthesize SQL
command) (SqlSelect -> [(SQL, SQL, Materialized)]
sqlSelectWith SqlSelect
cmd)
      , if Bool
hasUnion Bool -> Bool -> Bool
|| Bool
hasUnionAll
          then SQL -> SQL -> [SQL] -> SQL
emitClausesSep SQL
"" SQL
unionKeyword (SQL
mainSelectClause SQL -> [SQL] -> [SQL]
forall a. a -> [a] -> [a]
: [SQL]
unionCmd)
          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 a. [a] -> 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 a. [a] -> 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
      hasUnionAll :: Bool
hasUnionAll = Bool -> Bool
not (Bool -> Bool) -> ([SQL] -> Bool) -> [SQL] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SQL] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([SQL] -> Bool) -> [SQL] -> Bool
forall a b. (a -> b) -> a -> b
$ SqlSelect -> [SQL]
sqlSelectUnionAll SqlSelect
cmd
      unionKeyword :: SQL
unionKeyword = case (Bool
hasUnion, Bool
hasUnionAll) of
        (Bool
False, Bool
True) -> SQL
"UNION ALL"
        (Bool
True, Bool
False) -> SQL
"UNION"
        -- False, False is caught by the (hasUnion || hasUnionAll) above.
        -- Hence, the catch-all is implicitly for (True, True).
        (Bool, Bool)
_ -> String -> SQL
forall a. HasCallStack => String -> a
error String
"Having both `sqlSelectUnion` and `sqlSelectUnionAll` is not supported at the moment."
      unionCmd :: [SQL]
unionCmd = case (Bool
hasUnion, Bool
hasUnionAll) of
        (Bool
False, Bool
True) -> SqlSelect -> [SQL]
sqlSelectUnionAll SqlSelect
cmd
        (Bool
True, Bool
False) -> SqlSelect -> [SQL]
sqlSelectUnion SqlSelect
cmd
        -- False, False is caught by the (hasUnion || hasUnionAll) above.
        -- Hence, the catch-all is implicitly for (True, True).
        (Bool, Bool)
_ -> String -> [SQL]
forall a. HasCallStack => String -> a
error String
"Having both `sqlSelectUnion` and `sqlSelectUnionAll` is not supported at the moment."
      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)

emitClauseOnConflictForInsert :: Maybe (SQL, Maybe SQL) -> SQL
emitClauseOnConflictForInsert :: Maybe (SQL, Maybe SQL) -> SQL
emitClauseOnConflictForInsert = \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

instance Sqlable SqlInsert where
  toSQLCommand :: SqlInsert -> SQL
toSQLCommand SqlInsert
cmd =
    SQL -> [SQL] -> SQL
emitClausesSepComma
      (Recursive -> SQL
recursiveClause (Recursive -> SQL) -> Recursive -> SQL
forall a b. (a -> b) -> a -> b
$ SqlInsert -> Recursive
sqlInsertRecursiveWith SqlInsert
cmd)
      (((SQL, SQL, Materialized) -> SQL)
-> [(SQL, SQL, Materialized)] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (\(SQL
name, SQL
command, Materialized
mat) -> 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
<+> Materialized -> SQL
materializedClause Materialized
mat SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> SQL
parenthesize SQL
command) (SqlInsert -> [(SQL, SQL, Materialized)]
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
emitClauseOnConflictForInsert (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
      -- this is the longest list of values
      longest :: Int
longest = [Int] -> Int
forall a. Ord a => [a] -> a
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 a. [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]
replicate Int
longest 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 (Recursive -> SQL
recursiveClause (Recursive -> SQL) -> Recursive -> SQL
forall a b. (a -> b) -> a -> b
$ SqlInsertSelect -> Recursive
sqlInsertSelectRecursiveWith SqlInsertSelect
cmd) ([SQL] -> SQL) -> [SQL] -> SQL
forall a b. (a -> b) -> a -> b
$
          ((SQL, SQL, Materialized) -> SQL)
-> [(SQL, SQL, Materialized)] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (\(SQL
name, SQL
command, Materialized
mat) -> 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
<+> Materialized -> SQL
materializedClause Materialized
mat SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> SQL
parenthesize SQL
command) (SqlInsertSelect -> [(SQL, SQL, Materialized)]
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
            { sqlSelectFrom :: SQL
sqlSelectFrom = SqlInsertSelect -> SQL
sqlInsertSelectFrom SqlInsertSelect
cmd
            , sqlSelectUnion :: [SQL]
sqlSelectUnion = []
            , sqlSelectUnionAll :: [SQL]
sqlSelectUnionAll = []
            , sqlSelectDistinct :: Bool
sqlSelectDistinct = SqlInsertSelect -> Bool
sqlInsertSelectDistinct SqlInsertSelect
cmd
            , sqlSelectResult :: [SQL]
sqlSelectResult = (SQL, SQL) -> SQL
forall a b. (a, b) -> b
snd ((SQL, SQL) -> SQL) -> [(SQL, SQL)] -> [SQL]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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, Materialized)]
sqlSelectWith = []
            , sqlSelectRecursiveWith :: Recursive
sqlSelectRecursiveWith = Recursive
NonRecursive
            }
      , Maybe (SQL, Maybe SQL) -> SQL
emitClauseOnConflictForInsert (SqlInsertSelect -> Maybe (SQL, Maybe SQL)
sqlInsertSelectOnConflict SqlInsertSelect
cmd)
      , SQL -> [SQL] -> SQL
emitClausesSepComma SQL
"RETURNING" ([SQL] -> SQL) -> [SQL] -> SQL
forall a b. (a -> b) -> a -> b
$ SqlInsertSelect -> [SQL]
sqlInsertSelectResult SqlInsertSelect
cmd
      ]

-- This function has to be called as one of first things in your program
-- for the library to make sure that it is aware if the "WITH MATERIALIZED"
-- clause is supported by your PostgreSQL version.
checkAndRememberMaterializationSupport :: (MonadDB m, MonadIO m, MonadMask m) => m ()
checkAndRememberMaterializationSupport :: forall (m :: * -> *). (MonadDB m, MonadIO m, MonadMask m) => m ()
checkAndRememberMaterializationSupport = do
  Either DBException Int64
res :: Either DBException Int64 <- m Int64 -> m (Either DBException Int64)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m Int64 -> m (Either DBException Int64))
-> (m Int64 -> m Int64) -> m Int64 -> m (Either DBException Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Int64 -> m Int64
forall a. m a -> m a
forall (m :: * -> *) a. MonadDB m => m a -> m a
withNewConnection (m Int64 -> m (Either DBException Int64))
-> m Int64 -> m (Either DBException Int64)
forall a b. (a -> b) -> a -> b
$ do
    SQL -> m ()
forall (m :: * -> *).
(HasCallStack, MonadDB m, MonadThrow m) =>
SQL -> m ()
runSQL01_ SQL
"WITH t(n) AS MATERIALIZED (SELECT (1 :: bigint)) SELECT n FROM t LIMIT 1"
    (Identity Int64 -> Int64) -> m Int64
forall (m :: * -> *) row t.
(HasCallStack, MonadDB m, MonadThrow m, FromRow row) =>
(row -> t) -> m t
fetchOne Identity Int64 -> Int64
forall a. Identity a -> a
runIdentity
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
withMaterializedSupported (Either DBException Int64 -> Bool
forall a b. Either a b -> Bool
isRight Either DBException Int64
res)

withMaterializedSupported :: IORef Bool
{-# NOINLINE withMaterializedSupported #-}
withMaterializedSupported :: IORef Bool
withMaterializedSupported = IO (IORef Bool) -> IORef Bool
forall a. IO a -> a
unsafePerformIO (IO (IORef Bool) -> IORef Bool) -> IO (IORef Bool) -> IORef Bool
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False

isWithMaterializedSupported :: Bool
{-# NOINLINE isWithMaterializedSupported #-}
isWithMaterializedSupported :: Bool
isWithMaterializedSupported = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
withMaterializedSupported

materializedClause :: Materialized -> SQL
materializedClause :: Materialized -> SQL
materializedClause Materialized
Materialized = if Bool
isWithMaterializedSupported then SQL
"MATERIALIZED" else SQL
""
materializedClause Materialized
NonMaterialized = if Bool
isWithMaterializedSupported then SQL
"NOT MATERIALIZED" else SQL
""

recursiveClause :: Recursive -> SQL
recursiveClause :: Recursive -> SQL
recursiveClause Recursive
Recursive = SQL
"WITH RECURSIVE"
recursiveClause Recursive
NonRecursive = SQL
"WITH"

instance Sqlable SqlUpdate where
  toSQLCommand :: SqlUpdate -> SQL
toSQLCommand SqlUpdate
cmd =
    SQL -> [SQL] -> SQL
emitClausesSepComma
      (Recursive -> SQL
recursiveClause (Recursive -> SQL) -> Recursive -> SQL
forall a b. (a -> b) -> a -> b
$ SqlUpdate -> Recursive
sqlUpdateRecursiveWith SqlUpdate
cmd)
      (((SQL, SQL, Materialized) -> SQL)
-> [(SQL, SQL, Materialized)] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (\(SQL
name, SQL
command, Materialized
mat) -> 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
<+> Materialized -> SQL
materializedClause Materialized
mat SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> SQL
parenthesize SQL
command) (SqlUpdate -> [(SQL, SQL, Materialized)]
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
      (Recursive -> SQL
recursiveClause (Recursive -> SQL) -> Recursive -> SQL
forall a b. (a -> b) -> a -> b
$ SqlDelete -> Recursive
sqlDeleteRecursiveWith SqlDelete
cmd)
      (((SQL, SQL, Materialized) -> SQL)
-> [(SQL, SQL, Materialized)] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map (\(SQL
name, SQL
command, Materialized
mat) -> 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
<+> Materialized -> SQL
materializedClause Materialized
mat SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> SQL
parenthesize SQL
command) (SqlDelete -> [(SQL, SQL, Materialized)]
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 SqlWhereAll where
  toSQLCommand :: SqlWhereAll -> SQL
toSQLCommand SqlWhereAll
cmd = case SqlWhereAll -> [SqlCondition]
sqlWhereAllWhere SqlWhereAll
cmd of
    [] -> SQL
"TRUE"
    [SqlCondition
cond] -> SqlCondition -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand SqlCondition
cond
    [SqlCondition]
conds -> SQL -> SQL
parenthesize (SQL -> SQL) -> SQL -> SQL
forall a b. (a -> b) -> a -> b
$ 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) [SqlCondition]
conds)

instance Sqlable SqlWhereAny where
  toSQLCommand :: SqlWhereAny -> SQL
toSQLCommand SqlWhereAny
cmd = case SqlWhereAny -> [SqlCondition]
sqlWhereAnyWhere SqlWhereAny
cmd of
    [] -> SQL
"FALSE"
    [SqlCondition
cond] -> SqlCondition -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand SqlCondition
cond
    [SqlCondition]
conds -> SQL -> SQL
parenthesize (SQL -> SQL) -> SQL -> SQL
forall a b. (a -> b) -> a -> b
$ SQL -> [SQL] -> SQL
forall m. (IsString m, Monoid m) => m -> [m] -> m
smintercalate SQL
"OR" ((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) [SqlCondition]
conds)

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]
-> [SQL]
-> Bool
-> [SQL]
-> [SqlCondition]
-> [SQL]
-> [SQL]
-> [SQL]
-> Integer
-> Integer
-> [(SQL, SQL, Materialized)]
-> Recursive
-> SqlSelect
SqlSelect SQL
table [] [] Bool
False [] [] [] [] [] Integer
0 (-Integer
1) [] Recursive
NonRecursive)

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]
-> [SQL]
-> Bool
-> [SQL]
-> [SqlCondition]
-> [SQL]
-> [SQL]
-> [SQL]
-> Integer
-> Integer
-> [(SQL, SQL, Materialized)]
-> Recursive
-> SqlSelect
SqlSelect SQL
from [] [] Bool
False [] [] [] [] [] Integer
0 (-Integer
1) [] Recursive
NonRecursive)

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, Materialized)]
-> Recursive
-> SqlInsert
SqlInsert SQL
table Maybe (SQL, Maybe SQL)
forall a. Maybe a
Nothing [(SQL, Multiplicity SQL)]
forall a. Monoid a => a
mempty [] [] Recursive
NonRecursive)

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
        { sqlInsertSelectWhat :: SQL
sqlInsertSelectWhat = SQL
table
        , sqlInsertSelectOnConflict :: Maybe (SQL, Maybe SQL)
sqlInsertSelectOnConflict = Maybe (SQL, Maybe SQL)
forall a. Maybe a
Nothing
        , 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, Materialized)]
sqlInsertSelectWith = []
        , sqlInsertSelectRecursiveWith :: Recursive
sqlInsertSelectRecursiveWith = Recursive
NonRecursive
        }
    )

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, Materialized)]
-> Recursive
-> SqlUpdate
SqlUpdate SQL
table SQL
forall a. Monoid a => a
mempty [] [] [] [] Recursive
NonRecursive)

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
        { sqlDeleteFrom :: SQL
sqlDeleteFrom = SQL
table
        , sqlDeleteUsing :: SQL
sqlDeleteUsing = SQL
forall a. Monoid a => a
mempty
        , sqlDeleteWhere :: [SqlCondition]
sqlDeleteWhere = []
        , sqlDeleteResult :: [SQL]
sqlDeleteResult = []
        , sqlDeleteWith :: [(SQL, SQL, Materialized)]
sqlDeleteWith = []
        , sqlDeleteRecursiveWith :: Recursive
sqlDeleteRecursiveWith = Recursive
NonRecursive
        }
    )

data Materialized = Materialized | NonMaterialized
data Recursive = Recursive | NonRecursive

-- This instance guarantees that once a single CTE has
-- been marked as recursive, the whole "WITH" block will
-- get the RECURSIVE keyword associated to it.
instance Semigroup Recursive where
  Recursive
_ <> :: Recursive -> Recursive -> Recursive
<> Recursive
Recursive = Recursive
Recursive
  Recursive
Recursive <> Recursive
_ = Recursive
Recursive
  Recursive
_ <> Recursive
_ = Recursive
NonRecursive

class SqlWith a where
  sqlWith1 :: a -> SQL -> SQL -> Materialized -> Recursive -> a

instance SqlWith SqlSelect where
  sqlWith1 :: SqlSelect -> SQL -> SQL -> Materialized -> Recursive -> SqlSelect
sqlWith1 SqlSelect
cmd SQL
name SQL
sql Materialized
mat Recursive
recurse = SqlSelect
cmd {sqlSelectWith = sqlSelectWith cmd ++ [(name, sql, mat)], sqlSelectRecursiveWith = recurse <> sqlSelectRecursiveWith cmd}

instance SqlWith SqlInsertSelect where
  sqlWith1 :: SqlInsertSelect
-> SQL -> SQL -> Materialized -> Recursive -> SqlInsertSelect
sqlWith1 SqlInsertSelect
cmd SQL
name SQL
sql Materialized
mat Recursive
recurse = SqlInsertSelect
cmd {sqlInsertSelectWith = sqlInsertSelectWith cmd ++ [(name, sql, mat)], sqlInsertSelectRecursiveWith = recurse <> sqlInsertSelectRecursiveWith cmd}

instance SqlWith SqlUpdate where
  sqlWith1 :: SqlUpdate -> SQL -> SQL -> Materialized -> Recursive -> SqlUpdate
sqlWith1 SqlUpdate
cmd SQL
name SQL
sql Materialized
mat Recursive
recurse = SqlUpdate
cmd {sqlUpdateWith = sqlUpdateWith cmd ++ [(name, sql, mat)], sqlUpdateRecursiveWith = recurse <> sqlUpdateRecursiveWith cmd}

instance SqlWith SqlDelete where
  sqlWith1 :: SqlDelete -> SQL -> SQL -> Materialized -> Recursive -> SqlDelete
sqlWith1 SqlDelete
cmd SQL
name SQL
sql Materialized
mat Recursive
recurse = SqlDelete
cmd {sqlDeleteWith = sqlDeleteWith cmd ++ [(name, sql, mat)], sqlDeleteRecursiveWith = recurse <> sqlDeleteRecursiveWith cmd}

sqlWith :: (MonadState v m, SqlWith v, Sqlable s) => SQL -> s -> m ()
sqlWith :: forall v (m :: * -> *) s.
(MonadState v m, SqlWith v, Sqlable s) =>
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 -> Materialized -> Recursive -> v
forall a.
SqlWith a =>
a -> SQL -> SQL -> Materialized -> Recursive -> a
sqlWith1 v
cmd SQL
name (s -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand s
sql) Materialized
NonMaterialized Recursive
NonRecursive)

sqlWithMaterialized :: (MonadState v m, SqlWith v, Sqlable s) => SQL -> s -> m ()
sqlWithMaterialized :: forall v (m :: * -> *) s.
(MonadState v m, SqlWith v, Sqlable s) =>
SQL -> s -> m ()
sqlWithMaterialized SQL
name s
sql = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> SQL -> SQL -> Materialized -> Recursive -> v
forall a.
SqlWith a =>
a -> SQL -> SQL -> Materialized -> Recursive -> a
sqlWith1 v
cmd SQL
name (s -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand s
sql) Materialized
Materialized Recursive
NonRecursive)

-- | Note: RECURSIVE only powers SELECTs (but the SELECT can feed an UPDATE outside of the recursive query).
sqlWithRecursive :: (MonadState v m, SqlWith v, Sqlable s) => SQL -> s -> m ()
sqlWithRecursive :: forall v (m :: * -> *) s.
(MonadState v m, SqlWith v, Sqlable s) =>
SQL -> s -> m ()
sqlWithRecursive SQL
name s
sql = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> SQL -> SQL -> Materialized -> Recursive -> v
forall a.
SqlWith a =>
a -> SQL -> SQL -> Materialized -> Recursive -> a
sqlWith1 v
cmd SQL
name (s -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand s
sql) Materialized
NonMaterialized Recursive
Recursive)

-- | 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 :: forall (m :: * -> *) sql.
(MonadState SqlSelect m, Sqlable sql) =>
[sql] -> m ()
sqlUnion [sql]
sqls = (SqlSelect -> SqlSelect) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\SqlSelect
cmd -> SqlSelect
cmd {sqlSelectUnion = map toSQLCommand sqls})

-- | Note: WHERE clause of the main SELECT is treated specially, i.e. it only
-- applies to the main SELECT, not the whole union.
--
-- @since 1.16.4.0
sqlUnionAll :: (MonadState SqlSelect m, Sqlable sql) => [sql] -> m ()
sqlUnionAll :: forall (m :: * -> *) sql.
(MonadState SqlSelect m, Sqlable sql) =>
[sql] -> m ()
sqlUnionAll [sql]
sqls = (SqlSelect -> SqlSelect) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\SqlSelect
cmd -> SqlSelect
cmd {sqlSelectUnionAll = map toSQLCommand 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 = sqlSelectWhere cmd ++ [cond]}
  sqlGetWhereConditions :: SqlSelect -> [SqlCondition]
sqlGetWhereConditions = SqlSelect -> [SqlCondition]
sqlSelectWhere

instance SqlWhere SqlInsertSelect where
  sqlWhere1 :: SqlInsertSelect -> SqlCondition -> SqlInsertSelect
sqlWhere1 SqlInsertSelect
cmd SqlCondition
cond = SqlInsertSelect
cmd {sqlInsertSelectWhere = sqlInsertSelectWhere cmd ++ [cond]}
  sqlGetWhereConditions :: SqlInsertSelect -> [SqlCondition]
sqlGetWhereConditions = SqlInsertSelect -> [SqlCondition]
sqlInsertSelectWhere

instance SqlWhere SqlUpdate where
  sqlWhere1 :: SqlUpdate -> SqlCondition -> SqlUpdate
sqlWhere1 SqlUpdate
cmd SqlCondition
cond = SqlUpdate
cmd {sqlUpdateWhere = sqlUpdateWhere cmd ++ [cond]}
  sqlGetWhereConditions :: SqlUpdate -> [SqlCondition]
sqlGetWhereConditions = SqlUpdate -> [SqlCondition]
sqlUpdateWhere

instance SqlWhere SqlDelete where
  sqlWhere1 :: SqlDelete -> SqlCondition -> SqlDelete
sqlWhere1 SqlDelete
cmd SqlCondition
cond = SqlDelete
cmd {sqlDeleteWhere = sqlDeleteWhere cmd ++ [cond]}
  sqlGetWhereConditions :: SqlDelete -> [SqlCondition]
sqlGetWhereConditions = SqlDelete -> [SqlCondition]
sqlDeleteWhere

instance SqlWhere SqlWhereAll where
  sqlWhere1 :: SqlWhereAll -> SqlCondition -> SqlWhereAll
sqlWhere1 SqlWhereAll
cmd SqlCondition
cond = SqlWhereAll
cmd {sqlWhereAllWhere = sqlWhereAllWhere cmd ++ [cond]}
  sqlGetWhereConditions :: SqlWhereAll -> [SqlCondition]
sqlGetWhereConditions = SqlWhereAll -> [SqlCondition]
sqlWhereAllWhere

instance SqlWhere SqlWhereAny where
  sqlWhere1 :: SqlWhereAny -> SqlCondition -> SqlWhereAny
sqlWhere1 SqlWhereAny
cmd SqlCondition
cond = SqlWhereAny
cmd {sqlWhereAnyWhere = sqlWhereAnyWhere cmd ++ [cond]}
  sqlGetWhereConditions :: SqlWhereAny -> [SqlCondition]
sqlGetWhereConditions = SqlWhereAny -> [SqlCondition]
sqlWhereAnyWhere

-- | 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 :: forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere 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 -> SqlCondition
SqlPlainCondition SQL
sql))

sqlWhereEq :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> a -> m ()
sqlWhereEq :: forall v (m :: * -> *) a.
(MonadState v m, SqlWhere v, Show a, ToSQL a) =>
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

sqlWhereEqSql :: (MonadState v m, SqlWhere v, Sqlable sql) => SQL -> sql -> m ()
sqlWhereEqSql :: forall v (m :: * -> *) sql.
(MonadState v m, SqlWhere v, Sqlable sql) =>
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 :: forall v (m :: * -> *) a.
(MonadState v m, SqlWhere v, Show a, ToSQL a) =>
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

sqlWhereLike :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> a -> m ()
sqlWhereLike :: forall v (m :: * -> *) a.
(MonadState v m, SqlWhere v, Show a, ToSQL a) =>
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

sqlWhereILike :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> a -> m ()
sqlWhereILike :: forall v (m :: * -> *) a.
(MonadState v m, SqlWhere v, Show a, ToSQL a) =>
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

-- | Similar to 'sqlWhereIn', but uses @ANY@ instead of @SELECT UNNEST@.
sqlWhereEqualsAny :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> [a] -> m ()
sqlWhereEqualsAny :: forall v (m :: * -> *) a.
(MonadState v m, SqlWhere v, Show a, ToSQL a) =>
SQL -> [a] -> m ()
sqlWhereEqualsAny 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
"= ANY(" 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
")"

-- | Note: `sqlWhereIn` will unpack the array using `UNNEST`. Using a postgresql function in this way
-- will interfere with the planner. Use `sqlWhereEqualsAny` instead, except if you know that
-- `UNNEST` will optimize better.
sqlWhereIn :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> [a] -> m ()
sqlWhereIn :: forall v (m :: * -> *) a.
(MonadState v m, SqlWhere v, Show a, ToSQL a) =>
SQL -> [a] -> m ()
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 :: forall v (m :: * -> *) a.
(MonadState v m, Sqlable a, SqlWhere v) =>
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)

sqlWhereNotIn :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> [a] -> m ()
sqlWhereNotIn :: forall v (m :: * -> *) a.
(MonadState v m, SqlWhere v, Show a, ToSQL a) =>
SQL -> [a] -> m ()
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 :: forall v (m :: * -> *) a.
(MonadState v m, Sqlable a, SqlWhere v) =>
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)

sqlWhereExists :: (MonadState v m, SqlWhere v) => SqlSelect -> m ()
sqlWhereExists :: forall v (m :: * -> *).
(MonadState v m, SqlWhere v) =>
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 :: forall v (m :: * -> *).
(MonadState v m, SqlWhere v) =>
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 = ["TRUE"]}) SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
")")

sqlWhereIsNULL :: (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhereIsNULL :: forall v (m :: * -> *). (MonadState v m, SqlWhere v) => 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 :: forall v (m :: * -> *). (MonadState v m, SqlWhere v) => 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"

-- | Run monad that joins all conditions using 'AND' operator.
--
-- When no conditions are given, the result is 'TRUE'.
--
-- Note: This is usally not needed as `SqlSelect`, `SqlUpdate` and `SqlDelete`
-- already join conditions using 'AND' by default, but it can be useful when
-- nested in `sqlAny`.
sqlAll :: State SqlWhereAll () -> SQL
sqlAll :: State SqlWhereAll () -> SQL
sqlAll = SqlWhereAll -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand (SqlWhereAll -> SQL)
-> (State SqlWhereAll () -> SqlWhereAll)
-> State SqlWhereAll ()
-> SQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State SqlWhereAll () -> SqlWhereAll -> SqlWhereAll
forall s a. State s a -> s -> s
`execState` [SqlCondition] -> SqlWhereAll
SqlWhereAll [])

-- | Run monad that joins all conditions using 'OR' operator.
--
-- When no conditions are given, the result is 'FALSE'.
sqlAny :: State SqlWhereAny () -> SQL
sqlAny :: State SqlWhereAny () -> SQL
sqlAny = SqlWhereAny -> SQL
forall a. Sqlable a => a -> SQL
toSQLCommand (SqlWhereAny -> SQL)
-> (State SqlWhereAny () -> SqlWhereAny)
-> State SqlWhereAny ()
-> SQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State SqlWhereAny () -> SqlWhereAny -> SqlWhereAny
forall s a. State s a -> s -> s
`execState` [SqlCondition] -> SqlWhereAny
SqlWhereAny [])

-- | Add a condition in the WHERE statement that holds if any of the given
-- condition holds.
--
-- These conditions are joined with 'OR' operator.
-- When no conditions are given, the result is 'FALSE'.
sqlWhereAny :: (MonadState v m, SqlWhere v) => [State SqlWhereAll ()] -> m ()
sqlWhereAny :: forall v (m :: * -> *).
(MonadState v m, SqlWhere v) =>
[State SqlWhereAll ()] -> m ()
sqlWhereAny = SQL -> m ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere (SQL -> m ())
-> ([State SqlWhereAll ()] -> SQL)
-> [State SqlWhereAll ()]
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State SqlWhereAny () -> SQL
sqlAny (State SqlWhereAny () -> SQL)
-> ([State SqlWhereAll ()] -> State SqlWhereAny ())
-> [State SqlWhereAll ()]
-> SQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State SqlWhereAll () -> State SqlWhereAny ())
-> [State SqlWhereAll ()] -> State SqlWhereAny ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SQL -> State SqlWhereAny ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere (SQL -> State SqlWhereAny ())
-> (State SqlWhereAll () -> SQL)
-> State SqlWhereAll ()
-> State SqlWhereAny ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State SqlWhereAll () -> SQL
sqlAll)

class SqlFrom a where
  sqlFrom1 :: a -> SQL -> a

instance SqlFrom SqlSelect where
  sqlFrom1 :: SqlSelect -> SQL -> SqlSelect
sqlFrom1 SqlSelect
cmd SQL
sql = SqlSelect
cmd {sqlSelectFrom = sqlSelectFrom cmd <+> sql}

instance SqlFrom SqlInsertSelect where
  sqlFrom1 :: SqlInsertSelect -> SQL -> SqlInsertSelect
sqlFrom1 SqlInsertSelect
cmd SQL
sql = SqlInsertSelect
cmd {sqlInsertSelectFrom = sqlInsertSelectFrom cmd <+> sql}

instance SqlFrom SqlUpdate where
  sqlFrom1 :: SqlUpdate -> SQL -> SqlUpdate
sqlFrom1 SqlUpdate
cmd SQL
sql = SqlUpdate
cmd {sqlUpdateFrom = sqlUpdateFrom cmd <+> sql}

instance SqlFrom SqlDelete where
  sqlFrom1 :: SqlDelete -> SQL -> SqlDelete
sqlFrom1 SqlDelete
cmd SQL
sql = SqlDelete
cmd {sqlDeleteUsing = sqlDeleteUsing cmd <+> sql}

sqlFrom :: (MonadState v m, SqlFrom v) => SQL -> m ()
sqlFrom :: forall v (m :: * -> *). (MonadState v m, SqlFrom v) => 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 :: forall v (m :: * -> *). (MonadState v m, SqlFrom v) => 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 :: forall v (m :: * -> *).
(MonadState v m, SqlFrom v) =>
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 :: forall v (m :: * -> *).
(MonadState v m, SqlFrom v) =>
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 :: forall v (m :: * -> *).
(MonadState v m, SqlFrom v) =>
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 :: forall v (m :: * -> *).
(MonadState v m, SqlFrom v) =>
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 = sqlUpdateSet cmd ++ [(name, v)]}

instance SqlSet SqlInsert where
  sqlSet1 :: SqlInsert -> SQL -> SQL -> SqlInsert
sqlSet1 SqlInsert
cmd SQL
name SQL
v = SqlInsert
cmd {sqlInsertSet = sqlInsertSet cmd ++ [(name, Single v)]}

instance SqlSet SqlInsertSelect where
  sqlSet1 :: SqlInsertSelect -> SQL -> SQL -> SqlInsertSelect
sqlSet1 SqlInsertSelect
cmd SQL
name SQL
v = SqlInsertSelect
cmd {sqlInsertSelectSet = sqlInsertSelectSet cmd ++ [(name, v)]}

sqlSetCmd :: (MonadState v m, SqlSet v) => SQL -> SQL -> m ()
sqlSetCmd :: forall v (m :: * -> *).
(MonadState v m, SqlSet v) =>
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 :: forall (m :: * -> *).
MonadState SqlInsert m =>
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 = sqlInsertSet cmd ++ [(name, Many as)]})

sqlSet :: (MonadState v m, SqlSet v, Show a, ToSQL a) => SQL -> a -> m ()
sqlSet :: forall v (m :: * -> *) a.
(MonadState v m, SqlSet v, Show a, ToSQL a) =>
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 :: forall v (m :: * -> *). (MonadState v m, SqlSet v) => 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 :: forall (m :: * -> *) a.
(MonadState SqlInsert m, Show a, ToSQL a) =>
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 :: forall (m :: * -> *) a.
(MonadState SqlInsert m, Show a, ToSQL a) =>
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 :: forall v (m :: * -> *). (MonadState v m, SqlSet v) => 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 SqlOnConflict a where
  sqlOnConflictDoNothing1 :: a -> a
  sqlOnConflictOnColumnsDoNothing1 :: a -> [SQL] -> a
  sqlOnConflictOnColumns1 :: Sqlable sql => a -> [SQL] -> sql -> a

instance SqlOnConflict SqlInsert where
  sqlOnConflictDoNothing1 :: SqlInsert -> SqlInsert
sqlOnConflictDoNothing1 SqlInsert
cmd =
    SqlInsert
cmd {sqlInsertOnConflict = Just ("", Nothing)}
  sqlOnConflictOnColumns1 :: forall sql. Sqlable sql => SqlInsert -> [SQL] -> sql -> SqlInsert
sqlOnConflictOnColumns1 SqlInsert
cmd [SQL]
columns sql
sql =
    SqlInsert
cmd {sqlInsertOnConflict = Just (parenthesize $ sqlConcatComma columns, Just $ toSQLCommand sql)}
  sqlOnConflictOnColumnsDoNothing1 :: SqlInsert -> [SQL] -> SqlInsert
sqlOnConflictOnColumnsDoNothing1 SqlInsert
cmd [SQL]
columns =
    SqlInsert
cmd {sqlInsertOnConflict = Just (parenthesize $ sqlConcatComma columns, Nothing)}

instance SqlOnConflict SqlInsertSelect where
  sqlOnConflictDoNothing1 :: SqlInsertSelect -> SqlInsertSelect
sqlOnConflictDoNothing1 SqlInsertSelect
cmd =
    SqlInsertSelect
cmd {sqlInsertSelectOnConflict = Just ("", Nothing)}
  sqlOnConflictOnColumns1 :: forall sql.
Sqlable sql =>
SqlInsertSelect -> [SQL] -> sql -> SqlInsertSelect
sqlOnConflictOnColumns1 SqlInsertSelect
cmd [SQL]
columns sql
sql =
    SqlInsertSelect
cmd {sqlInsertSelectOnConflict = Just (parenthesize $ sqlConcatComma columns, Just $ toSQLCommand sql)}
  sqlOnConflictOnColumnsDoNothing1 :: SqlInsertSelect -> [SQL] -> SqlInsertSelect
sqlOnConflictOnColumnsDoNothing1 SqlInsertSelect
cmd [SQL]
columns =
    SqlInsertSelect
cmd {sqlInsertSelectOnConflict = Just (parenthesize $ sqlConcatComma columns, Nothing)}

sqlOnConflictDoNothing :: (MonadState v m, SqlOnConflict v) => m ()
sqlOnConflictDoNothing :: forall v (m :: * -> *). (MonadState v m, SqlOnConflict v) => m ()
sqlOnConflictDoNothing = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify v -> v
forall a. SqlOnConflict a => a -> a
sqlOnConflictDoNothing1

sqlOnConflictOnColumnsDoNothing :: (MonadState v m, SqlOnConflict v) => [SQL] -> m ()
sqlOnConflictOnColumnsDoNothing :: forall v (m :: * -> *).
(MonadState v m, SqlOnConflict v) =>
[SQL] -> m ()
sqlOnConflictOnColumnsDoNothing [SQL]
columns = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> [SQL] -> v
forall a. SqlOnConflict a => a -> [SQL] -> a
sqlOnConflictOnColumnsDoNothing1 v
cmd [SQL]
columns)

sqlOnConflictOnColumns :: (MonadState v m, SqlOnConflict v, Sqlable sql) => [SQL] -> sql -> m ()
sqlOnConflictOnColumns :: forall v (m :: * -> *) sql.
(MonadState v m, SqlOnConflict v, Sqlable sql) =>
[SQL] -> sql -> m ()
sqlOnConflictOnColumns [SQL]
columns sql
sql = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\v
cmd -> v -> [SQL] -> sql -> v
forall a sql.
(SqlOnConflict a, Sqlable sql) =>
a -> [SQL] -> sql -> a
forall sql. Sqlable sql => v -> [SQL] -> sql -> v
sqlOnConflictOnColumns1 v
cmd [SQL]
columns sql
sql)

class SqlResult a where
  sqlResult1 :: a -> SQL -> a

instance SqlResult SqlSelect where
  sqlResult1 :: SqlSelect -> SQL -> SqlSelect
sqlResult1 SqlSelect
cmd SQL
sql = SqlSelect
cmd {sqlSelectResult = sqlSelectResult cmd ++ [sql]}

instance SqlResult SqlInsert where
  sqlResult1 :: SqlInsert -> SQL -> SqlInsert
sqlResult1 SqlInsert
cmd SQL
sql = SqlInsert
cmd {sqlInsertResult = sqlInsertResult cmd ++ [sql]}

instance SqlResult SqlInsertSelect where
  sqlResult1 :: SqlInsertSelect -> SQL -> SqlInsertSelect
sqlResult1 SqlInsertSelect
cmd SQL
sql = SqlInsertSelect
cmd {sqlInsertSelectResult = sqlInsertSelectResult cmd ++ [sql]}

instance SqlResult SqlUpdate where
  sqlResult1 :: SqlUpdate -> SQL -> SqlUpdate
sqlResult1 SqlUpdate
cmd SQL
sql = SqlUpdate
cmd {sqlUpdateResult = sqlUpdateResult cmd ++ [sql]}

instance SqlResult SqlDelete where
  sqlResult1 :: SqlDelete -> SQL -> SqlDelete
sqlResult1 SqlDelete
cmd SQL
sql = SqlDelete
cmd {sqlDeleteResult = sqlDeleteResult cmd ++ [sql]}

sqlResult :: (MonadState v m, SqlResult v) => SQL -> m ()
sqlResult :: forall v (m :: * -> *).
(MonadState v m, SqlResult v) =>
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 = sqlSelectOrderBy cmd ++ [sql]}

instance SqlOrderBy SqlInsertSelect where
  sqlOrderBy1 :: SqlInsertSelect -> SQL -> SqlInsertSelect
sqlOrderBy1 SqlInsertSelect
cmd SQL
sql = SqlInsertSelect
cmd {sqlInsertSelectOrderBy = sqlInsertSelectOrderBy cmd ++ [sql]}

sqlOrderBy :: (MonadState v m, SqlOrderBy v) => SQL -> m ()
sqlOrderBy :: forall v (m :: * -> *).
(MonadState v m, SqlOrderBy v) =>
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 = sqlSelectGroupBy cmd ++ [sql]}
  sqlHaving1 :: SqlSelect -> SQL -> SqlSelect
sqlHaving1 SqlSelect
cmd SQL
sql = SqlSelect
cmd {sqlSelectHaving = sqlSelectHaving cmd ++ [sql]}

instance SqlGroupByHaving SqlInsertSelect where
  sqlGroupBy1 :: SqlInsertSelect -> SQL -> SqlInsertSelect
sqlGroupBy1 SqlInsertSelect
cmd SQL
sql = SqlInsertSelect
cmd {sqlInsertSelectGroupBy = sqlInsertSelectGroupBy cmd ++ [sql]}
  sqlHaving1 :: SqlInsertSelect -> SQL -> SqlInsertSelect
sqlHaving1 SqlInsertSelect
cmd SQL
sql = SqlInsertSelect
cmd {sqlInsertSelectHaving = sqlInsertSelectHaving cmd ++ [sql]}

sqlGroupBy :: (MonadState v m, SqlGroupByHaving v) => SQL -> m ()
sqlGroupBy :: forall v (m :: * -> *).
(MonadState v m, SqlGroupByHaving v) =>
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 :: forall v (m :: * -> *).
(MonadState v m, SqlGroupByHaving v) =>
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 = num}
  sqlLimit1 :: SqlSelect -> Integer -> SqlSelect
sqlLimit1 SqlSelect
cmd Integer
num = SqlSelect
cmd {sqlSelectLimit = num}

instance SqlOffsetLimit SqlInsertSelect where
  sqlOffset1 :: SqlInsertSelect -> Integer -> SqlInsertSelect
sqlOffset1 SqlInsertSelect
cmd Integer
num = SqlInsertSelect
cmd {sqlInsertSelectOffset = num}
  sqlLimit1 :: SqlInsertSelect -> Integer -> SqlInsertSelect
sqlLimit1 SqlInsertSelect
cmd Integer
num = SqlInsertSelect
cmd {sqlInsertSelectLimit = num}

sqlOffset :: (MonadState v m, SqlOffsetLimit v, Integral int) => int -> m ()
sqlOffset :: forall v (m :: * -> *) int.
(MonadState v m, SqlOffsetLimit v, Integral int) =>
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 :: forall v (m :: * -> *) int.
(MonadState v m, SqlOffsetLimit v, Integral int) =>
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 = True}

instance SqlDistinct SqlInsertSelect where
  sqlDistinct1 :: SqlInsertSelect -> SqlInsertSelect
sqlDistinct1 SqlInsertSelect
cmd = SqlInsertSelect
cmd {sqlInsertSelectDistinct = True}

sqlDistinct :: (MonadState v m, SqlDistinct v) => m ()
sqlDistinct :: forall v (m :: * -> *). (MonadState v m, SqlDistinct v) => m ()
sqlDistinct = (v -> v) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify v -> v
forall a. SqlDistinct a => a -> a
sqlDistinct1