{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, FlexibleInstances,
OverloadedStrings, DefaultSignatures #-}
module Database.MySQL.Simple.Param
( Action(..)
, ToField(..)
, Param(..)
, inQuotes
) where
import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString,
toByteString)
import Blaze.ByteString.Builder.Char8 (fromChar)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Base16.Lazy as L16
import Data.Int (Int8, Int16, Int32, Int64)
import Data.List (intersperse)
import Data.Monoid (mappend)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Time.Calendar (Day, showGregorian)
import Data.Time.Clock (UTCTime)
import Data.Time.Format (formatTime)
import Data.Time.LocalTime (TimeOfDay)
import Data.Typeable (Typeable)
import Data.Word (Word, Word8, Word16, Word32, Word64)
import Database.MySQL.Simple.Types (Binary(..), In(..), VaArgs(..), Null)
import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8
import qualified Data.ByteString as SB
import qualified Data.ByteString.Lazy as LB
import qualified Data.Text as ST
import qualified Data.Text.Encoding as ST
import qualified Data.Text.Lazy as LT
import Database.MySQL.Internal.Blaze (integral, double, float)
#if MIN_VERSION_time(1,5,0)
import Data.Time.Format (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif
data Action =
Plain Builder
| Escape ByteString
| Many [Action]
deriving (Typeable)
instance Show Action where
show :: Action -> String
show (Plain Builder
b) = String
"Plain " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Builder -> ByteString
toByteString Builder
b)
show (Escape ByteString
b) = String
"Escape " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
b
show (Many [Action]
b) = String
"Many " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Action] -> String
forall a. Show a => a -> String
show [Action]
b
class ToField a where
toField :: a -> ByteString
class Param a where
render :: a -> Action
default render :: ToField a => a -> Action
render = ByteString -> Action
Escape (ByteString -> Action) -> (a -> ByteString) -> a -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToField a => a -> ByteString
toField
instance Param Action where
render :: Action -> Action
render Action
a = Action
a
{-# INLINE render #-}
instance (Param a) => Param (Maybe a) where
render :: Maybe a -> Action
render Maybe a
Nothing = Action
renderNull
render (Just a
a) = a -> Action
forall a. Param a => a -> Action
render a
a
{-# INLINE render #-}
instance (Param a) => Param (In [a]) where
render :: In [a] -> Action
render (In []) = Builder -> Action
Plain (Builder -> Action) -> Builder -> Action
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromByteString ByteString
"(null)"
render (In [a]
xs) = [Action] -> Action
Many ([Action] -> Action) -> [Action] -> Action
forall a b. (a -> b) -> a -> b
$
Builder -> Action
Plain (Char -> Builder
fromChar Char
'(') Action -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:
(Action -> [Action] -> [Action]
forall a. a -> [a] -> [a]
intersperse (Builder -> Action
Plain (Char -> Builder
fromChar Char
',')) ([Action] -> [Action]) -> ([a] -> [Action]) -> [a] -> [Action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Action) -> [a] -> [Action]
forall a b. (a -> b) -> [a] -> [b]
map a -> Action
forall a. Param a => a -> Action
render ([a] -> [Action]) -> [a] -> [Action]
forall a b. (a -> b) -> a -> b
$ [a]
xs) [Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++
[Builder -> Action
Plain (Char -> Builder
fromChar Char
')')]
instance (Param a) => Param (In (Set a)) where
render :: In (Set a) -> Action
render = In [a] -> Action
forall a. Param a => a -> Action
render (In [a] -> Action)
-> (In (Set a) -> In [a]) -> In (Set a) -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> [a]) -> In (Set a) -> In [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Set a -> [a]
forall a. Set a -> [a]
Set.toList
instance (Param a) => Param (VaArgs [a]) where
render :: VaArgs [a] -> Action
render (VaArgs []) = Builder -> Action
Plain (Builder -> Action) -> Builder -> Action
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromByteString ByteString
"null"
render (VaArgs [a]
xs) = [Action] -> Action
Many ([Action] -> Action) -> [Action] -> Action
forall a b. (a -> b) -> a -> b
$
Action -> [Action] -> [Action]
forall a. a -> [a] -> [a]
intersperse (Builder -> Action
Plain (Char -> Builder
fromChar Char
',')) ([Action] -> [Action]) -> ([a] -> [Action]) -> [a] -> [Action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Action) -> [a] -> [Action]
forall a b. (a -> b) -> [a] -> [b]
map a -> Action
forall a. Param a => a -> Action
render ([a] -> [Action]) -> [a] -> [Action]
forall a b. (a -> b) -> a -> b
$ [a]
xs
instance Param (Binary SB.ByteString) where
render :: Binary ByteString -> Action
render (Binary ByteString
bs) = Builder -> Action
Plain (Builder -> Action) -> Builder -> Action
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromByteString ByteString
"x'" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
ByteString -> Builder
fromByteString (ByteString -> ByteString
B16.encode ByteString
bs) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
Char -> Builder
fromChar Char
'\''
instance Param (Binary LB.ByteString) where
render :: Binary ByteString -> Action
render (Binary ByteString
bs) = Builder -> Action
Plain (Builder -> Action) -> Builder -> Action
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromByteString ByteString
"x'" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
ByteString -> Builder
fromLazyByteString (ByteString -> ByteString
L16.encode ByteString
bs) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
Char -> Builder
fromChar Char
'\''
renderNull :: Action
renderNull :: Action
renderNull = Builder -> Action
Plain (ByteString -> Builder
fromByteString ByteString
"null")
instance Param Null where
render :: Null -> Action
render Null
_ = Action
renderNull
{-# INLINE render #-}
instance Param Bool where
render :: Bool -> Action
render = Builder -> Action
Plain (Builder -> Action) -> (Bool -> Builder) -> Bool -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral (Int -> Builder) -> (Bool -> Int) -> Bool -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum
{-# INLINE render #-}
instance Param Int8 where
render :: Int8 -> Action
render = Builder -> Action
Plain (Builder -> Action) -> (Int8 -> Builder) -> Int8 -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral
{-# INLINE render #-}
instance Param Int16 where
render :: Int16 -> Action
render = Builder -> Action
Plain (Builder -> Action) -> (Int16 -> Builder) -> Int16 -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral
{-# INLINE render #-}
instance Param Int32 where
render :: Int32 -> Action
render = Builder -> Action
Plain (Builder -> Action) -> (Int32 -> Builder) -> Int32 -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral
{-# INLINE render #-}
instance Param Int where
render :: Int -> Action
render = Builder -> Action
Plain (Builder -> Action) -> (Int -> Builder) -> Int -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral
{-# INLINE render #-}
instance Param Int64 where
render :: Int64 -> Action
render = Builder -> Action
Plain (Builder -> Action) -> (Int64 -> Builder) -> Int64 -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral
{-# INLINE render #-}
instance Param Integer where
render :: Integer -> Action
render = Builder -> Action
Plain (Builder -> Action) -> (Integer -> Builder) -> Integer -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral
{-# INLINE render #-}
instance Param Word8 where
render :: Word8 -> Action
render = Builder -> Action
Plain (Builder -> Action) -> (Word8 -> Builder) -> Word8 -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral
{-# INLINE render #-}
instance Param Word16 where
render :: Word16 -> Action
render = Builder -> Action
Plain (Builder -> Action) -> (Word16 -> Builder) -> Word16 -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral
{-# INLINE render #-}
instance Param Word32 where
render :: Word32 -> Action
render = Builder -> Action
Plain (Builder -> Action) -> (Word32 -> Builder) -> Word32 -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral
{-# INLINE render #-}
instance Param Word where
render :: Word -> Action
render = Builder -> Action
Plain (Builder -> Action) -> (Word -> Builder) -> Word -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral
{-# INLINE render #-}
instance Param Word64 where
render :: Word64 -> Action
render = Builder -> Action
Plain (Builder -> Action) -> (Word64 -> Builder) -> Word64 -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Builder
forall a. (Integral a, Show a) => a -> Builder
integral
{-# INLINE render #-}
instance Param Float where
render :: Float -> Action
render Float
v | Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
v Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
v = Action
renderNull
| Bool
otherwise = Builder -> Action
Plain (Float -> Builder
float Float
v)
{-# INLINE render #-}
instance Param Double where
render :: Double -> Action
render Double
v | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
v Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
v = Action
renderNull
| Bool
otherwise = Builder -> Action
Plain (Double -> Builder
double Double
v)
{-# INLINE render #-}
instance Param SB.ByteString where
render :: ByteString -> Action
render = ByteString -> Action
Escape
{-# INLINE render #-}
instance Param LB.ByteString where
render :: ByteString -> Action
render = ByteString -> Action
forall a. Param a => a -> Action
render (ByteString -> Action)
-> (ByteString -> ByteString) -> ByteString -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
SB.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LB.toChunks
{-# INLINE render #-}
instance Param ST.Text where
render :: Text -> Action
render = ByteString -> Action
Escape (ByteString -> Action) -> (Text -> ByteString) -> Text -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
ST.encodeUtf8
{-# INLINE render #-}
instance Param [Char] where
render :: String -> Action
render = ByteString -> Action
Escape (ByteString -> Action)
-> (String -> ByteString) -> String -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toByteString (Builder -> ByteString)
-> (String -> Builder) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
Utf8.fromString
{-# INLINE render #-}
instance Param LT.Text where
render :: Text -> Action
render = Text -> Action
forall a. Param a => a -> Action
render (Text -> Action) -> (Text -> Text) -> Text -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict
{-# INLINE render #-}
instance Param UTCTime where
render :: UTCTime -> Action
render = Builder -> Action
Plain (Builder -> Action) -> (UTCTime -> Builder) -> UTCTime -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
Utf8.fromString (String -> Builder) -> (UTCTime -> String) -> UTCTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"'%F %T%Q'"
{-# INLINE render #-}
instance Param Day where
render :: Day -> Action
render = Builder -> Action
Plain (Builder -> Action) -> (Day -> Builder) -> Day -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
inQuotes (Builder -> Builder) -> (Day -> Builder) -> Day -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
Utf8.fromString (String -> Builder) -> (Day -> String) -> Day -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> String
showGregorian
{-# INLINE render #-}
instance Param TimeOfDay where
render :: TimeOfDay -> Action
render = Builder -> Action
Plain (Builder -> Action)
-> (TimeOfDay -> Builder) -> TimeOfDay -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
inQuotes (Builder -> Builder)
-> (TimeOfDay -> Builder) -> TimeOfDay -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
Utf8.fromString (String -> Builder)
-> (TimeOfDay -> String) -> TimeOfDay -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> String
forall a. Show a => a -> String
show
{-# INLINE render #-}
inQuotes :: Builder -> Builder
inQuotes :: Builder -> Builder
inQuotes Builder
b = Builder
quote Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
quote
where quote :: Builder
quote = Char -> Builder
Utf8.fromChar Char
'\''