{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}

{-|
Module      : Database.Hasqelator
Description : SQL generation
Copyright   : (c) Kristof Bastiaensen, 2020
License     : BSD-3
Maintainer  : kristof@resonata.be
Stability   : unstable
Portability : ghc


-}

module Database.MySQL.Hasqlator
  ( -- * Querying
    Query, Command, select, mergeSelect, replaceSelect,

    -- * Query Clauses
    QueryClauses, from, innerJoin, leftJoin, rightJoin, outerJoin, emptyJoins,
    where_, emptyWhere, groupBy_, having, emptyHaving, QueryOrdering(..),
    orderBy, limit, limitOffset,

    -- * Selectors
    Selector, as,

    -- ** polymorphic selector
    sel,
    -- ** specialised selectors
    -- | The following are specialised versions of `sel`.  Using these
    -- may make refactoring easier, for example accidently swapping
    -- @`sel` "age"@ and @`sel` "name"@ would not give a type error,
    -- while @intSel "age"@ and @textSel "name"@ most likely would.
    intSel, integerSel, doubleSel, floatSel, scientificSel, 
    localTimeSel, timeOfDaySel, diffTimeSel, daySel, byteStringSel,
    textSel,
    -- ** other selectors
    values, values_,

    -- * Expressions
    subQuery,
    arg, fun, op, (>.), (<.), (>=.), (<=.), (+.), (-.), (*.), (/.), (=.), (++.),
    (/=.), (&&.), (||.), abs_, negate_, signum_, sum_, rawSql, substr, in_,

    -- * Insertion
    Insertor, insertValues, insertSelect, insertData, skipInsert, into, Getter,
    lensInto, insertOne, ToSql,
    
    -- * Rendering Queries
    renderStmt, renderPreparedStmt, SQLError(..), QueryBuilder,
    ToQueryBuilder(..), FromSql,

    -- * Executing Queries
    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

-- | Execute a Query which returns a resultset.  May throw a
-- `SQLError` exception.  See the mysql-haskell package for other
-- exceptions it may throw.
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

-- | Execute a Command which doesn't return a result-set. May throw a
-- `SQLError` exception.  See the mysql-haskell package for other
-- exceptions it may throw.
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

-- | The polymorphic selector.  The return type is determined by type
-- inference.
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

-- | an integer field (TINYINT.. BIGINT).  Any bounded haskell integer
-- type can be used here , for example `Int`, `Int32`, `Word32`.  An
-- `Overflow` ur `Underflow` error will be raised if the value doesn't
-- fit the type.
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

-- | Un unbounded integer field, either a bounded integer (TINYINT,
-- etc...) or DECIMAL in the database.  Will throw a type error if the
-- stored value is actually fractional.
--
-- /WARNING/: this function could potentially create huge integers with DECIMAL,
-- if the exponent is large, even fillup the space and crash your
-- program!  Only use this on trusted inputs, or use Scientific
-- instead.
integerSel :: QueryBuilder -> Selector Integer
integerSel :: QueryBuilder -> Selector Integer
integerSel = QueryBuilder -> Selector Integer
forall a. FromSql a => QueryBuilder -> Selector a
sel

-- | a DOUBLE field.
doubleSel :: QueryBuilder -> Selector Double
doubleSel :: QueryBuilder -> Selector Double
doubleSel = QueryBuilder -> Selector Double
forall a. FromSql a => QueryBuilder -> Selector a
sel

-- | a FLOAT field.
floatSel :: QueryBuilder -> Selector Float
floatSel :: QueryBuilder -> Selector Float
floatSel = QueryBuilder -> Selector Float
forall a. FromSql a => QueryBuilder -> Selector a
sel

-- | A DECIMAL or NUMERIC field.
scientificSel :: QueryBuilder -> Selector Scientific
scientificSel :: QueryBuilder -> Selector Scientific
scientificSel = QueryBuilder -> Selector Scientific
forall a. FromSql a => QueryBuilder -> Selector a
sel

-- | a DATETIME or a TIMESTAMP field.
localTimeSel :: QueryBuilder -> Selector LocalTime
localTimeSel :: QueryBuilder -> Selector LocalTime
localTimeSel = QueryBuilder -> Selector LocalTime
forall a. FromSql a => QueryBuilder -> Selector a
sel

-- | A TIME field taken as a specific time.
timeOfDaySel :: QueryBuilder -> Selector TimeOfDay
timeOfDaySel :: QueryBuilder -> Selector TimeOfDay
timeOfDaySel = QueryBuilder -> Selector TimeOfDay
forall a. FromSql a => QueryBuilder -> Selector a
sel

-- | a TIME field taken as a time duration.
diffTimeSel :: QueryBuilder -> Selector DiffTime
diffTimeSel :: QueryBuilder -> Selector DiffTime
diffTimeSel = QueryBuilder -> Selector DiffTime
forall a. FromSql a => QueryBuilder -> Selector a
sel

-- | A DATE field.
daySel :: QueryBuilder -> Selector Day
daySel :: QueryBuilder -> Selector Day
daySel = QueryBuilder -> Selector Day
forall a. FromSql a => QueryBuilder -> Selector a
sel

-- | A binary BLOB field.
byteStringSel :: QueryBuilder -> Selector StrictBS.ByteString
byteStringSel :: QueryBuilder -> Selector ByteString
byteStringSel = QueryBuilder -> Selector ByteString
forall a. FromSql a => QueryBuilder -> Selector a
sel

-- | a TEXT field.
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
-- | Selectors contain the target fields or expressions in a SQL
-- SELECT statement, and perform the conversion to haskell.  Selectors
-- are instances of `Applicative`, so they can return the desired
-- haskell type.
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) [a]
             | forall a.Delete (Query a)

-- | An @`Insertor` a@ provides a mapping of parts of values of type
-- @a@ to columns in the database.  Insertors can be combined using `<>`.
data Insertor a = Insertor [Text] (a -> [MySQLValue])

data Join = Join JoinType [QueryBuilder] [QueryBuilder]
data JoinType = InnerJoin | LeftJoin | RightJoin | OuterJoin

instance ToQueryBuilder Command where
  toQueryBuilder :: Command -> QueryBuilder
toQueryBuilder (Update QueryBuilder
table [(QueryBuilder, QueryBuilder)]
setting QueryBody
body) =
    let pairQuery :: (a, a) -> a
pairQuery (a
a, a
b) = a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" = " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b
    in [QueryBuilder] -> QueryBuilder
forall a. (IsString a, Monoid a) => [a] -> a
unwords
        [ QueryBuilder
"UPDATE", QueryBuilder
table
       , 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
forall a. (Semigroup a, IsString a) => (a, a) -> a
pairQuery [(QueryBuilder, QueryBuilder)]
setting
       , QueryBody -> QueryBuilder
forall a. ToQueryBuilder a => a -> QueryBuilder
toQueryBuilder QueryBody
body
       ] 
    
  toQueryBuilder (InsertValues (QueryBuilder Builder
table Builder
_ DList MySQLValue
_)
                  (Insertor [Text]
cols a -> [MySQLValue]
convert) [a]
values__) =
    let builder, valuesB :: Builder
        valuesB :: Builder
valuesB = [Builder] -> Builder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
                  (a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Builder
forall a. (IsString a, Monoid a) => a -> a
parentized (Builder -> Builder) -> (a -> Builder) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep ([Builder] -> Builder) -> (a -> [Builder]) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MySQLValue -> Builder) -> [MySQLValue] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map MySQLValue -> Builder
mysqlValueBuilder ([MySQLValue] -> [Builder])
-> (a -> [MySQLValue]) -> a -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [MySQLValue]
convert)
                  [a]
values__
        builder :: Builder
builder = [Builder] -> Builder
forall a. (IsString a, Monoid a) => [a] -> a
unwords [ Builder
"INSERT INTO", Builder
table
                          , Builder -> Builder
forall a. (IsString a, Monoid a) => a -> a
parentized (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. (IsString a, Monoid a) => [a] -> a
commaSep ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
                            (Text -> Builder) -> [Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Builder
Builder.byteString (ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8) [Text]
cols
                          , Builder
"VALUES", Builder
valuesB]
    in Builder -> Builder -> DList MySQLValue -> QueryBuilder
QueryBuilder Builder
builder Builder
builder DList MySQLValue
forall a. DList a
DList.empty
  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 -> [MySQLValue]
conv1 <> :: Insertor a -> Insertor a -> Insertor a
<> Insertor [Text]
fields2 a -> [MySQLValue]
conv2 =
    [Text] -> (a -> [MySQLValue]) -> Insertor a
forall a. [Text] -> (a -> [MySQLValue]) -> Insertor a
Insertor ([Text]
fields1 [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
fields2) (a -> [MySQLValue]
conv1 (a -> [MySQLValue]) -> (a -> [MySQLValue]) -> a -> [MySQLValue]
forall a. Semigroup a => a -> a -> a
<> a -> [MySQLValue]
conv2)

instance Monoid (Insertor a) where
  mempty :: Insertor a
mempty = [Text] -> (a -> [MySQLValue]) -> Insertor a
forall a. [Text] -> (a -> [MySQLValue]) -> Insertor a
Insertor [Text]
forall a. Monoid a => a
mempty a -> [MySQLValue]
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 -> [MySQLValue]
g) = [Text] -> (a -> [MySQLValue]) -> Insertor a
forall a. [Text] -> (a -> [MySQLValue]) -> Insertor a
Insertor [Text]
x (b -> [MySQLValue]
g (b -> [MySQLValue]) -> (a -> b) -> a -> [MySQLValue]
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]

(>.), (<.), (>=.), (<=.), (+.), (-.), (/.), (*.), (=.), (/=.), (++.), (&&.),
  (||.)
  :: 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]


-- | insert a single value directly
insertOne :: ToSql a => Text -> Insertor a
insertOne :: Text -> Insertor a
insertOne Text
s = [Text] -> (a -> [MySQLValue]) -> Insertor a
forall a. [Text] -> (a -> [MySQLValue]) -> Insertor a
Insertor [Text
s] (\a
t -> [a -> MySQLValue
forall a. ToSql a => a -> MySQLValue
toSqlValue a
t])

-- | insert a datastructure
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` inserts a tuple or other product type into the given
-- fields.  It uses generics to match the input to the fields. For
-- example:
--
-- > insert "Person" (insertData ("name", "age"))
-- >   [Person "Bart Simpson" 10, Person "Lisa Simpson" 8]

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 is mempty specialized to an Insertor.  It can be used
-- to skip fields when using insertData.
skipInsert :: Insertor a
skipInsert :: Insertor a
skipInsert = Insertor a
forall a. Monoid a => a
mempty

-- | `into` uses the given accessor function to map the part to a
-- field.  For example:
--
-- > insertValues "Person" (fst `into` "name" <> snd `into` "age")
-- >   [("Bart Simpson", 10), ("Lisa Simpson", 8)]
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

-- | A Getter type compatible with the lens library
type Getter s a = (a -> Const a a) -> s -> Const a s

-- | `lensInto` uses a lens to map the part to a field.  For example:
--
-- > insertValues "Person" (_1 `lensInto` "name" <> _2 `lensInto` "age")
-- >   [("Bart Simpson", 10), ("Lisa Simpson", 8)]

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 -> Insertor a -> [a] -> Command
forall a. QueryBuilder -> Insertor a -> [a] -> Command
InsertValues

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

-- | combinator for aliasing columns.
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
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)

-- | Read the columns directly as a `MySQLValue` type without conversion.
values :: [QueryBuilder] -> Selector [MySQLValue]
values :: [QueryBuilder] -> Selector [MySQLValue]
values [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)

-- | Ignore the content of the given columns
values_ :: [QueryBuilder] -> Selector ()
values_ :: [QueryBuilder] -> Selector ()
values_ [QueryBuilder]
cols = () () -> Selector [MySQLValue] -> Selector ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [QueryBuilder] -> Selector [MySQLValue]
values [QueryBuilder]
cols
  
-- selector for any bounded integer type
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