{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}
module Database.MySQL.Hasqlator
(
Query, Command, select, mergeSelect, replaceSelect,
QueryClauses, from, innerJoin, leftJoin, rightJoin, outerJoin, emptyJoins,
where_, emptyWhere, groupBy_, having, emptyHaving, QueryOrdering(..),
orderBy, limit, limitOffset,
Selector, as,
sel,
intSel, integerSel, doubleSel, floatSel, scientificSel,
localTimeSel, timeOfDaySel, diffTimeSel, daySel, byteStringSel,
textSel,
rawValues, rawValues_,
subQuery,
arg, fun, op, isNull, isNotNull, (>.), (<.), (>=.), (<=.), (+.), (-.), (*.),
(/.), (=.), (++.), (/=.), (&&.), (||.), abs_, negate_, signum_, sum_,
rawSql, substr, in_, false_, true_, notIn_, values,
Insertor, insertValues, insertUpdateValues, insertSelect, insertData,
skipInsert, into, exprInto, Getter, lensInto, insertOne, ToSql,
update,
renderStmt, renderPreparedStmt, SQLError(..), QueryBuilder,
ToQueryBuilder(..), FromSql,
executeQuery, executeCommand
)
where
import Database.MySQL.Base hiding (Query, Command)
import qualified Database.MySQL.Base as MySQL
import Prelude hiding (unwords)
import Control.Monad.State
import Control.Applicative
import Control.Monad.Except
import Data.Monoid hiding ((<>))
import Data.String hiding (unwords)
import Data.List hiding (unwords)
import qualified Data.DList as DList
import GHC.Generics hiding (Selector, from)
import qualified GHC.Generics as Generics (from)
import Data.DList (DList)
import Data.Scientific
import Data.Word
import Data.Int
import Data.Time
import qualified Data.ByteString as StrictBS
import qualified Data.ByteString.Lazy as LazyBS
import Data.ByteString.Lazy.Builder (Builder)
import qualified Data.ByteString.Lazy.Builder as Builder
import qualified Data.Text.Encoding as Text
import qualified Data.Text as Text
import Data.Text (Text)
import Data.Binary.Put
import Data.Traversable
import Data.Functor.Contravariant
import qualified System.IO.Streams as Streams
import Control.Exception (throw, Exception)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Text as Aeson
import qualified Data.Text.Lazy as LazyText
class FromSql a where
fromSql :: MySQLValue -> Either SQLError a
class ToSql a where
toSqlValue :: a -> MySQLValue
instance FromSql a => IsString (Selector a) where
fromString :: String -> Selector a
fromString = QueryBuilder -> Selector a
forall a. FromSql a => QueryBuilder -> Selector a
sel (QueryBuilder -> Selector a)
-> (String -> QueryBuilder) -> String -> Selector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QueryBuilder
forall a. IsString a => String -> a
fromString
class ToQueryBuilder a where
toQueryBuilder :: a -> QueryBuilder
renderStmt :: ToQueryBuilder a => a -> LazyBS.ByteString
renderStmt :: a -> ByteString
renderStmt a
a = Builder -> ByteString
Builder.toLazyByteString Builder
stmt
where
QueryBuilder Builder
stmt Builder
_ DList MySQLValue
_ = a -> QueryBuilder
forall a. ToQueryBuilder a => a -> QueryBuilder
toQueryBuilder a
a
renderPreparedStmt :: ToQueryBuilder a => a -> (LazyBS.ByteString, [MySQLValue])
renderPreparedStmt :: a -> (ByteString, [MySQLValue])
renderPreparedStmt a
a = (Builder -> ByteString
Builder.toLazyByteString Builder
pstmt, DList MySQLValue -> [MySQLValue]
forall a. DList a -> [a]
DList.toList DList MySQLValue
args)
where
QueryBuilder Builder
_ Builder
pstmt DList MySQLValue
args = a -> QueryBuilder
forall a. ToQueryBuilder a => a -> QueryBuilder
toQueryBuilder a
a
executeQuery :: MySQLConn -> Query a -> IO [a]
executeQuery :: MySQLConn -> Query a -> IO [a]
executeQuery MySQLConn
conn q :: Query a
q@(Query Selector a
s QueryBody
_) =
do InputStream [MySQLValue]
is <- (([ColumnDef], InputStream [MySQLValue])
-> InputStream [MySQLValue])
-> IO ([ColumnDef], InputStream [MySQLValue])
-> IO (InputStream [MySQLValue])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ColumnDef], InputStream [MySQLValue]) -> InputStream [MySQLValue]
forall a b. (a, b) -> b
snd (IO ([ColumnDef], InputStream [MySQLValue])
-> IO (InputStream [MySQLValue]))
-> IO ([ColumnDef], InputStream [MySQLValue])
-> IO (InputStream [MySQLValue])
forall a b. (a -> b) -> a -> b
$ MySQLConn -> Query -> IO ([ColumnDef], InputStream [MySQLValue])
MySQL.query_ MySQLConn
conn (Query -> IO ([ColumnDef], InputStream [MySQLValue]))
-> Query -> IO ([ColumnDef], InputStream [MySQLValue])
forall a b. (a -> b) -> a -> b
$ ByteString -> Query
MySQL.Query (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$ Query a -> ByteString
forall a. ToQueryBuilder a => a -> ByteString
renderStmt Query a
q
[[MySQLValue]]
results <- InputStream [MySQLValue] -> IO [[MySQLValue]]
forall a. InputStream a -> IO [a]
Streams.toList InputStream [MySQLValue]
is
[[MySQLValue]] -> ([MySQLValue] -> IO a) -> IO [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [[MySQLValue]]
results (([MySQLValue] -> IO a) -> IO [a])
-> ([MySQLValue] -> IO a) -> IO [a]
forall a b. (a -> b) -> a -> b
$ (SQLError -> IO a) -> (a -> IO a) -> Either SQLError a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SQLError -> IO a
forall a e. Exception e => e -> a
throw a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SQLError a -> IO a)
-> ([MySQLValue] -> Either SQLError a) -> [MySQLValue] -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector a -> [MySQLValue] -> Either SQLError a
forall a. Selector a -> [MySQLValue] -> Either SQLError a
runSelector Selector a
s
executeCommand :: MySQLConn -> Command -> IO OK
executeCommand :: MySQLConn -> Command -> IO OK
executeCommand MySQLConn
conn Command
c = MySQLConn -> Query -> IO OK
MySQL.execute_ MySQLConn
conn (Query -> IO OK) -> Query -> IO OK
forall a b. (a -> b) -> a -> b
$ ByteString -> Query
MySQL.Query (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$ Command -> ByteString
forall a. ToQueryBuilder a => a -> ByteString
renderStmt Command
c
selectOne :: (MySQLValue -> Either SQLError a) -> QueryBuilder -> Selector a
selectOne :: (MySQLValue -> Either SQLError a) -> QueryBuilder -> Selector a
selectOne MySQLValue -> Either SQLError a
f QueryBuilder
fieldName =
DList QueryBuilder
-> StateT [MySQLValue] (Either SQLError) a -> Selector a
forall a.
DList QueryBuilder
-> StateT [MySQLValue] (Either SQLError) a -> Selector a
Selector (QueryBuilder -> DList QueryBuilder
forall a. a -> DList a
DList.singleton QueryBuilder
fieldName) (StateT [MySQLValue] (Either SQLError) a -> Selector a)
-> StateT [MySQLValue] (Either SQLError) a -> Selector a
forall a b. (a -> b) -> a -> b
$ do
[MySQLValue]
results <- StateT [MySQLValue] (Either SQLError) [MySQLValue]
forall s (m :: * -> *). MonadState s m => m s
get
case [MySQLValue]
results of
[] -> SQLError -> StateT [MySQLValue] (Either SQLError) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SQLError
ResultSetCountError
(MySQLValue
r1:[MySQLValue]
rest) -> do
[MySQLValue] -> StateT [MySQLValue] (Either SQLError) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [MySQLValue]
rest
Either SQLError a -> StateT [MySQLValue] (Either SQLError) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either SQLError a -> StateT [MySQLValue] (Either SQLError) a)
-> Either SQLError a -> StateT [MySQLValue] (Either SQLError) a
forall a b. (a -> b) -> a -> b
$ MySQLValue -> Either SQLError a
f MySQLValue
r1
sel :: FromSql a => QueryBuilder -> Selector a
sel :: QueryBuilder -> Selector a
sel QueryBuilder
fieldName = (MySQLValue -> Either SQLError a) -> QueryBuilder -> Selector a
forall a.
(MySQLValue -> Either SQLError a) -> QueryBuilder -> Selector a
selectOne MySQLValue -> Either SQLError a
forall a. FromSql a => MySQLValue -> Either SQLError a
fromSql QueryBuilder
fieldName
intSel :: (Show a, Bounded a, Integral a) => QueryBuilder -> Selector a
intSel :: QueryBuilder -> Selector a
intSel QueryBuilder
e = (MySQLValue -> Either SQLError a) -> QueryBuilder -> Selector a
forall a.
(MySQLValue -> Either SQLError a) -> QueryBuilder -> Selector a
selectOne MySQLValue -> Either SQLError a
forall a.
(Show a, Bounded a, Integral a) =>
MySQLValue -> Either SQLError a
intFromSql QueryBuilder
e
integerSel :: QueryBuilder -> Selector Integer
integerSel :: QueryBuilder -> Selector Integer
integerSel = QueryBuilder -> Selector Integer
forall a. FromSql a => QueryBuilder -> Selector a
sel
doubleSel :: QueryBuilder -> Selector Double
doubleSel :: QueryBuilder -> Selector Double
doubleSel = QueryBuilder -> Selector Double
forall a. FromSql a => QueryBuilder -> Selector a
sel
floatSel :: QueryBuilder -> Selector Float
floatSel :: QueryBuilder -> Selector Float
floatSel = QueryBuilder -> Selector Float
forall a. FromSql a => QueryBuilder -> Selector a
sel
scientificSel :: QueryBuilder -> Selector Scientific
scientificSel :: QueryBuilder -> Selector Scientific
scientificSel = QueryBuilder -> Selector Scientific
forall a. FromSql a => QueryBuilder -> Selector a
sel
localTimeSel :: QueryBuilder -> Selector LocalTime
localTimeSel :: QueryBuilder -> Selector LocalTime
localTimeSel = QueryBuilder -> Selector LocalTime
forall a. FromSql a => QueryBuilder -> Selector a
sel
timeOfDaySel :: QueryBuilder -> Selector TimeOfDay
timeOfDaySel :: QueryBuilder -> Selector TimeOfDay
timeOfDaySel = QueryBuilder -> Selector TimeOfDay
forall a. FromSql a => QueryBuilder -> Selector a
sel
diffTimeSel :: QueryBuilder -> Selector DiffTime
diffTimeSel :: QueryBuilder -> Selector DiffTime
diffTimeSel = QueryBuilder -> Selector DiffTime
forall a. FromSql a => QueryBuilder -> Selector a
sel
daySel :: QueryBuilder -> Selector Day
daySel :: QueryBuilder -> Selector Day
daySel = QueryBuilder -> Selector Day
forall a. FromSql a => QueryBuilder -> Selector a
sel
byteStringSel :: QueryBuilder -> Selector StrictBS.ByteString
byteStringSel :: QueryBuilder -> Selector ByteString
byteStringSel = QueryBuilder -> Selector ByteString
forall a. FromSql a => QueryBuilder -> Selector a
sel
textSel :: QueryBuilder -> Selector Text
textSel :: QueryBuilder -> Selector Text
textSel = QueryBuilder -> Selector Text
forall a. FromSql a => QueryBuilder -> Selector a
sel
data SQLError = SQLError String
| ResultSetCountError
| TypeError MySQLValue String
| ConversionError Text
deriving Int -> SQLError -> ShowS
[SQLError] -> ShowS
SQLError -> String
(Int -> SQLError -> ShowS)
-> (SQLError -> String) -> ([SQLError] -> ShowS) -> Show SQLError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SQLError] -> ShowS
$cshowList :: [SQLError] -> ShowS
show :: SQLError -> String
$cshow :: SQLError -> String
showsPrec :: Int -> SQLError -> ShowS
$cshowsPrec :: Int -> SQLError -> ShowS
Show
instance Exception SQLError
data Selector a = Selector (DList QueryBuilder)
(StateT [MySQLValue] (Either SQLError) a)
runSelector :: Selector a -> [MySQLValue] -> Either SQLError a
runSelector :: Selector a -> [MySQLValue] -> Either SQLError a
runSelector (Selector DList QueryBuilder
_ StateT [MySQLValue] (Either SQLError) a
run) = StateT [MySQLValue] (Either SQLError) a
-> [MySQLValue] -> Either SQLError a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT [MySQLValue] (Either SQLError) a
run
instance Functor Selector where
fmap :: (a -> b) -> Selector a -> Selector b
fmap a -> b
f (Selector DList QueryBuilder
cols StateT [MySQLValue] (Either SQLError) a
cast) = DList QueryBuilder
-> StateT [MySQLValue] (Either SQLError) b -> Selector b
forall a.
DList QueryBuilder
-> StateT [MySQLValue] (Either SQLError) a -> Selector a
Selector DList QueryBuilder
cols (StateT [MySQLValue] (Either SQLError) b -> Selector b)
-> StateT [MySQLValue] (Either SQLError) b -> Selector b
forall a b. (a -> b) -> a -> b
$ (a -> b)
-> StateT [MySQLValue] (Either SQLError) a
-> StateT [MySQLValue] (Either SQLError) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f StateT [MySQLValue] (Either SQLError) a
cast
instance Applicative Selector where
Selector DList QueryBuilder
cols1 StateT [MySQLValue] (Either SQLError) (a -> b)
cast1 <*> :: Selector (a -> b) -> Selector a -> Selector b
<*> Selector DList QueryBuilder
cols2 StateT [MySQLValue] (Either SQLError) a
cast2 =
DList QueryBuilder
-> StateT [MySQLValue] (Either SQLError) b -> Selector b
forall a.
DList QueryBuilder
-> StateT [MySQLValue] (Either SQLError) a -> Selector a
Selector (DList QueryBuilder
cols1 DList QueryBuilder -> DList QueryBuilder -> DList QueryBuilder
forall a. Semigroup a => a -> a -> a
<> DList QueryBuilder
cols2) (StateT [MySQLValue] (Either SQLError) (a -> b)
cast1 StateT [MySQLValue] (Either SQLError) (a -> b)
-> StateT [MySQLValue] (Either SQLError) a
-> StateT [MySQLValue] (Either SQLError) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT [MySQLValue] (Either SQLError) a
cast2)
pure :: a -> Selector a
pure a
x = DList QueryBuilder
-> StateT [MySQLValue] (Either SQLError) a -> Selector a
forall a.
DList QueryBuilder
-> StateT [MySQLValue] (Either SQLError) a -> Selector a
Selector DList QueryBuilder
forall a. DList a
DList.empty (StateT [MySQLValue] (Either SQLError) a -> Selector a)
-> StateT [MySQLValue] (Either SQLError) a -> Selector a
forall a b. (a -> b) -> a -> b
$ a -> StateT [MySQLValue] (Either SQLError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
instance Semigroup a => Semigroup (Selector a) where
<> :: Selector a -> Selector a -> Selector a
(<>) = (a -> a -> a) -> Selector a -> Selector a -> Selector a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance Monoid a => Monoid (Selector a) where
mempty :: Selector a
mempty = a -> Selector a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
data Query a = Query (Selector a) QueryBody
data Command = Update [QueryBuilder] [(QueryBuilder, QueryBuilder)] QueryBody
| InsertSelect QueryBuilder [QueryBuilder] [QueryBuilder] QueryBody
| forall a.InsertValues QueryBuilder (Insertor a)
(Maybe [(QueryBuilder, QueryBuilder)]) [a]
| forall a.Delete (Query a)
data Insertor a = Insertor [Text] (a -> [QueryBuilder])
data Join = Join JoinType [QueryBuilder] [QueryBuilder]
data JoinType = InnerJoin | LeftJoin | RightJoin | OuterJoin
pairQuery :: (QueryBuilder, QueryBuilder) -> QueryBuilder
pairQuery :: (QueryBuilder, QueryBuilder) -> QueryBuilder
pairQuery (QueryBuilder
a, QueryBuilder
b) = QueryBuilder
a QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder
" = " QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder
b
instance ToQueryBuilder Command where
toQueryBuilder :: Command -> QueryBuilder
toQueryBuilder (Update [QueryBuilder]
tables [(QueryBuilder, QueryBuilder)]
setting QueryBody
body) =
[QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
unwords
[ QueryBuilder
"UPDATE", [QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep [QueryBuilder]
tables
, QueryBuilder
"SET", [QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep ([QueryBuilder] -> QueryBuilder) -> [QueryBuilder] -> QueryBuilder
forall a b. (a -> b) -> a -> b
$ ((QueryBuilder, QueryBuilder) -> QueryBuilder)
-> [(QueryBuilder, QueryBuilder)] -> [QueryBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (QueryBuilder, QueryBuilder) -> QueryBuilder
pairQuery [(QueryBuilder, QueryBuilder)]
setting
, QueryBody -> QueryBuilder
forall a. ToQueryBuilder a => a -> QueryBuilder
toQueryBuilder QueryBody
body
]
toQueryBuilder (InsertValues QueryBuilder
_ Insertor a
_ Maybe [(QueryBuilder, QueryBuilder)]
_ []) = QueryBuilder
"SELECT 'nothing to insert'"
toQueryBuilder (InsertValues QueryBuilder
table (Insertor [Text]
cols a -> [QueryBuilder]
convert) Maybe [(QueryBuilder, QueryBuilder)]
updates [a]
values__) =
let valuesB :: QueryBuilder
valuesB = [QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep ([QueryBuilder] -> QueryBuilder) -> [QueryBuilder] -> QueryBuilder
forall a b. (a -> b) -> a -> b
$
(a -> QueryBuilder) -> [a] -> [QueryBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (QueryBuilder -> QueryBuilder
forall a. (IsString a, Monoid a) => a -> a
parentized (QueryBuilder -> QueryBuilder)
-> (a -> QueryBuilder) -> a -> QueryBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep ([QueryBuilder] -> QueryBuilder)
-> (a -> [QueryBuilder]) -> a -> QueryBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [QueryBuilder]
convert)
[a]
values__
insertStmt :: [QueryBuilder]
insertStmt = [ QueryBuilder
"INSERT INTO", QueryBuilder
table
, QueryBuilder -> QueryBuilder
forall a. (IsString a, Monoid a) => a -> a
parentized (QueryBuilder -> QueryBuilder) -> QueryBuilder -> QueryBuilder
forall a b. (a -> b) -> a -> b
$ [QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep ([QueryBuilder] -> QueryBuilder) -> [QueryBuilder] -> QueryBuilder
forall a b. (a -> b) -> a -> b
$
(Text -> QueryBuilder) -> [Text] -> [QueryBuilder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> QueryBuilder
rawSql [Text]
cols
, QueryBuilder
"VALUES", QueryBuilder
valuesB]
in [QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
unwords ([QueryBuilder] -> QueryBuilder) -> [QueryBuilder] -> QueryBuilder
forall a b. (a -> b) -> a -> b
$ [QueryBuilder]
insertStmt [QueryBuilder] -> [QueryBuilder] -> [QueryBuilder]
forall a. [a] -> [a] -> [a]
++
([(QueryBuilder, QueryBuilder)] -> [QueryBuilder])
-> Maybe [(QueryBuilder, QueryBuilder)] -> [QueryBuilder]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\[(QueryBuilder, QueryBuilder)]
setting ->
[ QueryBuilder
"ON DUPLICATE KEY UPDATE"
, [QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep (((QueryBuilder, QueryBuilder) -> QueryBuilder)
-> [(QueryBuilder, QueryBuilder)] -> [QueryBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (QueryBuilder, QueryBuilder) -> QueryBuilder
pairQuery [(QueryBuilder, QueryBuilder)]
setting)])
Maybe [(QueryBuilder, QueryBuilder)]
updates
toQueryBuilder (InsertSelect QueryBuilder
table [QueryBuilder]
cols [QueryBuilder]
rows QueryBody
queryBody) =
[QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
unwords
[ QueryBuilder
"INSERT INTO", QueryBuilder
table
, QueryBuilder -> QueryBuilder
forall a. (IsString a, Monoid a) => a -> a
parentized (QueryBuilder -> QueryBuilder) -> QueryBuilder -> QueryBuilder
forall a b. (a -> b) -> a -> b
$ [QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep [QueryBuilder]
cols
, QueryBuilder
"SELECT", QueryBuilder -> QueryBuilder
forall a. (IsString a, Monoid a) => a -> a
parentized (QueryBuilder -> QueryBuilder) -> QueryBuilder -> QueryBuilder
forall a b. (a -> b) -> a -> b
$ [QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep [QueryBuilder]
rows
, QueryBody -> QueryBuilder
forall a. ToQueryBuilder a => a -> QueryBuilder
toQueryBuilder QueryBody
queryBody
]
toQueryBuilder (Delete Query a
query__) =
QueryBuilder
"DELETE " QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> Query a -> QueryBuilder
forall a. ToQueryBuilder a => a -> QueryBuilder
toQueryBuilder Query a
query__
instance ToQueryBuilder QueryBody where
toQueryBuilder :: QueryBody -> QueryBuilder
toQueryBuilder QueryBody
body =
[QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
unwords ([QueryBuilder] -> QueryBuilder) -> [QueryBuilder] -> QueryBuilder
forall a b. (a -> b) -> a -> b
$
Maybe QueryBuilder -> [QueryBuilder]
forall a. IsString a => Maybe a -> [a]
fromB (QueryBody -> Maybe QueryBuilder
_from QueryBody
body) [QueryBuilder] -> [QueryBuilder] -> [QueryBuilder]
forall a. Semigroup a => a -> a -> a
<>
(Join -> QueryBuilder
joinB (Join -> QueryBuilder) -> [Join] -> [QueryBuilder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryBody -> [Join]
_joins QueryBody
body) [QueryBuilder] -> [QueryBuilder] -> [QueryBuilder]
forall a. Semigroup a => a -> a -> a
<>
QueryBuilder -> [QueryBuilder] -> [QueryBuilder]
renderPredicates QueryBuilder
"WHERE" (QueryBody -> [QueryBuilder]
_where_ QueryBody
body) [QueryBuilder] -> [QueryBuilder] -> [QueryBuilder]
forall a. Semigroup a => a -> a -> a
<>
([QueryBuilder] -> [QueryBuilder]
forall a. (IsString a, Monoid a) => [a] -> [a]
groupByB ([QueryBuilder] -> [QueryBuilder])
-> [QueryBuilder] -> [QueryBuilder]
forall a b. (a -> b) -> a -> b
$ QueryBody -> [QueryBuilder]
_groupBy QueryBody
body) [QueryBuilder] -> [QueryBuilder] -> [QueryBuilder]
forall a. Semigroup a => a -> a -> a
<>
QueryBuilder -> [QueryBuilder] -> [QueryBuilder]
renderPredicates QueryBuilder
"HAVING" (QueryBody -> [QueryBuilder]
_having QueryBody
body) [QueryBuilder] -> [QueryBuilder] -> [QueryBuilder]
forall a. Semigroup a => a -> a -> a
<>
[QueryOrdering] -> [QueryBuilder]
forall a. ToQueryBuilder a => [a] -> [QueryBuilder]
orderByB (QueryBody -> [QueryOrdering]
_orderBy QueryBody
body) [QueryBuilder] -> [QueryBuilder] -> [QueryBuilder]
forall a. Semigroup a => a -> a -> a
<>
Maybe (Int, Maybe Int) -> [QueryBuilder]
forall a a a.
(IsString a, Show a, Show a) =>
Maybe (a, Maybe a) -> [a]
limitB (QueryBody -> Maybe (Int, Maybe Int)
_limit QueryBody
body)
where
fromB :: Maybe a -> [a]
fromB Maybe a
Nothing = []
fromB (Just a
table) = [a
"FROM", a
table]
joinB :: Join -> QueryBuilder
joinB (Join JoinType
_ [] [QueryBuilder]
_) = String -> QueryBuilder
forall a. HasCallStack => String -> a
error String
"list of join tables cannot be empty"
joinB (Join JoinType
joinType [QueryBuilder]
tables [QueryBuilder]
joinConditions) =
[QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
unwords ([QueryBuilder] -> QueryBuilder) -> [QueryBuilder] -> QueryBuilder
forall a b. (a -> b) -> a -> b
$ [JoinType -> QueryBuilder
forall a. ToQueryBuilder a => a -> QueryBuilder
toQueryBuilder JoinType
joinType, [QueryBuilder] -> QueryBuilder
renderList [QueryBuilder]
tables] [QueryBuilder] -> [QueryBuilder] -> [QueryBuilder]
forall a. [a] -> [a] -> [a]
++
QueryBuilder -> [QueryBuilder] -> [QueryBuilder]
renderPredicates QueryBuilder
"ON" [QueryBuilder]
joinConditions
groupByB :: [a] -> [a]
groupByB [] = []
groupByB [a]
e = [a
"GROUP BY", [a] -> a
forall a. (IsString a, Monoid a) => [a] -> a
commaSep [a]
e]
orderByB :: [a] -> [QueryBuilder]
orderByB [] = []
orderByB [a]
e = [QueryBuilder
"ORDER BY", [QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep ([QueryBuilder] -> QueryBuilder) -> [QueryBuilder] -> QueryBuilder
forall a b. (a -> b) -> a -> b
$ (a -> QueryBuilder) -> [a] -> [QueryBuilder]
forall a b. (a -> b) -> [a] -> [b]
map a -> QueryBuilder
forall a. ToQueryBuilder a => a -> QueryBuilder
toQueryBuilder [a]
e]
limitB :: Maybe (a, Maybe a) -> [a]
limitB Maybe (a, Maybe a)
Nothing = []
limitB (Just (a
count, Maybe a
Nothing)) = [a
"LIMIT", String -> a
forall a. IsString a => String -> a
fromString (a -> String
forall a. Show a => a -> String
show a
count)]
limitB (Just (a
count, Just a
offset)) =
[ a
"LIMIT" , String -> a
forall a. IsString a => String -> a
fromString (a -> String
forall a. Show a => a -> String
show a
count)
, a
"OFFSET", String -> a
forall a. IsString a => String -> a
fromString (a -> String
forall a. Show a => a -> String
show a
offset) ]
instance ToQueryBuilder (Query a) where
toQueryBuilder :: Query a -> QueryBuilder
toQueryBuilder (Query (Selector DList QueryBuilder
dl StateT [MySQLValue] (Either SQLError) a
_) QueryBody
body) =
QueryBuilder
"SELECT " QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> [QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep (DList QueryBuilder -> [QueryBuilder]
forall a. DList a -> [a]
DList.toList DList QueryBuilder
dl) QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder
" " QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBody -> QueryBuilder
forall a. ToQueryBuilder a => a -> QueryBuilder
toQueryBuilder QueryBody
body
rawSql :: Text -> QueryBuilder
rawSql :: Text -> QueryBuilder
rawSql Text
t = Builder -> Builder -> DList MySQLValue -> QueryBuilder
QueryBuilder Builder
builder Builder
builder DList MySQLValue
forall a. DList a
DList.empty where
builder :: Builder
builder = ByteString -> Builder
Builder.byteString (Text -> ByteString
Text.encodeUtf8 Text
t)
instance ToQueryBuilder JoinType where
toQueryBuilder :: JoinType -> QueryBuilder
toQueryBuilder JoinType
InnerJoin = QueryBuilder
"INNER JOIN"
toQueryBuilder JoinType
LeftJoin = QueryBuilder
"LEFT JOIN"
toQueryBuilder JoinType
RightJoin = QueryBuilder
"RIGHT JOIN"
toQueryBuilder JoinType
OuterJoin = QueryBuilder
"OUTER JOIN"
data QueryBody = QueryBody
{ QueryBody -> Maybe QueryBuilder
_from :: Maybe QueryBuilder
, QueryBody -> [Join]
_joins :: [Join]
, QueryBody -> [QueryBuilder]
_where_ :: [QueryBuilder]
, QueryBody -> [QueryBuilder]
_groupBy :: [QueryBuilder]
, QueryBody -> [QueryBuilder]
_having :: [QueryBuilder]
, QueryBody -> [QueryOrdering]
_orderBy :: [QueryOrdering]
, QueryBody -> Maybe (Int, Maybe Int)
_limit :: Maybe (Int, Maybe Int)
}
data QueryOrdering =
Asc QueryBuilder | Desc QueryBuilder
instance ToQueryBuilder QueryOrdering where
toQueryBuilder :: QueryOrdering -> QueryBuilder
toQueryBuilder (Asc QueryBuilder
b) = QueryBuilder
b QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder
" ASC"
toQueryBuilder (Desc QueryBuilder
b) = QueryBuilder
b QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder
" DESC"
data QueryBuilder = QueryBuilder Builder Builder (DList MySQLValue)
instance IsString QueryBuilder where
fromString :: String -> QueryBuilder
fromString String
s = Builder -> Builder -> DList MySQLValue -> QueryBuilder
QueryBuilder Builder
b Builder
b DList MySQLValue
forall a. DList a
DList.empty
where b :: Builder
b = String -> Builder
Builder.string8 String
s
instance Semigroup QueryBuilder where
QueryBuilder Builder
stmt1 Builder
prepStmt1 DList MySQLValue
vals1 <> :: QueryBuilder -> QueryBuilder -> QueryBuilder
<> QueryBuilder Builder
stmt2 Builder
prepStmt2 DList MySQLValue
vals2 =
Builder -> Builder -> DList MySQLValue -> QueryBuilder
QueryBuilder (Builder
stmt1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
stmt2) (Builder
prepStmt1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
prepStmt2) (DList MySQLValue
vals1 DList MySQLValue -> DList MySQLValue -> DList MySQLValue
forall a. Semigroup a => a -> a -> a
<> DList MySQLValue
vals2)
instance Monoid QueryBuilder where
mempty :: QueryBuilder
mempty = Builder -> Builder -> DList MySQLValue -> QueryBuilder
QueryBuilder Builder
forall a. Monoid a => a
mempty Builder
forall a. Monoid a => a
mempty DList MySQLValue
forall a. Monoid a => a
mempty
newtype QueryClauses = QueryClauses (Endo QueryBody)
deriving (b -> QueryClauses -> QueryClauses
NonEmpty QueryClauses -> QueryClauses
QueryClauses -> QueryClauses -> QueryClauses
(QueryClauses -> QueryClauses -> QueryClauses)
-> (NonEmpty QueryClauses -> QueryClauses)
-> (forall b. Integral b => b -> QueryClauses -> QueryClauses)
-> Semigroup QueryClauses
forall b. Integral b => b -> QueryClauses -> QueryClauses
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> QueryClauses -> QueryClauses
$cstimes :: forall b. Integral b => b -> QueryClauses -> QueryClauses
sconcat :: NonEmpty QueryClauses -> QueryClauses
$csconcat :: NonEmpty QueryClauses -> QueryClauses
<> :: QueryClauses -> QueryClauses -> QueryClauses
$c<> :: QueryClauses -> QueryClauses -> QueryClauses
Semigroup, Semigroup QueryClauses
QueryClauses
Semigroup QueryClauses
-> QueryClauses
-> (QueryClauses -> QueryClauses -> QueryClauses)
-> ([QueryClauses] -> QueryClauses)
-> Monoid QueryClauses
[QueryClauses] -> QueryClauses
QueryClauses -> QueryClauses -> QueryClauses
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [QueryClauses] -> QueryClauses
$cmconcat :: [QueryClauses] -> QueryClauses
mappend :: QueryClauses -> QueryClauses -> QueryClauses
$cmappend :: QueryClauses -> QueryClauses -> QueryClauses
mempty :: QueryClauses
$cmempty :: QueryClauses
$cp1Monoid :: Semigroup QueryClauses
Monoid)
instance Semigroup (Insertor a) where
Insertor [Text]
fields1 a -> [QueryBuilder]
conv1 <> :: Insertor a -> Insertor a -> Insertor a
<> Insertor [Text]
fields2 a -> [QueryBuilder]
conv2 =
[Text] -> (a -> [QueryBuilder]) -> Insertor a
forall a. [Text] -> (a -> [QueryBuilder]) -> Insertor a
Insertor ([Text]
fields1 [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
fields2) (a -> [QueryBuilder]
conv1 (a -> [QueryBuilder])
-> (a -> [QueryBuilder]) -> a -> [QueryBuilder]
forall a. Semigroup a => a -> a -> a
<> a -> [QueryBuilder]
conv2)
instance Monoid (Insertor a) where
mempty :: Insertor a
mempty = [Text] -> (a -> [QueryBuilder]) -> Insertor a
forall a. [Text] -> (a -> [QueryBuilder]) -> Insertor a
Insertor [Text]
forall a. Monoid a => a
mempty a -> [QueryBuilder]
forall a. Monoid a => a
mempty
instance Contravariant Insertor where
contramap :: (a -> b) -> Insertor b -> Insertor a
contramap a -> b
f (Insertor [Text]
x b -> [QueryBuilder]
g) = [Text] -> (a -> [QueryBuilder]) -> Insertor a
forall a. [Text] -> (a -> [QueryBuilder]) -> Insertor a
Insertor [Text]
x (b -> [QueryBuilder]
g (b -> [QueryBuilder]) -> (a -> b) -> a -> [QueryBuilder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
class HasQueryClauses a where
mergeClauses :: a -> QueryClauses -> a
instance HasQueryClauses (Query a) where
mergeClauses :: Query a -> QueryClauses -> Query a
mergeClauses (Query Selector a
selector QueryBody
body) (QueryClauses Endo QueryBody
clauses) =
Selector a -> QueryBody -> Query a
forall a. Selector a -> QueryBody -> Query a
Query Selector a
selector (Endo QueryBody
clauses Endo QueryBody -> QueryBody -> QueryBody
forall a. Endo a -> a -> a
`appEndo` QueryBody
body)
instance HasQueryClauses Command where
mergeClauses :: Command -> QueryClauses -> Command
mergeClauses (Update [QueryBuilder]
table [(QueryBuilder, QueryBuilder)]
setting QueryBody
body) (QueryClauses Endo QueryBody
clauses) =
[QueryBuilder]
-> [(QueryBuilder, QueryBuilder)] -> QueryBody -> Command
Update [QueryBuilder]
table [(QueryBuilder, QueryBuilder)]
setting (Endo QueryBody
clauses Endo QueryBody -> QueryBody -> QueryBody
forall a. Endo a -> a -> a
`appEndo` QueryBody
body)
mergeClauses (InsertSelect QueryBuilder
table [QueryBuilder]
toColumns [QueryBuilder]
fromColumns QueryBody
queryBody)
(QueryClauses Endo QueryBody
clauses) =
QueryBuilder
-> [QueryBuilder] -> [QueryBuilder] -> QueryBody -> Command
InsertSelect QueryBuilder
table [QueryBuilder]
toColumns [QueryBuilder]
fromColumns (Endo QueryBody -> QueryBody -> QueryBody
forall a. Endo a -> a -> a
appEndo Endo QueryBody
clauses QueryBody
queryBody)
mergeClauses command__ :: Command
command__@InsertValues{} QueryClauses
_ =
Command
command__
mergeClauses (Delete Query a
query__) QueryClauses
clauses =
Query a -> Command
forall a. Query a -> Command
Delete (Query a -> Command) -> Query a -> Command
forall a b. (a -> b) -> a -> b
$ Query a -> QueryClauses -> Query a
forall a. HasQueryClauses a => a -> QueryClauses -> a
mergeClauses Query a
query__ QueryClauses
clauses
fromText :: Text -> QueryBuilder
fromText :: Text -> QueryBuilder
fromText Text
s = Builder -> Builder -> DList MySQLValue -> QueryBuilder
QueryBuilder Builder
b Builder
b DList MySQLValue
forall a. DList a
DList.empty
where b :: Builder
b = ByteString -> Builder
Builder.byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
s
sepBy :: Monoid a => a -> [a] -> a
sepBy :: a -> [a] -> a
sepBy a
sep [a]
builder = [a] -> a
forall a. Monoid a => [a] -> a
mconcat ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ a -> [a] -> [a]
forall a. a -> [a] -> [a]
intersperse a
sep [a]
builder
{-# INLINE sepBy #-}
commaSep :: (IsString a, Monoid a) => [a] -> a
commaSep :: [a] -> a
commaSep = a -> [a] -> a
forall a. Monoid a => a -> [a] -> a
sepBy a
", "
{-# INLINE commaSep #-}
unwords :: (IsString a, Monoid a) => [a] -> a
unwords :: [a] -> a
unwords = a -> [a] -> a
forall a. Monoid a => a -> [a] -> a
sepBy a
" "
{-# INLINE unwords #-}
parentized :: (IsString a, Monoid a) => a -> a
parentized :: a -> a
parentized a
expr = a
"(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
expr a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"
{-# INLINE parentized #-}
renderList :: [QueryBuilder] -> QueryBuilder
renderList :: [QueryBuilder] -> QueryBuilder
renderList [] = QueryBuilder
""
renderList [QueryBuilder
e] = QueryBuilder
e
renderList [QueryBuilder]
es = QueryBuilder -> QueryBuilder
forall a. (IsString a, Monoid a) => a -> a
parentized (QueryBuilder -> QueryBuilder) -> QueryBuilder -> QueryBuilder
forall a b. (a -> b) -> a -> b
$ [QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep [QueryBuilder]
es
renderPredicates :: QueryBuilder -> [QueryBuilder] -> [QueryBuilder]
renderPredicates :: QueryBuilder -> [QueryBuilder] -> [QueryBuilder]
renderPredicates QueryBuilder
_ [] = []
renderPredicates QueryBuilder
keyword [QueryBuilder
e] = [QueryBuilder
keyword, QueryBuilder
e]
renderPredicates QueryBuilder
keyword [QueryBuilder]
es =
QueryBuilder
keyword QueryBuilder -> [QueryBuilder] -> [QueryBuilder]
forall a. a -> [a] -> [a]
: QueryBuilder -> [QueryBuilder] -> [QueryBuilder]
forall a. a -> [a] -> [a]
intersperse QueryBuilder
"AND" ((QueryBuilder -> QueryBuilder) -> [QueryBuilder] -> [QueryBuilder]
forall a b. (a -> b) -> [a] -> [b]
map QueryBuilder -> QueryBuilder
forall a. (IsString a, Monoid a) => a -> a
parentized ([QueryBuilder] -> [QueryBuilder])
-> [QueryBuilder] -> [QueryBuilder]
forall a b. (a -> b) -> a -> b
$ [QueryBuilder] -> [QueryBuilder]
forall a. [a] -> [a]
reverse [QueryBuilder]
es)
mysqlValueBuilder :: MySQLValue -> Builder
mysqlValueBuilder :: MySQLValue -> Builder
mysqlValueBuilder = ByteString -> Builder
Builder.lazyByteString (ByteString -> Builder)
-> (MySQLValue -> ByteString) -> MySQLValue -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString)
-> (MySQLValue -> Put) -> MySQLValue -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MySQLValue -> Put
putTextField
arg :: ToSql a => a -> QueryBuilder
arg :: a -> QueryBuilder
arg a
a = Builder -> Builder -> DList MySQLValue -> QueryBuilder
QueryBuilder
(MySQLValue -> Builder
mysqlValueBuilder (MySQLValue -> Builder) -> MySQLValue -> Builder
forall a b. (a -> b) -> a -> b
$ a -> MySQLValue
forall a. ToSql a => a -> MySQLValue
toSqlValue a
a)
(ByteString -> Builder
Builder.lazyByteString ByteString
"?")
(MySQLValue -> DList MySQLValue
forall a. a -> DList a
DList.singleton (MySQLValue -> DList MySQLValue) -> MySQLValue -> DList MySQLValue
forall a b. (a -> b) -> a -> b
$ a -> MySQLValue
forall a. ToSql a => a -> MySQLValue
toSqlValue a
a)
fun :: Text -> [QueryBuilder] -> QueryBuilder
fun :: Text -> [QueryBuilder] -> QueryBuilder
fun Text
name [QueryBuilder]
exprs = Text -> QueryBuilder
fromText Text
name QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder -> QueryBuilder
forall a. (IsString a, Monoid a) => a -> a
parentized ([QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep [QueryBuilder]
exprs)
op :: Text -> QueryBuilder -> QueryBuilder -> QueryBuilder
op :: Text -> QueryBuilder -> QueryBuilder -> QueryBuilder
op Text
name QueryBuilder
e1 QueryBuilder
e2 = QueryBuilder -> QueryBuilder
forall a. (IsString a, Monoid a) => a -> a
parentized (QueryBuilder -> QueryBuilder) -> QueryBuilder -> QueryBuilder
forall a b. (a -> b) -> a -> b
$ QueryBuilder
e1 QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder
" " QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> Text -> QueryBuilder
fromText Text
name QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder
" " QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder
e2
substr :: QueryBuilder -> QueryBuilder -> QueryBuilder -> QueryBuilder
substr :: QueryBuilder -> QueryBuilder -> QueryBuilder -> QueryBuilder
substr QueryBuilder
field QueryBuilder
start QueryBuilder
end = Text -> [QueryBuilder] -> QueryBuilder
fun Text
"substr" [QueryBuilder
field, QueryBuilder
start, QueryBuilder
end]
infixr 3 &&., ||.
infix 4 <., >., >=., <=., =., /=.
infixr 5 ++.
infixl 6 +., -.
infixl 7 *., /.
(>.), (<.), (>=.), (<=.), (+.), (-.), (/.), (*.), (=.), (/=.), (++.), (&&.),
(||.)
:: QueryBuilder -> QueryBuilder -> QueryBuilder
>. :: QueryBuilder -> QueryBuilder -> QueryBuilder
(>.) = Text -> QueryBuilder -> QueryBuilder -> QueryBuilder
op Text
">"
<. :: QueryBuilder -> QueryBuilder -> QueryBuilder
(<.) = Text -> QueryBuilder -> QueryBuilder -> QueryBuilder
op Text
"<"
>=. :: QueryBuilder -> QueryBuilder -> QueryBuilder
(>=.) = Text -> QueryBuilder -> QueryBuilder -> QueryBuilder
op Text
">="
<=. :: QueryBuilder -> QueryBuilder -> QueryBuilder
(<=.) = Text -> QueryBuilder -> QueryBuilder -> QueryBuilder
op Text
"<="
+. :: QueryBuilder -> QueryBuilder -> QueryBuilder
(+.) = Text -> QueryBuilder -> QueryBuilder -> QueryBuilder
op Text
"+"
*. :: QueryBuilder -> QueryBuilder -> QueryBuilder
(*.) = Text -> QueryBuilder -> QueryBuilder -> QueryBuilder
op Text
"*"
/. :: QueryBuilder -> QueryBuilder -> QueryBuilder
(/.) = Text -> QueryBuilder -> QueryBuilder -> QueryBuilder
op Text
"/"
-. :: QueryBuilder -> QueryBuilder -> QueryBuilder
(-.) = Text -> QueryBuilder -> QueryBuilder -> QueryBuilder
op Text
"-"
=. :: QueryBuilder -> QueryBuilder -> QueryBuilder
(=.) = Text -> QueryBuilder -> QueryBuilder -> QueryBuilder
op Text
"="
/=. :: QueryBuilder -> QueryBuilder -> QueryBuilder
(/=.) = Text -> QueryBuilder -> QueryBuilder -> QueryBuilder
op Text
"<>"
QueryBuilder
a ++. :: QueryBuilder -> QueryBuilder -> QueryBuilder
++. QueryBuilder
b = Text -> [QueryBuilder] -> QueryBuilder
fun Text
"concat" [QueryBuilder
a, QueryBuilder
b]
&&. :: QueryBuilder -> QueryBuilder -> QueryBuilder
(&&.) = Text -> QueryBuilder -> QueryBuilder -> QueryBuilder
op Text
"and"
||. :: QueryBuilder -> QueryBuilder -> QueryBuilder
(||.) = Text -> QueryBuilder -> QueryBuilder -> QueryBuilder
op Text
"or"
abs_, signum_, negate_, sum_ :: QueryBuilder -> QueryBuilder
abs_ :: QueryBuilder -> QueryBuilder
abs_ QueryBuilder
x = Text -> [QueryBuilder] -> QueryBuilder
fun Text
"abs" [QueryBuilder
x]
signum_ :: QueryBuilder -> QueryBuilder
signum_ QueryBuilder
x = Text -> [QueryBuilder] -> QueryBuilder
fun Text
"sign" [QueryBuilder
x]
negate_ :: QueryBuilder -> QueryBuilder
negate_ QueryBuilder
x = Text -> [QueryBuilder] -> QueryBuilder
fun Text
"-" [QueryBuilder
x]
sum_ :: QueryBuilder -> QueryBuilder
sum_ QueryBuilder
x = Text -> [QueryBuilder] -> QueryBuilder
fun Text
"sum" [QueryBuilder
x]
false_, true_ :: QueryBuilder
false_ :: QueryBuilder
false_ = Text -> QueryBuilder
rawSql Text
"false"
true_ :: QueryBuilder
true_ = Text -> QueryBuilder
rawSql Text
"true"
values :: QueryBuilder -> QueryBuilder
values :: QueryBuilder -> QueryBuilder
values QueryBuilder
x = Text -> [QueryBuilder] -> QueryBuilder
fun Text
"values" [QueryBuilder
x]
isNull :: QueryBuilder -> QueryBuilder
isNull :: QueryBuilder -> QueryBuilder
isNull QueryBuilder
e = QueryBuilder -> QueryBuilder
forall a. (IsString a, Monoid a) => a -> a
parentized (QueryBuilder -> QueryBuilder) -> QueryBuilder -> QueryBuilder
forall a b. (a -> b) -> a -> b
$ QueryBuilder
e QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder
" IS NULL"
isNotNull :: QueryBuilder -> QueryBuilder
isNotNull :: QueryBuilder -> QueryBuilder
isNotNull QueryBuilder
e = QueryBuilder -> QueryBuilder
forall a. (IsString a, Monoid a) => a -> a
parentized (QueryBuilder -> QueryBuilder) -> QueryBuilder -> QueryBuilder
forall a b. (a -> b) -> a -> b
$ QueryBuilder
e QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder
" IS NOT NULL"
exprInto :: (a -> QueryBuilder) -> Text -> Insertor a
exprInto :: (a -> QueryBuilder) -> Text -> Insertor a
exprInto a -> QueryBuilder
f Text
s = [Text] -> (a -> [QueryBuilder]) -> Insertor a
forall a. [Text] -> (a -> [QueryBuilder]) -> Insertor a
Insertor [Text
s] (\a
t -> [a -> QueryBuilder
f a
t])
insertOne :: ToSql a => Text -> Insertor a
insertOne :: Text -> Insertor a
insertOne Text
s = a -> QueryBuilder
forall a. ToSql a => a -> QueryBuilder
arg (a -> QueryBuilder) -> Text -> Insertor a
forall a. (a -> QueryBuilder) -> Text -> Insertor a
`exprInto` Text
s
class InsertGeneric (fields :: *) (data_ :: *) where
insertDataGeneric :: fields -> Insertor data_
genFst :: (a :*: b) () -> a ()
genFst :: (:*:) a b () -> a ()
genFst (a ()
a :*: b ()
_) = a ()
a
genSnd :: (a :*: b) () -> b ()
genSnd :: (:*:) a b () -> b ()
genSnd (a ()
_ :*: b ()
b) = b ()
b
instance (InsertGeneric (a ()) (c ()),
InsertGeneric (b ()) (d ())) =>
InsertGeneric ((a :*: b) ()) ((c :*: d) ()) where
insertDataGeneric :: (:*:) a b () -> Insertor ((:*:) c d ())
insertDataGeneric (a ()
a :*: b ()
b) =
((:*:) c d () -> c ())
-> Insertor (c ()) -> Insertor ((:*:) c d ())
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (:*:) c d () -> c ()
forall (a :: * -> *) (b :: * -> *). (:*:) a b () -> a ()
genFst (a () -> Insertor (c ())
forall fields data_.
InsertGeneric fields data_ =>
fields -> Insertor data_
insertDataGeneric a ()
a) Insertor ((:*:) c d ())
-> Insertor ((:*:) c d ()) -> Insertor ((:*:) c d ())
forall a. Semigroup a => a -> a -> a
<>
((:*:) c d () -> d ())
-> Insertor (d ()) -> Insertor ((:*:) c d ())
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (:*:) c d () -> d ()
forall (a :: * -> *) (b :: * -> *). (:*:) a b () -> b ()
genSnd (b () -> Insertor (d ())
forall fields data_.
InsertGeneric fields data_ =>
fields -> Insertor data_
insertDataGeneric b ()
b)
instance InsertGeneric (a ()) (b ()) =>
InsertGeneric (M1 m1 m2 a ()) (M1 m3 m4 b ()) where
insertDataGeneric :: M1 m1 m2 a () -> Insertor (M1 m3 m4 b ())
insertDataGeneric = (M1 m3 m4 b () -> b ())
-> Insertor (b ()) -> Insertor (M1 m3 m4 b ())
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap M1 m3 m4 b () -> b ()
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (Insertor (b ()) -> Insertor (M1 m3 m4 b ()))
-> (M1 m1 m2 a () -> Insertor (b ()))
-> M1 m1 m2 a ()
-> Insertor (M1 m3 m4 b ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a () -> Insertor (b ())
forall fields data_.
InsertGeneric fields data_ =>
fields -> Insertor data_
insertDataGeneric (a () -> Insertor (b ()))
-> (M1 m1 m2 a () -> a ()) -> M1 m1 m2 a () -> Insertor (b ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 m1 m2 a () -> a ()
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
instance ToSql b => InsertGeneric (K1 r Text ()) (K1 r b ()) where
insertDataGeneric :: K1 r Text () -> Insertor (K1 r b ())
insertDataGeneric = (K1 r b () -> b) -> Insertor b -> Insertor (K1 r b ())
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap K1 r b () -> b
forall i c k (p :: k). K1 i c p -> c
unK1 (Insertor b -> Insertor (K1 r b ()))
-> (K1 r Text () -> Insertor b)
-> K1 r Text ()
-> Insertor (K1 r b ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Insertor b
forall a. ToSql a => Text -> Insertor a
insertOne (Text -> Insertor b)
-> (K1 r Text () -> Text) -> K1 r Text () -> Insertor b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 r Text () -> Text
forall i c k (p :: k). K1 i c p -> c
unK1
instance InsertGeneric (K1 r (Insertor a) ()) (K1 r a ()) where
insertDataGeneric :: K1 r (Insertor a) () -> Insertor (K1 r a ())
insertDataGeneric = (K1 r a () -> a) -> Insertor a -> Insertor (K1 r a ())
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap K1 r a () -> a
forall i c k (p :: k). K1 i c p -> c
unK1 (Insertor a -> Insertor (K1 r a ()))
-> (K1 r (Insertor a) () -> Insertor a)
-> K1 r (Insertor a) ()
-> Insertor (K1 r a ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 r (Insertor a) () -> Insertor a
forall i c k (p :: k). K1 i c p -> c
unK1
insertData :: (Generic a, Generic b, InsertGeneric (Rep a ()) (Rep b ()))
=> a -> Insertor b
insertData :: a -> Insertor b
insertData = (b -> Rep b ()) -> Insertor (Rep b ()) -> Insertor b
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap b -> Rep b ()
forall a. Generic a => a -> Rep a ()
from' (Insertor (Rep b ()) -> Insertor b)
-> (a -> Insertor (Rep b ())) -> a -> Insertor b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep a () -> Insertor (Rep b ())
forall fields data_.
InsertGeneric fields data_ =>
fields -> Insertor data_
insertDataGeneric (Rep a () -> Insertor (Rep b ()))
-> (a -> Rep a ()) -> a -> Insertor (Rep b ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a ()
forall a. Generic a => a -> Rep a ()
from'
where from' :: Generic a => a -> Rep a ()
from' :: a -> Rep a ()
from' = a -> Rep a ()
forall a x. Generic a => a -> Rep a x
Generics.from
skipInsert :: Insertor a
skipInsert :: Insertor a
skipInsert = Insertor a
forall a. Monoid a => a
mempty
into :: ToSql b => (a -> b) -> Text -> Insertor a
into :: (a -> b) -> Text -> Insertor a
into a -> b
toVal = (a -> b) -> Insertor b -> Insertor a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
toVal (Insertor b -> Insertor a)
-> (Text -> Insertor b) -> Text -> Insertor a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Insertor b
forall a. ToSql a => Text -> Insertor a
insertOne
type Getter s a = (a -> Const a a) -> s -> Const a s
lensInto :: ToSql b => Getter a b -> Text -> Insertor a
lensInto :: Getter a b -> Text -> Insertor a
lensInto Getter a b
lens = (a -> b) -> Text -> Insertor a
forall b a. ToSql b => (a -> b) -> Text -> Insertor a
into (Const b a -> b
forall a k (b :: k). Const a b -> a
getConst (Const b a -> b) -> (a -> Const b a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter a b
lens b -> Const b b
forall k a (b :: k). a -> Const a b
Const)
subQuery :: ToQueryBuilder a => a -> QueryBuilder
subQuery :: a -> QueryBuilder
subQuery = QueryBuilder -> QueryBuilder
forall a. (IsString a, Monoid a) => a -> a
parentized (QueryBuilder -> QueryBuilder)
-> (a -> QueryBuilder) -> a -> QueryBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> QueryBuilder
forall a. ToQueryBuilder a => a -> QueryBuilder
toQueryBuilder
from :: QueryBuilder -> QueryClauses
from :: QueryBuilder -> QueryClauses
from QueryBuilder
table = Endo QueryBody -> QueryClauses
QueryClauses (Endo QueryBody -> QueryClauses) -> Endo QueryBody -> QueryClauses
forall a b. (a -> b) -> a -> b
$ (QueryBody -> QueryBody) -> Endo QueryBody
forall a. (a -> a) -> Endo a
Endo ((QueryBody -> QueryBody) -> Endo QueryBody)
-> (QueryBody -> QueryBody) -> Endo QueryBody
forall a b. (a -> b) -> a -> b
$ \QueryBody
qc -> QueryBody
qc {_from :: Maybe QueryBuilder
_from = QueryBuilder -> Maybe QueryBuilder
forall a. a -> Maybe a
Just QueryBuilder
table}
joinClause :: JoinType -> [QueryBuilder] -> [QueryBuilder] -> QueryClauses
joinClause :: JoinType -> [QueryBuilder] -> [QueryBuilder] -> QueryClauses
joinClause JoinType
tp [QueryBuilder]
tables [QueryBuilder]
conditions = Endo QueryBody -> QueryClauses
QueryClauses (Endo QueryBody -> QueryClauses) -> Endo QueryBody -> QueryClauses
forall a b. (a -> b) -> a -> b
$ (QueryBody -> QueryBody) -> Endo QueryBody
forall a. (a -> a) -> Endo a
Endo ((QueryBody -> QueryBody) -> Endo QueryBody)
-> (QueryBody -> QueryBody) -> Endo QueryBody
forall a b. (a -> b) -> a -> b
$ \QueryBody
qc ->
QueryBody
qc { _joins :: [Join]
_joins = JoinType -> [QueryBuilder] -> [QueryBuilder] -> Join
Join JoinType
tp [QueryBuilder]
tables [QueryBuilder]
conditions Join -> [Join] -> [Join]
forall a. a -> [a] -> [a]
: QueryBody -> [Join]
_joins QueryBody
qc }
innerJoin :: [QueryBuilder] -> [QueryBuilder] -> QueryClauses
innerJoin :: [QueryBuilder] -> [QueryBuilder] -> QueryClauses
innerJoin = JoinType -> [QueryBuilder] -> [QueryBuilder] -> QueryClauses
joinClause JoinType
InnerJoin
leftJoin :: [QueryBuilder] -> [QueryBuilder] -> QueryClauses
leftJoin :: [QueryBuilder] -> [QueryBuilder] -> QueryClauses
leftJoin = JoinType -> [QueryBuilder] -> [QueryBuilder] -> QueryClauses
joinClause JoinType
LeftJoin
rightJoin :: [QueryBuilder] -> [QueryBuilder] -> QueryClauses
rightJoin :: [QueryBuilder] -> [QueryBuilder] -> QueryClauses
rightJoin = JoinType -> [QueryBuilder] -> [QueryBuilder] -> QueryClauses
joinClause JoinType
RightJoin
outerJoin :: [QueryBuilder] -> [QueryBuilder] -> QueryClauses
outerJoin :: [QueryBuilder] -> [QueryBuilder] -> QueryClauses
outerJoin = JoinType -> [QueryBuilder] -> [QueryBuilder] -> QueryClauses
joinClause JoinType
OuterJoin
emptyJoins :: QueryClauses
emptyJoins :: QueryClauses
emptyJoins = Endo QueryBody -> QueryClauses
QueryClauses (Endo QueryBody -> QueryClauses) -> Endo QueryBody -> QueryClauses
forall a b. (a -> b) -> a -> b
$ (QueryBody -> QueryBody) -> Endo QueryBody
forall a. (a -> a) -> Endo a
Endo ((QueryBody -> QueryBody) -> Endo QueryBody)
-> (QueryBody -> QueryBody) -> Endo QueryBody
forall a b. (a -> b) -> a -> b
$ \QueryBody
qc ->
QueryBody
qc { _joins :: [Join]
_joins = [] }
where_ :: [QueryBuilder] -> QueryClauses
where_ :: [QueryBuilder] -> QueryClauses
where_ [QueryBuilder]
conditions = Endo QueryBody -> QueryClauses
QueryClauses (Endo QueryBody -> QueryClauses) -> Endo QueryBody -> QueryClauses
forall a b. (a -> b) -> a -> b
$ (QueryBody -> QueryBody) -> Endo QueryBody
forall a. (a -> a) -> Endo a
Endo ((QueryBody -> QueryBody) -> Endo QueryBody)
-> (QueryBody -> QueryBody) -> Endo QueryBody
forall a b. (a -> b) -> a -> b
$ \QueryBody
qc ->
QueryBody
qc { _where_ :: [QueryBuilder]
_where_ = [QueryBuilder] -> [QueryBuilder]
forall a. [a] -> [a]
reverse [QueryBuilder]
conditions [QueryBuilder] -> [QueryBuilder] -> [QueryBuilder]
forall a. [a] -> [a] -> [a]
++ QueryBody -> [QueryBuilder]
_where_ QueryBody
qc}
emptyWhere :: QueryClauses
emptyWhere :: QueryClauses
emptyWhere = Endo QueryBody -> QueryClauses
QueryClauses (Endo QueryBody -> QueryClauses) -> Endo QueryBody -> QueryClauses
forall a b. (a -> b) -> a -> b
$ (QueryBody -> QueryBody) -> Endo QueryBody
forall a. (a -> a) -> Endo a
Endo ((QueryBody -> QueryBody) -> Endo QueryBody)
-> (QueryBody -> QueryBody) -> Endo QueryBody
forall a b. (a -> b) -> a -> b
$ \QueryBody
qc ->
QueryBody
qc { _where_ :: [QueryBuilder]
_where_ = [] }
groupBy_ :: [QueryBuilder] -> QueryClauses
groupBy_ :: [QueryBuilder] -> QueryClauses
groupBy_ [QueryBuilder]
columns = Endo QueryBody -> QueryClauses
QueryClauses (Endo QueryBody -> QueryClauses) -> Endo QueryBody -> QueryClauses
forall a b. (a -> b) -> a -> b
$ (QueryBody -> QueryBody) -> Endo QueryBody
forall a. (a -> a) -> Endo a
Endo ((QueryBody -> QueryBody) -> Endo QueryBody)
-> (QueryBody -> QueryBody) -> Endo QueryBody
forall a b. (a -> b) -> a -> b
$ \QueryBody
qc ->
QueryBody
qc { _groupBy :: [QueryBuilder]
_groupBy = [QueryBuilder]
columns }
having :: [QueryBuilder] -> QueryClauses
having :: [QueryBuilder] -> QueryClauses
having [QueryBuilder]
conditions = Endo QueryBody -> QueryClauses
QueryClauses (Endo QueryBody -> QueryClauses) -> Endo QueryBody -> QueryClauses
forall a b. (a -> b) -> a -> b
$ (QueryBody -> QueryBody) -> Endo QueryBody
forall a. (a -> a) -> Endo a
Endo ((QueryBody -> QueryBody) -> Endo QueryBody)
-> (QueryBody -> QueryBody) -> Endo QueryBody
forall a b. (a -> b) -> a -> b
$ \QueryBody
qc ->
QueryBody
qc { _having :: [QueryBuilder]
_having = [QueryBuilder] -> [QueryBuilder]
forall a. [a] -> [a]
reverse [QueryBuilder]
conditions [QueryBuilder] -> [QueryBuilder] -> [QueryBuilder]
forall a. [a] -> [a] -> [a]
++ QueryBody -> [QueryBuilder]
_having QueryBody
qc }
emptyHaving :: QueryClauses
emptyHaving :: QueryClauses
emptyHaving = Endo QueryBody -> QueryClauses
QueryClauses (Endo QueryBody -> QueryClauses) -> Endo QueryBody -> QueryClauses
forall a b. (a -> b) -> a -> b
$ (QueryBody -> QueryBody) -> Endo QueryBody
forall a. (a -> a) -> Endo a
Endo ((QueryBody -> QueryBody) -> Endo QueryBody)
-> (QueryBody -> QueryBody) -> Endo QueryBody
forall a b. (a -> b) -> a -> b
$ \QueryBody
qc ->
QueryBody
qc { _having :: [QueryBuilder]
_having = [] }
orderBy :: [QueryOrdering] -> QueryClauses
orderBy :: [QueryOrdering] -> QueryClauses
orderBy [QueryOrdering]
ordering = Endo QueryBody -> QueryClauses
QueryClauses (Endo QueryBody -> QueryClauses) -> Endo QueryBody -> QueryClauses
forall a b. (a -> b) -> a -> b
$ (QueryBody -> QueryBody) -> Endo QueryBody
forall a. (a -> a) -> Endo a
Endo ((QueryBody -> QueryBody) -> Endo QueryBody)
-> (QueryBody -> QueryBody) -> Endo QueryBody
forall a b. (a -> b) -> a -> b
$ \QueryBody
qc ->
QueryBody
qc { _orderBy :: [QueryOrdering]
_orderBy = [QueryOrdering]
ordering }
limit :: Int -> QueryClauses
limit :: Int -> QueryClauses
limit Int
count = Endo QueryBody -> QueryClauses
QueryClauses (Endo QueryBody -> QueryClauses) -> Endo QueryBody -> QueryClauses
forall a b. (a -> b) -> a -> b
$ (QueryBody -> QueryBody) -> Endo QueryBody
forall a. (a -> a) -> Endo a
Endo ((QueryBody -> QueryBody) -> Endo QueryBody)
-> (QueryBody -> QueryBody) -> Endo QueryBody
forall a b. (a -> b) -> a -> b
$ \QueryBody
qc ->
QueryBody
qc { _limit :: Maybe (Int, Maybe Int)
_limit = (Int, Maybe Int) -> Maybe (Int, Maybe Int)
forall a. a -> Maybe a
Just (Int
count, Maybe Int
forall a. Maybe a
Nothing) }
limitOffset :: Int -> Int -> QueryClauses
limitOffset :: Int -> Int -> QueryClauses
limitOffset Int
count Int
offset = Endo QueryBody -> QueryClauses
QueryClauses (Endo QueryBody -> QueryClauses) -> Endo QueryBody -> QueryClauses
forall a b. (a -> b) -> a -> b
$ (QueryBody -> QueryBody) -> Endo QueryBody
forall a. (a -> a) -> Endo a
Endo ((QueryBody -> QueryBody) -> Endo QueryBody)
-> (QueryBody -> QueryBody) -> Endo QueryBody
forall a b. (a -> b) -> a -> b
$ \QueryBody
qc ->
QueryBody
qc { _limit :: Maybe (Int, Maybe Int)
_limit = (Int, Maybe Int) -> Maybe (Int, Maybe Int)
forall a. a -> Maybe a
Just (Int
count, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
offset) }
emptyQueryBody :: QueryBody
emptyQueryBody :: QueryBody
emptyQueryBody = Maybe QueryBuilder
-> [Join]
-> [QueryBuilder]
-> [QueryBuilder]
-> [QueryBuilder]
-> [QueryOrdering]
-> Maybe (Int, Maybe Int)
-> QueryBody
QueryBody Maybe QueryBuilder
forall a. Maybe a
Nothing [] [] [] [] [] Maybe (Int, Maybe Int)
forall a. Maybe a
Nothing
select :: Selector a -> QueryClauses -> Query a
select :: Selector a -> QueryClauses -> Query a
select Selector a
selector (QueryClauses Endo QueryBody
clauses) =
Selector a -> QueryBody -> Query a
forall a. Selector a -> QueryBody -> Query a
Query Selector a
selector (QueryBody -> Query a) -> QueryBody -> Query a
forall a b. (a -> b) -> a -> b
$ Endo QueryBody
clauses Endo QueryBody -> QueryBody -> QueryBody
forall a. Endo a -> a -> a
`appEndo` QueryBody
emptyQueryBody
mergeSelect :: Query b -> (a -> b -> c) -> Selector a -> Query c
mergeSelect :: Query b -> (a -> b -> c) -> Selector a -> Query c
mergeSelect (Query Selector b
selector2 QueryBody
body) a -> b -> c
f Selector a
selector1 =
Selector c -> QueryBody -> Query c
forall a. Selector a -> QueryBody -> Query a
Query ((a -> b -> c) -> Selector a -> Selector b -> Selector c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Selector a
selector1 Selector b
selector2) QueryBody
body
replaceSelect :: Selector a -> Query b -> Query a
replaceSelect :: Selector a -> Query b -> Query a
replaceSelect Selector a
s (Query Selector b
_ QueryBody
body) = Selector a -> QueryBody -> Query a
forall a. Selector a -> QueryBody -> Query a
Query Selector a
s QueryBody
body
insertValues :: QueryBuilder -> Insertor a -> [a] -> Command
insertValues :: QueryBuilder -> Insertor a -> [a] -> Command
insertValues QueryBuilder
qb Insertor a
i = QueryBuilder
-> Insertor a
-> Maybe [(QueryBuilder, QueryBuilder)]
-> [a]
-> Command
forall a.
QueryBuilder
-> Insertor a
-> Maybe [(QueryBuilder, QueryBuilder)]
-> [a]
-> Command
InsertValues QueryBuilder
qb Insertor a
i Maybe [(QueryBuilder, QueryBuilder)]
forall a. Maybe a
Nothing
insertUpdateValues :: QueryBuilder
-> Insertor a
-> [(QueryBuilder, QueryBuilder)]
-> [a]
-> Command
insertUpdateValues :: QueryBuilder
-> Insertor a -> [(QueryBuilder, QueryBuilder)] -> [a] -> Command
insertUpdateValues QueryBuilder
qb Insertor a
i [(QueryBuilder, QueryBuilder)]
u = QueryBuilder
-> Insertor a
-> Maybe [(QueryBuilder, QueryBuilder)]
-> [a]
-> Command
forall a.
QueryBuilder
-> Insertor a
-> Maybe [(QueryBuilder, QueryBuilder)]
-> [a]
-> Command
InsertValues QueryBuilder
qb Insertor a
i ([(QueryBuilder, QueryBuilder)]
-> Maybe [(QueryBuilder, QueryBuilder)]
forall a. a -> Maybe a
Just [(QueryBuilder, QueryBuilder)]
u)
insertSelect :: QueryBuilder -> [QueryBuilder] -> [QueryBuilder] -> QueryClauses
-> Command
insertSelect :: QueryBuilder
-> [QueryBuilder] -> [QueryBuilder] -> QueryClauses -> Command
insertSelect QueryBuilder
table [QueryBuilder]
toColumns [QueryBuilder]
fromColumns (QueryClauses Endo QueryBody
clauses) =
QueryBuilder
-> [QueryBuilder] -> [QueryBuilder] -> QueryBody -> Command
InsertSelect QueryBuilder
table [QueryBuilder]
toColumns [QueryBuilder]
fromColumns (QueryBody -> Command) -> QueryBody -> Command
forall a b. (a -> b) -> a -> b
$ Endo QueryBody -> QueryBody -> QueryBody
forall a. Endo a -> a -> a
appEndo Endo QueryBody
clauses QueryBody
emptyQueryBody
update :: [QueryBuilder] -> [(QueryBuilder, QueryBuilder)] -> QueryClauses
-> Command
update :: [QueryBuilder]
-> [(QueryBuilder, QueryBuilder)] -> QueryClauses -> Command
update [QueryBuilder]
tables [(QueryBuilder, QueryBuilder)]
assignments (QueryClauses Endo QueryBody
clauses) =
[QueryBuilder]
-> [(QueryBuilder, QueryBuilder)] -> QueryBody -> Command
Update [QueryBuilder]
tables [(QueryBuilder, QueryBuilder)]
assignments (QueryBody -> Command) -> QueryBody -> Command
forall a b. (a -> b) -> a -> b
$ Endo QueryBody -> QueryBody -> QueryBody
forall a. Endo a -> a -> a
appEndo Endo QueryBody
clauses QueryBody
emptyQueryBody
as :: QueryBuilder -> QueryBuilder -> QueryBuilder
as :: QueryBuilder -> QueryBuilder -> QueryBuilder
as QueryBuilder
e1 QueryBuilder
e2 = QueryBuilder
e1 QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder
" AS " QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder
e2
in_ :: QueryBuilder -> [QueryBuilder] -> QueryBuilder
in_ :: QueryBuilder -> [QueryBuilder] -> QueryBuilder
in_ QueryBuilder
_ [] = QueryBuilder
false_
in_ QueryBuilder
e [QueryBuilder]
l = QueryBuilder
e QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder
" IN " QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder -> QueryBuilder
forall a. (IsString a, Monoid a) => a -> a
parentized ([QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep [QueryBuilder]
l)
notIn_ :: QueryBuilder -> [QueryBuilder] -> QueryBuilder
notIn_ :: QueryBuilder -> [QueryBuilder] -> QueryBuilder
notIn_ QueryBuilder
_ [] = QueryBuilder
true_
notIn_ QueryBuilder
e [QueryBuilder]
l = QueryBuilder
e QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder
" NOT IN " QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
<> QueryBuilder -> QueryBuilder
forall a. (IsString a, Monoid a) => a -> a
parentized ([QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep [QueryBuilder]
l)
rawValues :: [QueryBuilder] -> Selector [MySQLValue]
rawValues :: [QueryBuilder] -> Selector [MySQLValue]
rawValues [QueryBuilder]
cols = DList QueryBuilder
-> StateT [MySQLValue] (Either SQLError) [MySQLValue]
-> Selector [MySQLValue]
forall a.
DList QueryBuilder
-> StateT [MySQLValue] (Either SQLError) a -> Selector a
Selector ([QueryBuilder] -> DList QueryBuilder
forall a. [a] -> DList a
DList.fromList [QueryBuilder]
cols) (StateT [MySQLValue] (Either SQLError) [MySQLValue]
-> Selector [MySQLValue])
-> StateT [MySQLValue] (Either SQLError) [MySQLValue]
-> Selector [MySQLValue]
forall a b. (a -> b) -> a -> b
$
([MySQLValue] -> ([MySQLValue], [MySQLValue]))
-> StateT [MySQLValue] (Either SQLError) [MySQLValue]
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (([MySQLValue] -> ([MySQLValue], [MySQLValue]))
-> StateT [MySQLValue] (Either SQLError) [MySQLValue])
-> ([MySQLValue] -> ([MySQLValue], [MySQLValue]))
-> StateT [MySQLValue] (Either SQLError) [MySQLValue]
forall a b. (a -> b) -> a -> b
$ Int -> [MySQLValue] -> ([MySQLValue], [MySQLValue])
forall a. Int -> [a] -> ([a], [a])
splitAt ([QueryBuilder] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [QueryBuilder]
cols)
rawValues_ :: [QueryBuilder] -> Selector ()
rawValues_ :: [QueryBuilder] -> Selector ()
rawValues_ [QueryBuilder]
cols = () () -> Selector [MySQLValue] -> Selector ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [QueryBuilder] -> Selector [MySQLValue]
rawValues [QueryBuilder]
cols
intFromSql :: forall a.(Show a, Bounded a, Integral a)
=> MySQLValue -> Either SQLError a
intFromSql :: MySQLValue -> Either SQLError a
intFromSql MySQLValue
r = case MySQLValue
r of
MySQLInt8U Word8
u -> Word64 -> Either SQLError a
castFromWord (Word64 -> Either SQLError a) -> Word64 -> Either SQLError a
forall a b. (a -> b) -> a -> b
$ Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
u
MySQLInt8 Int8
i -> Int64 -> Either SQLError a
castFromInt (Int64 -> Either SQLError a) -> Int64 -> Either SQLError a
forall a b. (a -> b) -> a -> b
$ Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
i
MySQLInt16U Word16
u -> Word64 -> Either SQLError a
castFromWord (Word64 -> Either SQLError a) -> Word64 -> Either SQLError a
forall a b. (a -> b) -> a -> b
$ Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
u
MySQLInt16 Int16
i -> Int64 -> Either SQLError a
castFromInt (Int64 -> Either SQLError a) -> Int64 -> Either SQLError a
forall a b. (a -> b) -> a -> b
$ Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
i
MySQLInt32U Word32
u -> Word64 -> Either SQLError a
castFromWord (Word64 -> Either SQLError a) -> Word64 -> Either SQLError a
forall a b. (a -> b) -> a -> b
$ Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
u
MySQLInt32 Int32
i -> Int64 -> Either SQLError a
castFromInt (Int64 -> Either SQLError a) -> Int64 -> Either SQLError a
forall a b. (a -> b) -> a -> b
$ Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i
MySQLInt64U Word64
u -> Word64 -> Either SQLError a
castFromWord (Word64 -> Either SQLError a) -> Word64 -> Either SQLError a
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
u
MySQLInt64 Int64
i -> Int64 -> Either SQLError a
castFromInt (Int64 -> Either SQLError a) -> Int64 -> Either SQLError a
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
MySQLYear Word16
y -> Word64 -> Either SQLError a
castFromWord (Word64 -> Either SQLError a) -> Word64 -> Either SQLError a
forall a b. (a -> b) -> a -> b
$ Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
y
MySQLValue
_ -> SQLError -> Either SQLError a
forall a b. a -> Either a b
Left (SQLError -> Either SQLError a) -> SQLError -> Either SQLError a
forall a b. (a -> b) -> a -> b
$ MySQLValue -> String -> SQLError
TypeError MySQLValue
r (String -> SQLError) -> String -> SQLError
forall a b. (a -> b) -> a -> b
$
String
"Int (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show (a
forall a. Bounded a => a
minBound :: a) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show (a
forall a. Bounded a => a
maxBound :: a) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
where castFromInt :: Int64 -> Either SQLError a
castFromInt :: Int64 -> Either SQLError a
castFromInt Int64
i
| Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
minBound :: a) = SQLError -> Either SQLError a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SQLError -> Either SQLError a) -> SQLError -> Either SQLError a
forall a b. (a -> b) -> a -> b
$ Text -> SQLError
ConversionError Text
"underflow"
| Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
maxBound :: a) = SQLError -> Either SQLError a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SQLError -> Either SQLError a) -> SQLError -> Either SQLError a
forall a b. (a -> b) -> a -> b
$ Text -> SQLError
ConversionError Text
"overflow"
| Bool
otherwise = a -> Either SQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either SQLError a) -> a -> Either SQLError a
forall a b. (a -> b) -> a -> b
$ Int64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
castFromWord :: Word64 -> Either SQLError a
castFromWord :: Word64 -> Either SQLError a
castFromWord Word64
i
| Word64
i Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
maxBound :: a) = SQLError -> Either SQLError a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SQLError -> Either SQLError a) -> SQLError -> Either SQLError a
forall a b. (a -> b) -> a -> b
$ Text -> SQLError
ConversionError Text
"overflow"
| Bool
otherwise = a -> Either SQLError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either SQLError a) -> a -> Either SQLError a
forall a b. (a -> b) -> a -> b
$ Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
integerFromSql :: MySQLValue -> Either SQLError Integer
integerFromSql :: MySQLValue -> Either SQLError Integer
integerFromSql (MySQLInt8U Word8
u) = Integer -> Either SQLError Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Either SQLError Integer)
-> Integer -> Either SQLError Integer
forall a b. (a -> b) -> a -> b
$ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
u
integerFromSql (MySQLInt8 Int8
i) = Integer -> Either SQLError Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Either SQLError Integer)
-> Integer -> Either SQLError Integer
forall a b. (a -> b) -> a -> b
$ Int8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
i
integerFromSql (MySQLInt16U Word16
u) = Integer -> Either SQLError Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Either SQLError Integer)
-> Integer -> Either SQLError Integer
forall a b. (a -> b) -> a -> b
$ Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
u
integerFromSql (MySQLInt16 Int16
i) = Integer -> Either SQLError Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Either SQLError Integer)
-> Integer -> Either SQLError Integer
forall a b. (a -> b) -> a -> b
$ Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
i
integerFromSql (MySQLInt32U Word32
u) = Integer -> Either SQLError Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Either SQLError Integer)
-> Integer -> Either SQLError Integer
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
u
integerFromSql (MySQLInt32 Int32
i) = Integer -> Either SQLError Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Either SQLError Integer)
-> Integer -> Either SQLError Integer
forall a b. (a -> b) -> a -> b
$ Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i
integerFromSql (MySQLInt64U Word64
u) = Integer -> Either SQLError Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Either SQLError Integer)
-> Integer -> Either SQLError Integer
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
u
integerFromSql (MySQLInt64 Int64
i) = Integer -> Either SQLError Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Either SQLError Integer)
-> Integer -> Either SQLError Integer
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
integerFromSql (MySQLYear Word16
y) = Integer -> Either SQLError Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Either SQLError Integer)
-> Integer -> Either SQLError Integer
forall a b. (a -> b) -> a -> b
$ Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
y
integerFromSql (MySQLDecimal Scientific
d) = case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
d of
Left (Double
_ :: Double) -> SQLError -> Either SQLError Integer
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SQLError -> Either SQLError Integer)
-> SQLError -> Either SQLError Integer
forall a b. (a -> b) -> a -> b
$ MySQLValue -> String -> SQLError
TypeError (Scientific -> MySQLValue
MySQLDecimal Scientific
d) String
"Integer"
Right Integer
i -> Integer -> Either SQLError Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
i
integerFromSql MySQLValue
v = SQLError -> Either SQLError Integer
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SQLError -> Either SQLError Integer)
-> SQLError -> Either SQLError Integer
forall a b. (a -> b) -> a -> b
$ MySQLValue -> String -> SQLError
TypeError MySQLValue
v String
"Integer"
instance FromSql Bool where
fromSql :: MySQLValue -> Either SQLError Bool
fromSql (MySQLInt8U Word8
x) = Bool -> Either SQLError Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Either SQLError Bool) -> Bool -> Either SQLError Bool
forall a b. (a -> b) -> a -> b
$ Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0
fromSql (MySQLInt8 Int8
x) = Bool -> Either SQLError Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Either SQLError Bool) -> Bool -> Either SQLError Bool
forall a b. (a -> b) -> a -> b
$ Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int8
0
fromSql MySQLValue
v = SQLError -> Either SQLError Bool
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SQLError -> Either SQLError Bool)
-> SQLError -> Either SQLError Bool
forall a b. (a -> b) -> a -> b
$ MySQLValue -> String -> SQLError
TypeError MySQLValue
v String
"Bool"
instance FromSql Int where
fromSql :: MySQLValue -> Either SQLError Int
fromSql = MySQLValue -> Either SQLError Int
forall a.
(Show a, Bounded a, Integral a) =>
MySQLValue -> Either SQLError a
intFromSql
instance FromSql Int8 where
fromSql :: MySQLValue -> Either SQLError Int8
fromSql = MySQLValue -> Either SQLError Int8
forall a.
(Show a, Bounded a, Integral a) =>
MySQLValue -> Either SQLError a
intFromSql
instance FromSql Word8 where
fromSql :: MySQLValue -> Either SQLError Word8
fromSql = MySQLValue -> Either SQLError Word8
forall a.
(Show a, Bounded a, Integral a) =>
MySQLValue -> Either SQLError a
intFromSql
instance FromSql Int16 where
fromSql :: MySQLValue -> Either SQLError Int16
fromSql = MySQLValue -> Either SQLError Int16
forall a.
(Show a, Bounded a, Integral a) =>
MySQLValue -> Either SQLError a
intFromSql
instance FromSql Word16 where
fromSql :: MySQLValue -> Either SQLError Word16
fromSql = MySQLValue -> Either SQLError Word16
forall a.
(Show a, Bounded a, Integral a) =>
MySQLValue -> Either SQLError a
intFromSql
instance FromSql Int32 where
fromSql :: MySQLValue -> Either SQLError Int32
fromSql = MySQLValue -> Either SQLError Int32
forall a.
(Show a, Bounded a, Integral a) =>
MySQLValue -> Either SQLError a
intFromSql
instance FromSql Word32 where
fromSql :: MySQLValue -> Either SQLError Word32
fromSql = MySQLValue -> Either SQLError Word32
forall a.
(Show a, Bounded a, Integral a) =>
MySQLValue -> Either SQLError a
intFromSql
instance FromSql Int64 where
fromSql :: MySQLValue -> Either SQLError Int64
fromSql = MySQLValue -> Either SQLError Int64
forall a.
(Show a, Bounded a, Integral a) =>
MySQLValue -> Either SQLError a
intFromSql
instance FromSql Word64 where
fromSql :: MySQLValue -> Either SQLError Word64
fromSql = MySQLValue -> Either SQLError Word64
forall a.
(Show a, Bounded a, Integral a) =>
MySQLValue -> Either SQLError a
intFromSql
instance FromSql Integer where
fromSql :: MySQLValue -> Either SQLError Integer
fromSql = MySQLValue -> Either SQLError Integer
integerFromSql
instance FromSql Float where
fromSql :: MySQLValue -> Either SQLError Float
fromSql MySQLValue
r = case MySQLValue
r of
MySQLFloat Float
f -> Float -> Either SQLError Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure Float
f
MySQLValue
_ -> SQLError -> Either SQLError Float
forall a b. a -> Either a b
Left (SQLError -> Either SQLError Float)
-> SQLError -> Either SQLError Float
forall a b. (a -> b) -> a -> b
$ MySQLValue -> String -> SQLError
TypeError MySQLValue
r String
"Float"
instance FromSql Double where
fromSql :: MySQLValue -> Either SQLError Double
fromSql MySQLValue
r = case MySQLValue
r of
MySQLFloat Float
f -> Double -> Either SQLError Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Either SQLError Double)
-> Double -> Either SQLError Double
forall a b. (a -> b) -> a -> b
$ Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
f
MySQLDouble Double
f -> Double -> Either SQLError Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
f
MySQLValue
_ -> SQLError -> Either SQLError Double
forall a b. a -> Either a b
Left (SQLError -> Either SQLError Double)
-> SQLError -> Either SQLError Double
forall a b. (a -> b) -> a -> b
$ MySQLValue -> String -> SQLError
TypeError MySQLValue
r String
"Double"
instance FromSql Scientific where
fromSql :: MySQLValue -> Either SQLError Scientific
fromSql MySQLValue
r = case MySQLValue
r of
MySQLDecimal Scientific
f -> Scientific -> Either SQLError Scientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scientific
f
MySQLValue
_ -> SQLError -> Either SQLError Scientific
forall a b. a -> Either a b
Left (SQLError -> Either SQLError Scientific)
-> SQLError -> Either SQLError Scientific
forall a b. (a -> b) -> a -> b
$ MySQLValue -> String -> SQLError
TypeError MySQLValue
r String
"Scientific"
instance FromSql LocalTime where
fromSql :: MySQLValue -> Either SQLError LocalTime
fromSql MySQLValue
r = case MySQLValue
r of
MySQLTimeStamp LocalTime
t -> LocalTime -> Either SQLError LocalTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalTime
t
MySQLDateTime LocalTime
t -> LocalTime -> Either SQLError LocalTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalTime
t
MySQLValue
_ -> SQLError -> Either SQLError LocalTime
forall a b. a -> Either a b
Left (SQLError -> Either SQLError LocalTime)
-> SQLError -> Either SQLError LocalTime
forall a b. (a -> b) -> a -> b
$ MySQLValue -> String -> SQLError
TypeError MySQLValue
r String
"LocalTime"
instance FromSql TimeOfDay where
fromSql :: MySQLValue -> Either SQLError TimeOfDay
fromSql MySQLValue
r = case MySQLValue
r of
MySQLTime Word8
sign_ TimeOfDay
t | Word8
sign_ Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0 -> TimeOfDay -> Either SQLError TimeOfDay
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeOfDay
t
| Bool
otherwise -> SQLError -> Either SQLError TimeOfDay
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SQLError -> Either SQLError TimeOfDay)
-> SQLError -> Either SQLError TimeOfDay
forall a b. (a -> b) -> a -> b
$ Text -> SQLError
ConversionError Text
"overflow"
MySQLValue
_ -> SQLError -> Either SQLError TimeOfDay
forall a b. a -> Either a b
Left (SQLError -> Either SQLError TimeOfDay)
-> SQLError -> Either SQLError TimeOfDay
forall a b. (a -> b) -> a -> b
$ MySQLValue -> String -> SQLError
TypeError MySQLValue
r String
"TimeOfDay"
instance FromSql DiffTime where
fromSql :: MySQLValue -> Either SQLError DiffTime
fromSql MySQLValue
r = case MySQLValue
r of
MySQLTime Word8
sign_ TimeOfDay
t | Word8
sign_ Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1 -> DiffTime -> Either SQLError DiffTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiffTime -> Either SQLError DiffTime)
-> DiffTime -> Either SQLError DiffTime
forall a b. (a -> b) -> a -> b
$ DiffTime -> DiffTime
forall a. Num a => a -> a
negate (DiffTime -> DiffTime) -> DiffTime -> DiffTime
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
t
| Bool
otherwise -> DiffTime -> Either SQLError DiffTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiffTime -> Either SQLError DiffTime)
-> DiffTime -> Either SQLError DiffTime
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
t
MySQLValue
_ -> SQLError -> Either SQLError DiffTime
forall a b. a -> Either a b
Left (SQLError -> Either SQLError DiffTime)
-> SQLError -> Either SQLError DiffTime
forall a b. (a -> b) -> a -> b
$ MySQLValue -> String -> SQLError
TypeError MySQLValue
r String
"DiffTime"
instance FromSql Day where
fromSql :: MySQLValue -> Either SQLError Day
fromSql MySQLValue
r = case MySQLValue
r of
MySQLDate Day
d -> Day -> Either SQLError Day
forall (f :: * -> *) a. Applicative f => a -> f a
pure Day
d
MySQLValue
_ -> SQLError -> Either SQLError Day
forall a b. a -> Either a b
Left (SQLError -> Either SQLError Day)
-> SQLError -> Either SQLError Day
forall a b. (a -> b) -> a -> b
$ MySQLValue -> String -> SQLError
TypeError MySQLValue
r String
"Day"
instance FromSql StrictBS.ByteString where
fromSql :: MySQLValue -> Either SQLError ByteString
fromSql MySQLValue
r = case MySQLValue
r of
MySQLBytes ByteString
b -> ByteString -> Either SQLError ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
b
MySQLValue
_ -> SQLError -> Either SQLError ByteString
forall a b. a -> Either a b
Left (SQLError -> Either SQLError ByteString)
-> SQLError -> Either SQLError ByteString
forall a b. (a -> b) -> a -> b
$ MySQLValue -> String -> SQLError
TypeError MySQLValue
r String
"ByteString"
instance FromSql Text where
fromSql :: MySQLValue -> Either SQLError Text
fromSql MySQLValue
r = case MySQLValue
r of
MySQLText Text
t -> Text -> Either SQLError Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
MySQLValue
_ -> SQLError -> Either SQLError Text
forall a b. a -> Either a b
Left (SQLError -> Either SQLError Text)
-> SQLError -> Either SQLError Text
forall a b. (a -> b) -> a -> b
$ MySQLValue -> String -> SQLError
TypeError MySQLValue
r String
"Text"
instance FromSql a => FromSql (Maybe a) where
fromSql :: MySQLValue -> Either SQLError (Maybe a)
fromSql MySQLValue
r = case MySQLValue
r of
MySQLValue
MySQLNull -> Maybe a -> Either SQLError (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
MySQLValue
_ -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either SQLError a -> Either SQLError (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MySQLValue -> Either SQLError a
forall a. FromSql a => MySQLValue -> Either SQLError a
fromSql MySQLValue
r
instance FromSql Aeson.Value where
fromSql :: MySQLValue -> Either SQLError Value
fromSql MySQLValue
r = case MySQLValue
r of
MySQLText Text
t -> case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict (ByteString -> Either String Value)
-> ByteString -> Either String Value
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
t
of Right Value
val -> Value -> Either SQLError Value
forall a b. b -> Either a b
Right Value
val
Left String
err -> SQLError -> Either SQLError Value
forall a b. a -> Either a b
Left (SQLError -> Either SQLError Value)
-> SQLError -> Either SQLError Value
forall a b. (a -> b) -> a -> b
$ Text -> SQLError
ConversionError (Text -> SQLError) -> Text -> SQLError
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
err
MySQLValue
_ -> SQLError -> Either SQLError Value
forall a b. a -> Either a b
Left (SQLError -> Either SQLError Value)
-> SQLError -> Either SQLError Value
forall a b. (a -> b) -> a -> b
$ MySQLValue -> String -> SQLError
TypeError MySQLValue
r String
"Value"
instance ToSql Int where
toSqlValue :: Int -> MySQLValue
toSqlValue = Int64 -> MySQLValue
MySQLInt64 (Int64 -> MySQLValue) -> (Int -> Int64) -> Int -> MySQLValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToSql Int8 where
toSqlValue :: Int8 -> MySQLValue
toSqlValue = Int8 -> MySQLValue
MySQLInt8
instance ToSql Word8 where
toSqlValue :: Word8 -> MySQLValue
toSqlValue = Word8 -> MySQLValue
MySQLInt8U
instance ToSql Int16 where
toSqlValue :: Int16 -> MySQLValue
toSqlValue = Int16 -> MySQLValue
MySQLInt16
instance ToSql Word16 where
toSqlValue :: Word16 -> MySQLValue
toSqlValue = Word16 -> MySQLValue
MySQLInt16U
instance ToSql Int32 where
toSqlValue :: Int32 -> MySQLValue
toSqlValue = Int32 -> MySQLValue
MySQLInt32
instance ToSql Word32 where
toSqlValue :: Word32 -> MySQLValue
toSqlValue = Word32 -> MySQLValue
MySQLInt32U
instance ToSql Int64 where
toSqlValue :: Int64 -> MySQLValue
toSqlValue = Int64 -> MySQLValue
MySQLInt64
instance ToSql Word64 where
toSqlValue :: Word64 -> MySQLValue
toSqlValue = Word64 -> MySQLValue
MySQLInt64U
instance ToSql Integer where
toSqlValue :: Integer -> MySQLValue
toSqlValue = Scientific -> MySQLValue
MySQLDecimal (Scientific -> MySQLValue)
-> (Integer -> Scientific) -> Integer -> MySQLValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToSql Float where
toSqlValue :: Float -> MySQLValue
toSqlValue = Float -> MySQLValue
MySQLFloat
instance ToSql Double where
toSqlValue :: Double -> MySQLValue
toSqlValue = Double -> MySQLValue
MySQLDouble
instance ToSql Scientific where
toSqlValue :: Scientific -> MySQLValue
toSqlValue = Scientific -> MySQLValue
MySQLDecimal
instance ToSql LocalTime where
toSqlValue :: LocalTime -> MySQLValue
toSqlValue = LocalTime -> MySQLValue
MySQLDateTime
instance ToSql TimeOfDay where
toSqlValue :: TimeOfDay -> MySQLValue
toSqlValue = Word8 -> TimeOfDay -> MySQLValue
MySQLTime Word8
0
instance ToSql DiffTime where
toSqlValue :: DiffTime -> MySQLValue
toSqlValue DiffTime
dt | DiffTime
dt DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< DiffTime
0 = Word8 -> TimeOfDay -> MySQLValue
MySQLTime Word8
1 (TimeOfDay -> MySQLValue) -> TimeOfDay -> MySQLValue
forall a b. (a -> b) -> a -> b
$ DiffTime -> TimeOfDay
timeToTimeOfDay (DiffTime -> TimeOfDay) -> DiffTime -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ DiffTime -> DiffTime
forall a. Num a => a -> a
negate DiffTime
dt
| Bool
otherwise = Word8 -> TimeOfDay -> MySQLValue
MySQLTime Word8
0 (TimeOfDay -> MySQLValue) -> TimeOfDay -> MySQLValue
forall a b. (a -> b) -> a -> b
$ DiffTime -> TimeOfDay
timeToTimeOfDay DiffTime
dt
instance ToSql Day where
toSqlValue :: Day -> MySQLValue
toSqlValue = Day -> MySQLValue
MySQLDate
instance ToSql StrictBS.ByteString where
toSqlValue :: ByteString -> MySQLValue
toSqlValue = ByteString -> MySQLValue
MySQLBytes
instance ToSql Text where
toSqlValue :: Text -> MySQLValue
toSqlValue = Text -> MySQLValue
MySQLText
instance ToSql a => ToSql (Maybe a) where
toSqlValue :: Maybe a -> MySQLValue
toSqlValue Maybe a
Nothing = MySQLValue
MySQLNull
toSqlValue (Just a
v) = a -> MySQLValue
forall a. ToSql a => a -> MySQLValue
toSqlValue a
v
instance ToSql Bool where
toSqlValue :: Bool -> MySQLValue
toSqlValue = Word8 -> MySQLValue
MySQLInt8U (Word8 -> MySQLValue) -> (Bool -> Word8) -> Bool -> MySQLValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Bool -> Int) -> Bool -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum
instance ToSql Aeson.Value where
toSqlValue :: Value -> MySQLValue
toSqlValue = Text -> MySQLValue
MySQLText (Text -> MySQLValue) -> (Value -> Text) -> Value -> MySQLValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LazyText.toStrict (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
forall a. ToJSON a => a -> Text
Aeson.encodeToLazyText