{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE CPP #-}
module Database.Beam.Backend.SQL.Builder
( SqlSyntaxBuilder(..)
, buildSepBy
, quoteSql
, renderSql ) where
import Database.Beam.Backend.SQL
import Control.Monad.IO.Class
import Data.ByteString (ByteString)
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.Text.Encoding as TE
import qualified Data.Text as T
import Data.Text (Text)
import Data.Coerce
import Data.Hashable
import Data.Int
import Data.String
import qualified Control.Monad.Fail as Fail
#if !MIN_VERSION_base(4, 11, 0)
import Data.Semigroup
#endif
newtype SqlSyntaxBuilder
= SqlSyntaxBuilder { buildSql :: Builder }
instance Hashable SqlSyntaxBuilder where
hashWithSalt salt (SqlSyntaxBuilder b) = hashWithSalt salt (toLazyByteString b)
instance Show SqlSyntaxBuilder where
showsPrec prec (SqlSyntaxBuilder s) =
showParen (prec > 10) $
showString "SqlSyntaxBuilder (" .
shows (toLazyByteString s) .
showString ")"
instance Eq SqlSyntaxBuilder where
a == b = toLazyByteString (buildSql a) == toLazyByteString (buildSql b)
instance Semigroup SqlSyntaxBuilder where
(<>) = mappend
instance Monoid SqlSyntaxBuilder where
mempty = SqlSyntaxBuilder mempty
mappend (SqlSyntaxBuilder a) (SqlSyntaxBuilder b) =
SqlSyntaxBuilder (mappend a b)
instance IsSql92Syntax SqlSyntaxBuilder where
type Sql92SelectSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92InsertSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92DeleteSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92UpdateSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
selectCmd = id
insertCmd = id
updateCmd = id
deleteCmd = id
instance IsSql92SelectSyntax SqlSyntaxBuilder where
type Sql92SelectSelectTableSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92SelectOrderingSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
selectStmt tableSrc ordering limit offset =
SqlSyntaxBuilder $
buildSql tableSrc <>
( case ordering of
[] -> mempty
_ -> byteString " ORDER BY " <>
buildSepBy (byteString ", ") (map buildSql ordering) ) <>
maybe mempty (\l -> byteString " LIMIT " <> byteString (fromString (show l))) limit <>
maybe mempty (\o -> byteString " OFFSET " <> byteString (fromString (show o))) offset
instance IsSql92GroupingSyntax SqlSyntaxBuilder where
type Sql92GroupingExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
groupByExpressions es =
SqlSyntaxBuilder $
buildSepBy (byteString ", ") (map buildSql es)
instance IsSql92SelectTableSyntax SqlSyntaxBuilder where
type Sql92SelectTableSelectSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92SelectTableExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92SelectTableProjectionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92SelectTableFromSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92SelectTableGroupingSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92SelectTableSetQuantifierSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
selectTableStmt setQuantifier proj from where_ grouping having =
SqlSyntaxBuilder $
byteString "SELECT " <>
maybe mempty (\setQuantifier' -> buildSql setQuantifier' <> byteString " ") setQuantifier <>
buildSql proj <>
maybe mempty ((byteString " FROM " <>) . buildSql) from <>
maybe mempty (\w -> byteString " WHERE " <> buildSql w) where_ <>
maybe mempty (\g -> byteString " GROUP BY " <> buildSql g) grouping <>
maybe mempty (\e -> byteString " HAVING " <> buildSql e) having
unionTables = tableOp "UNION"
intersectTables = tableOp "INTERSECT"
exceptTable = tableOp "EXCEPT"
tableOp :: ByteString -> Bool -> SqlSyntaxBuilder -> SqlSyntaxBuilder -> SqlSyntaxBuilder
tableOp op all a b =
SqlSyntaxBuilder $
byteString "(" <> buildSql a <> byteString ") " <>
byteString op <> if all then byteString " ALL " else mempty <>
byteString " (" <> buildSql b <> byteString ")"
instance IsSql92InsertSyntax SqlSyntaxBuilder where
type Sql92InsertValuesSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92InsertTableNameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
insertStmt tblNm fields values =
SqlSyntaxBuilder $
byteString "INSERT INTO " <> buildSql tblNm <>
byteString "(" <> buildSepBy (byteString ", ") (map quoteSql fields) <> byteString ") " <>
buildSql values
instance IsSql92InsertValuesSyntax SqlSyntaxBuilder where
type Sql92InsertValuesExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92InsertValuesSelectSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
insertSqlExpressions values =
SqlSyntaxBuilder $
byteString "VALUES " <>
buildSepBy (byteString ", ") (map mkValues values)
where mkValues values' =
byteString "(" <>
buildSepBy (byteString ", ") (map buildSql values') <>
byteString ")"
insertFromSql select = select
instance IsSql92UpdateSyntax SqlSyntaxBuilder where
type Sql92UpdateFieldNameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92UpdateExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92UpdateTableNameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
updateStmt tblNm set where_ =
SqlSyntaxBuilder $
byteString "UPDATE " <> buildSql tblNm <>
(case set of
[] -> mempty
es -> byteString " SET " <> buildSepBy (byteString ", ") (map (\(field, expr) -> buildSql field <> byteString "=" <> buildSql expr) es)) <>
maybe mempty (\where_ -> byteString " WHERE " <> buildSql where_) where_
instance IsSql92DeleteSyntax SqlSyntaxBuilder where
type Sql92DeleteExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92DeleteTableNameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
deleteStmt tblNm alias where_ =
SqlSyntaxBuilder $
byteString "DELETE FROM " <> buildSql tblNm <>
maybe mempty (\alias_ -> byteString " AS " <> quoteSql alias_) alias <>
maybe mempty (\where_ -> byteString " WHERE " <> buildSql where_) where_
deleteSupportsAlias _ = True
instance IsSql92FieldNameSyntax SqlSyntaxBuilder where
qualifiedField a b =
SqlSyntaxBuilder $
byteString "`" <> stringUtf8 (T.unpack a) <> byteString "`.`" <>
stringUtf8 (T.unpack b) <> byteString "`"
unqualifiedField a =
SqlSyntaxBuilder $
byteString "`" <> stringUtf8 (T.unpack a) <> byteString "`"
instance IsSql92QuantifierSyntax SqlSyntaxBuilder where
quantifyOverAll = SqlSyntaxBuilder "ALL"
quantifyOverAny = SqlSyntaxBuilder "ANY"
instance IsSql92ExtractFieldSyntax SqlSyntaxBuilder where
secondsField = SqlSyntaxBuilder (byteString "SECOND")
minutesField = SqlSyntaxBuilder (byteString "MINUTE")
hourField = SqlSyntaxBuilder (byteString "HOUR")
dayField = SqlSyntaxBuilder (byteString "DAY")
monthField = SqlSyntaxBuilder (byteString "MONTH")
yearField = SqlSyntaxBuilder (byteString "YEAR")
instance IsSql92ExpressionSyntax SqlSyntaxBuilder where
type Sql92ExpressionValueSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92ExpressionSelectSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92ExpressionFieldNameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92ExpressionQuantifierSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92ExpressionCastTargetSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92ExpressionExtractFieldSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
rowE vs = SqlSyntaxBuilder $
byteString "(" <>
buildSepBy (byteString ", ") (map buildSql (coerce vs)) <>
byteString ")"
isNotNullE = sqlPostFixOp "IS NOT NULL"
isNullE = sqlPostFixOp "IS NULL"
isTrueE = sqlPostFixOp "IS TRUE"
isFalseE = sqlPostFixOp "IS FALSE"
isUnknownE = sqlPostFixOp "IS UNKNOWN"
isNotTrueE = sqlPostFixOp "IS NOT TRUE"
isNotFalseE = sqlPostFixOp "IS NOT FALSE"
isNotUnknownE = sqlPostFixOp "IS NOT UNKNOWN"
caseE cases else_ =
SqlSyntaxBuilder $
byteString "CASE " <>
foldMap (\(cond, res) -> byteString "WHEN " <> buildSql cond <>
byteString " THEN " <> buildSql res <> byteString " ") cases <>
byteString "ELSE " <> buildSql else_ <> byteString " END"
fieldE = id
nullIfE a b = sqlFuncOp "NULLIF" $
SqlSyntaxBuilder $
byteString "(" <> buildSql a <> byteString "), (" <>
buildSql b <> byteString ")"
positionE needle haystack =
SqlSyntaxBuilder $ byteString "POSITION(" <> buildSql needle <> byteString ") IN (" <> buildSql haystack <> byteString ")"
extractE what from =
SqlSyntaxBuilder $ byteString "EXTRACT(" <> buildSql what <> byteString " FROM (" <> buildSql from <> byteString "))"
absE = sqlFuncOp "ABS"
charLengthE = sqlFuncOp "CHAR_LENGTH"
bitLengthE = sqlFuncOp "BIT_LENGTH"
octetLengthE = sqlFuncOp "OCTET_LENGTH"
lowerE = sqlFuncOp "LOWER"
upperE = sqlFuncOp "UPPER"
trimE = sqlFuncOp "TRIM"
addE = sqlBinOp "+"
likeE = sqlBinOp "LIKE"
subE = sqlBinOp "-"
mulE = sqlBinOp "*"
divE = sqlBinOp "/"
modE = sqlBinOp "%"
overlapsE = sqlBinOp "OVERLAPS"
andE = sqlBinOp "AND"
orE = sqlBinOp "OR"
castE a ty = SqlSyntaxBuilder $
byteString "CAST((" <> buildSql a <> byteString ") AS " <> buildSql ty <> byteString ")"
coalesceE es = SqlSyntaxBuilder $
byteString "COALESCE(" <>
buildSepBy (byteString ", ") (map (\e -> byteString"(" <> buildSql e <> byteString ")") es) <>
byteString ")"
betweenE a b c = SqlSyntaxBuilder $
byteString "(" <> buildSql a <> byteString ") BETWEEN (" <> buildSql b <> byteString ") AND (" <> buildSql c <> byteString ")"
eqE = sqlCompOp "="
neqE = sqlCompOp "<>"
ltE = sqlCompOp "<"
gtE = sqlCompOp ">"
leE = sqlCompOp "<="
geE = sqlCompOp ">="
negateE = sqlUnOp "-"
notE = sqlUnOp "NOT"
existsE = sqlUnOp "EXISTS"
uniqueE = sqlUnOp "UNIQUE"
subqueryE a = SqlSyntaxBuilder $ byteString "(" <> buildSql a <> byteString ")"
valueE = id
currentTimestampE = SqlSyntaxBuilder (byteString "CURRENT_TIMESTAMP")
defaultE = SqlSyntaxBuilder (byteString "DEFAULT")
inE a es = SqlSyntaxBuilder (byteString "(" <> buildSql a <> byteString ") IN (" <>
buildSepBy (byteString ", ") (map buildSql es))
instance IsSql99FunctionExpressionSyntax SqlSyntaxBuilder where
functionNameE fn = SqlSyntaxBuilder (byteString (TE.encodeUtf8 fn))
functionCallE function args =
SqlSyntaxBuilder $
buildSql function <>
byteString "(" <>
buildSepBy (byteString ", ") (map buildSql args) <>
byteString ")"
instance IsSql99ExpressionSyntax SqlSyntaxBuilder where
distinctE = sqlUnOp "DISTINCT"
similarToE = sqlBinOp "SIMILAR TO"
instanceFieldE e fieldNm =
SqlSyntaxBuilder $
byteString "(" <> buildSql e <> byteString ")." <> byteString (TE.encodeUtf8 fieldNm)
refFieldE e fieldNm =
SqlSyntaxBuilder $
byteString "(" <> buildSql e <> byteString ")->" <> byteString (TE.encodeUtf8 fieldNm)
instance IsSql2003ExpressionSyntax SqlSyntaxBuilder where
type Sql2003ExpressionWindowFrameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
overE expr frame =
SqlSyntaxBuilder $
buildSql expr <> buildSql frame
rowNumberE = SqlSyntaxBuilder (byteString "ROW_NUMBER()")
instance IsSql2003WindowFrameSyntax SqlSyntaxBuilder where
type Sql2003WindowFrameExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql2003WindowFrameOrderingSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql2003WindowFrameBoundsSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
frameSyntax partition_ ordering_ bounds_ =
SqlSyntaxBuilder $
byteString " OVER (" <>
maybe mempty (\p -> byteString "PARTITION BY " <> buildSepBy (byteString ", ") (map buildSql p)) partition_ <>
maybe mempty (\o -> byteString " ORDER BY " <> buildSepBy (byteString ", ") (map buildSql o)) ordering_ <>
maybe mempty (\b -> byteString " ROWS " <> buildSql b) bounds_ <>
byteString ")"
instance IsSql2003ExpressionElementaryOLAPOperationsSyntax SqlSyntaxBuilder where
filterAggE agg_ filter_ =
SqlSyntaxBuilder $
buildSql agg_ <> byteString " FILTER (WHERE " <> buildSql filter_ <> byteString ")"
rankAggE = SqlSyntaxBuilder "RANK()"
instance IsSql2003ExpressionAdvancedOLAPOperationsSyntax SqlSyntaxBuilder where
denseRankAggE = SqlSyntaxBuilder "DENSE_RANK()"
percentRankAggE = SqlSyntaxBuilder "PERCENT_RANK()"
cumeDistAggE = SqlSyntaxBuilder "CUME_DIST()"
data SqlWindowFrameBound = SqlWindowFrameUnbounded
| SqlWindowFrameBounded Int
deriving Show
instance IsSql2003WindowFrameBoundsSyntax SqlSyntaxBuilder where
type Sql2003WindowFrameBoundsBoundSyntax SqlSyntaxBuilder = SqlWindowFrameBound
fromToBoundSyntax SqlWindowFrameUnbounded Nothing = SqlSyntaxBuilder "UNBOUNDED PRECEDING"
fromToBoundSyntax (SqlWindowFrameBounded 0) Nothing = SqlSyntaxBuilder "CURRENT ROW"
fromToBoundSyntax (SqlWindowFrameBounded n) Nothing = SqlSyntaxBuilder (fromString (show n) <> " PRECEDING")
fromToBoundSyntax SqlWindowFrameUnbounded (Just SqlWindowFrameUnbounded) =
SqlSyntaxBuilder "BETWEEN UNBOUNDED PRECEDING AND UNBOUNDED FOLLOWING"
fromToBoundSyntax SqlWindowFrameUnbounded (Just (SqlWindowFrameBounded 0)) =
SqlSyntaxBuilder "BETWEEN UNBOUNDED PRECEDING AND CURRENT ROW"
fromToBoundSyntax SqlWindowFrameUnbounded (Just (SqlWindowFrameBounded n)) =
SqlSyntaxBuilder ("BETWEEN UNBOUNDED PRECEDING AND " <> fromString (show n) <> " FOLLOWING")
fromToBoundSyntax (SqlWindowFrameBounded 0) (Just SqlWindowFrameUnbounded) =
SqlSyntaxBuilder "BETWEEN CURRENT ROW AND UNBOUNDED FOLLOWING"
fromToBoundSyntax (SqlWindowFrameBounded 0) (Just (SqlWindowFrameBounded 0)) =
SqlSyntaxBuilder "BETWEEN CURRENT ROW AND CURRENT ROW"
fromToBoundSyntax (SqlWindowFrameBounded 0) (Just (SqlWindowFrameBounded n)) =
SqlSyntaxBuilder ("BETWEEN CURRENT ROW AND " <> fromString (show n) <> " FOLLOWING")
fromToBoundSyntax (SqlWindowFrameBounded n) (Just SqlWindowFrameUnbounded) =
SqlSyntaxBuilder ("BETWEEN " <> fromString (show n) <> " PRECEDING AND UNBOUNDED FOLLOWING")
fromToBoundSyntax (SqlWindowFrameBounded n) (Just (SqlWindowFrameBounded 0)) =
SqlSyntaxBuilder ("BETWEEN " <> fromString (show n) <> " PRECEDING AND CURRENT ROW")
fromToBoundSyntax (SqlWindowFrameBounded n1) (Just (SqlWindowFrameBounded n2)) =
SqlSyntaxBuilder ("BETWEEN " <> fromString (show n1) <> " PRECEDING AND " <> fromString (show n2) <> " FOLLOWING")
instance IsSql2003WindowFrameBoundSyntax SqlWindowFrameBound where
unboundedSyntax = SqlWindowFrameUnbounded
nrowsBoundSyntax = SqlWindowFrameBounded
instance IsSql92AggregationExpressionSyntax SqlSyntaxBuilder where
type Sql92AggregationSetQuantifierSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
countAllE = SqlSyntaxBuilder (byteString "COUNT(*)")
countE q x = SqlSyntaxBuilder (byteString "COUNT(" <> maybe mempty (\q' -> buildSql q' <> byteString " ") q <> buildSql x <> byteString ")")
avgE q x = SqlSyntaxBuilder (byteString "AVG(" <> maybe mempty (\q' -> buildSql q' <> byteString " ") q <> buildSql x <> byteString ")")
minE q x = SqlSyntaxBuilder (byteString "MIN(" <> maybe mempty (\q' -> buildSql q' <> byteString " ") q <> buildSql x <> byteString ")")
maxE q x = SqlSyntaxBuilder (byteString "MAX(" <> maybe mempty (\q' -> buildSql q' <> byteString " ") q <> buildSql x <> byteString ")")
sumE q x = SqlSyntaxBuilder (byteString "SUM(" <> maybe mempty (\q' -> buildSql q' <> byteString " ") q <> buildSql x <> byteString ")")
instance IsSql92AggregationSetQuantifierSyntax SqlSyntaxBuilder where
setQuantifierAll = SqlSyntaxBuilder (byteString "ALL")
setQuantifierDistinct = SqlSyntaxBuilder (byteString "DISTINCT")
instance IsSql92ProjectionSyntax SqlSyntaxBuilder where
type Sql92ProjectionExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
projExprs exprs =
SqlSyntaxBuilder $
buildSepBy (byteString ", ")
(map (\(expr, nm) -> buildSql expr <>
maybe mempty (\nm -> byteString " AS " <> quoteSql nm) nm) exprs)
instance IsSql92OrderingSyntax SqlSyntaxBuilder where
type Sql92OrderingExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
ascOrdering expr = SqlSyntaxBuilder (buildSql expr <> byteString " ASC")
descOrdering expr = SqlSyntaxBuilder (buildSql expr <> byteString " DESC")
instance IsSql92TableSourceSyntax SqlSyntaxBuilder where
type Sql92TableSourceTableNameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92TableSourceSelectSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92TableSourceExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
tableNamed = id
tableFromSubSelect query = SqlSyntaxBuilder (byteString "(" <> buildSql query <> byteString ")")
tableFromValues vss =
SqlSyntaxBuilder $
byteString "VALUES " <>
buildSepBy (byteString ", ")
(map (\vs -> byteString "(" <>
buildSepBy (byteString ", ") (map buildSql vs) <>
byteString ")") vss)
instance IsSql92TableNameSyntax SqlSyntaxBuilder where
tableName Nothing t = SqlSyntaxBuilder $ quoteSql t
tableName (Just s) t = SqlSyntaxBuilder $ quoteSql s <> byteString "." <> quoteSql t
instance IsSql92FromSyntax SqlSyntaxBuilder where
type Sql92FromTableSourceSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
type Sql92FromExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder
fromTable t Nothing = t
fromTable t (Just (nm, colNms)) =
SqlSyntaxBuilder (buildSql t <> byteString " AS " <> quoteSql nm <>
maybe mempty (\colNms' -> byteString "(" <> buildSepBy (byteString ", ") (map quoteSql colNms') <> byteString ")") colNms)
innerJoin = join "INNER JOIN"
leftJoin = join "LEFT JOIN"
rightJoin = join "RIGHT JOIN"
instance IsSql92DataTypeSyntax SqlSyntaxBuilder where
domainType nm = SqlSyntaxBuilder (quoteSql nm)
charType prec charSet = SqlSyntaxBuilder ("CHAR" <> sqlOptPrec prec <> sqlOptCharSet charSet)
varCharType prec charSet = SqlSyntaxBuilder ("VARCHAR" <> sqlOptPrec prec <> sqlOptCharSet charSet)
nationalCharType prec = SqlSyntaxBuilder ("NATIONAL CHAR" <> sqlOptPrec prec)
nationalVarCharType prec = SqlSyntaxBuilder ("NATIONAL CHARACTER VARYING" <> sqlOptPrec prec)
bitType prec = SqlSyntaxBuilder ("BIT" <> sqlOptPrec prec)
varBitType prec = SqlSyntaxBuilder ("BIT VARYING" <> sqlOptPrec prec)
numericType prec = SqlSyntaxBuilder ("NUMERIC" <> sqlOptNumericPrec prec)
decimalType prec = SqlSyntaxBuilder ("DOUBLE" <> sqlOptNumericPrec prec)
intType = SqlSyntaxBuilder "INT"
smallIntType = SqlSyntaxBuilder "SMALLINT"
floatType prec = SqlSyntaxBuilder ("FLOAT" <> sqlOptPrec prec)
doubleType = SqlSyntaxBuilder "DOUBLE PRECISION"
realType = SqlSyntaxBuilder "REAL"
dateType = SqlSyntaxBuilder "DATE"
timeType prec withTz =
SqlSyntaxBuilder ("TIME" <> sqlOptPrec prec <> if withTz then " WITH TIME ZONE" else mempty)
timestampType prec withTz =
SqlSyntaxBuilder ("TIMESTAMP" <> sqlOptPrec prec <> if withTz then " WITH TIME ZONE" else mempty)
sqlOptPrec :: Maybe Word -> Builder
sqlOptPrec Nothing = mempty
sqlOptPrec (Just x) = "(" <> byteString (fromString (show x)) <> ")"
sqlOptCharSet :: Maybe T.Text -> Builder
sqlOptCharSet Nothing = mempty
sqlOptCharSet (Just cs) = " CHARACTER SET " <> byteString (TE.encodeUtf8 cs)
sqlOptNumericPrec :: Maybe (Word, Maybe Word) -> Builder
sqlOptNumericPrec Nothing = mempty
sqlOptNumericPrec (Just (prec, Nothing)) = sqlOptPrec (Just prec)
sqlOptNumericPrec (Just (prec, Just dec)) = "(" <> fromString (show prec) <> ", " <> fromString (show dec) <> ")"
instance HasSqlValueSyntax SqlSyntaxBuilder Int where
sqlValueSyntax x = SqlSyntaxBuilder $
byteString (fromString (show x))
instance HasSqlValueSyntax SqlSyntaxBuilder Int32 where
sqlValueSyntax x = SqlSyntaxBuilder $
byteString (fromString (show x))
instance HasSqlValueSyntax SqlSyntaxBuilder Bool where
sqlValueSyntax True = SqlSyntaxBuilder (byteString "TRUE")
sqlValueSyntax False = SqlSyntaxBuilder (byteString "FALSE")
instance HasSqlValueSyntax SqlSyntaxBuilder Text where
sqlValueSyntax x = SqlSyntaxBuilder $
byteString (fromString (show x))
instance HasSqlValueSyntax SqlSyntaxBuilder SqlNull where
sqlValueSyntax _ = SqlSyntaxBuilder (byteString "NULL")
renderSql :: SqlSyntaxBuilder -> String
renderSql (SqlSyntaxBuilder b) = BL.unpack (toLazyByteString b)
buildSepBy :: Builder -> [Builder] -> Builder
buildSepBy _ [] = mempty
buildSepBy _ [x] = x
buildSepBy sep (x:xs) = x <> sep <> buildSepBy sep xs
quoteSql :: Text -> Builder
quoteSql table =
byteString "\"" <> byteString (TE.encodeUtf8 table) <> byteString "\""
join :: ByteString
-> SqlSyntaxBuilder -> SqlSyntaxBuilder
-> Maybe SqlSyntaxBuilder -> SqlSyntaxBuilder
join type_ a b on =
SqlSyntaxBuilder $
buildSql a <> byteString " " <> byteString type_ <> byteString " " <> buildSql b <>
case on of
Nothing -> mempty
Just on -> byteString " ON (" <> buildSql on <> byteString ")"
sqlPostFixOp, sqlUnOp :: ByteString -> SqlSyntaxBuilder -> SqlSyntaxBuilder
sqlUnOp op a =
SqlSyntaxBuilder $
byteString op <> byteString " (" <> buildSql a <> byteString ")"
sqlPostFixOp op a =
SqlSyntaxBuilder $
byteString "(" <> buildSql a <> byteString ") " <> byteString op
sqlCompOp :: ByteString -> Maybe SqlSyntaxBuilder
-> SqlSyntaxBuilder -> SqlSyntaxBuilder
-> SqlSyntaxBuilder
sqlCompOp op quant a b =
SqlSyntaxBuilder $
byteString "(" <> buildSql a <> byteString ") " <>
byteString op <>
maybe mempty (\quant -> byteString " " <> buildSql quant) quant <>
byteString " (" <> buildSql b <> byteString ")"
sqlBinOp :: ByteString -> SqlSyntaxBuilder -> SqlSyntaxBuilder
-> SqlSyntaxBuilder
sqlBinOp op a b =
SqlSyntaxBuilder $
byteString "(" <> buildSql a <> byteString ") " <>
byteString op <>
byteString " (" <> buildSql b <> byteString ")"
sqlFuncOp :: ByteString -> SqlSyntaxBuilder -> SqlSyntaxBuilder
sqlFuncOp fun a =
SqlSyntaxBuilder $
byteString fun <> byteString "(" <> buildSql a <> byteString")"
newtype SqlSyntaxM a = SqlSyntaxM (IO a)
deriving (Applicative, Functor, Monad, MonadIO, Fail.MonadFail)