{-# LANGUAGE DeriveDataTypeable, DeriveFunctor       #-}
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

------------------------------------------------------------------------------
-- |
-- Module:      Database.SQLite.Simple.ToField
-- Copyright:   (c) 2011 MailRank, Inc.
--              (c) 2011-2012 Leon P Smith
--              (c) 2012-2013 Janne Hellsten
-- License:     BSD3
-- Maintainer:  Janne Hellsten <jjhellst@gmail.com>
-- Portability: portable
--
-- The 'ToField' typeclass, for rendering a parameter to an SQLite
-- value to be bound as a SQL query parameter.
--
------------------------------------------------------------------------------

module Database.SQLite.Simple.ToField (ToField(..)) where

import           Blaze.ByteString.Builder (toByteString)
import qualified Data.ByteString as SB
import qualified Data.ByteString.Lazy as LB
import           Data.Int (Int8, Int16, Int32, Int64)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Encoding as T
import           Data.Time (Day, UTCTime)
import           Data.Word (Word8, Word16, Word32, Word64)
import           GHC.Float

import           Database.SQLite3 as Base
import           Database.SQLite.Simple.Types (Null)
import           Database.SQLite.Simple.Time

-- | A type that may be used as a single parameter to a SQL query.
class ToField a where
    toField :: a -> SQLData
    -- ^ Prepare a value for substitution into a query string.

instance ToField SQLData where
    toField :: SQLData -> SQLData
toField a :: SQLData
a = SQLData
a
    {-# INLINE toField #-}

instance (ToField a) => ToField (Maybe a) where
    toField :: Maybe a -> SQLData
toField Nothing  = SQLData
Base.SQLNull
    toField (Just a :: a
a) = a -> SQLData
forall a. ToField a => a -> SQLData
toField a
a
    {-# INLINE toField #-}

instance ToField Null where
    toField :: Null -> SQLData
toField _ = SQLData
Base.SQLNull
    {-# INLINE toField #-}

instance ToField Bool where
    toField :: Bool -> SQLData
toField False = Int64 -> SQLData
SQLInteger 0
    toField True  = Int64 -> SQLData
SQLInteger 1
    {-# INLINE toField #-}

instance ToField Int8 where
    toField :: Int8 -> SQLData
toField = Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> (Int8 -> Int64) -> Int8 -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toField #-}

instance ToField Int16 where
    toField :: Int16 -> SQLData
toField = Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> (Int16 -> Int64) -> Int16 -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toField #-}

instance ToField Int32 where
    toField :: Int32 -> SQLData
toField = Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> (Int32 -> Int64) -> Int32 -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toField #-}

instance ToField Int where
    toField :: Int -> SQLData
toField = Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> (Int -> Int64) -> Int -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toField #-}

instance ToField Int64 where
    toField :: Int64 -> SQLData
toField = Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> (Int64 -> Int64) -> Int64 -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toField #-}

instance ToField Integer where
    toField :: Integer -> SQLData
toField = Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> (Integer -> Int64) -> Integer -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toField #-}

instance ToField Word8 where
    toField :: Word8 -> SQLData
toField = Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> (Word8 -> Int64) -> Word8 -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toField #-}

instance ToField Word16 where
    toField :: Word16 -> SQLData
toField = Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> (Word16 -> Int64) -> Word16 -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toField #-}

instance ToField Word32 where
    toField :: Word32 -> SQLData
toField = Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> (Word32 -> Int64) -> Word32 -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toField #-}

instance ToField Word where
    toField :: Word -> SQLData
toField = Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> (Word -> Int64) -> Word -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toField #-}

instance ToField Word64 where
    toField :: Word64 -> SQLData
toField = Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> (Word64 -> Int64) -> Word64 -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    {-# INLINE toField #-}

instance ToField Float where
    toField :: Float -> SQLData
toField = Double -> SQLData
SQLFloat (Double -> SQLData) -> (Float -> Double) -> Float -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
float2Double
    {-# INLINE toField #-}

instance ToField Double where
    toField :: Double -> SQLData
toField = Double -> SQLData
SQLFloat
    {-# INLINE toField #-}

instance ToField SB.ByteString where
    toField :: ByteString -> SQLData
toField = ByteString -> SQLData
SQLBlob
    {-# INLINE toField #-}

instance ToField LB.ByteString where
    toField :: ByteString -> SQLData
toField = ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (ByteString -> SQLData)
-> (ByteString -> ByteString) -> ByteString -> SQLData
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 toField #-}

instance ToField T.Text where
    toField :: Text -> SQLData
toField = Text -> SQLData
SQLText
    {-# INLINE toField #-}

instance ToField [Char] where
    toField :: [Char] -> SQLData
toField = Text -> SQLData
SQLText (Text -> SQLData) -> ([Char] -> Text) -> [Char] -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
    {-# INLINE toField #-}

instance ToField LT.Text where
    toField :: Text -> SQLData
toField = Text -> SQLData
forall a. ToField a => a -> SQLData
toField (Text -> SQLData) -> (Text -> Text) -> Text -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict
    {-# INLINE toField #-}

instance ToField UTCTime where
    toField :: UTCTime -> SQLData
toField = Text -> SQLData
SQLText (Text -> SQLData) -> (UTCTime -> Text) -> UTCTime -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (UTCTime -> ByteString) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toByteString (Builder -> ByteString)
-> (UTCTime -> Builder) -> UTCTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Builder
utcTimeToBuilder
    {-# INLINE toField #-}

instance ToField Day where
    toField :: Day -> SQLData
toField = Text -> SQLData
SQLText (Text -> SQLData) -> (Day -> Text) -> Day -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (Day -> ByteString) -> Day -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toByteString (Builder -> ByteString) -> (Day -> Builder) -> Day -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Builder
dayToBuilder
    {-# INLINE toField #-}

-- TODO enable these
--instance ToField ZonedTime where
--    toField = SQLText . zonedTimeToBuilder
--    {-# INLINE toField #-}
--
--instance ToField LocalTime where
--    toField = SQLText . localTimeToBuilder
--    {-# INLINE toField #-}
--
--instance ToField Day where
--    toField = SQLText . dayToBuilder
--    {-# INLINE toField #-}
--
--instance ToField TimeOfDay where
--    toField = SQLText . timeOfDayToBuilder
--    {-# INLINE toField #-}
--
--instance ToField UTCTimestamp where
--    toField = SQLText . utcTimestampToBuilder
--    {-# INLINE toField #-}
--
--instance ToField ZonedTimestamp where
--    toField = SQLText . zonedTimestampToBuilder
--    {-# INLINE toField #-}
--
--instance ToField LocalTimestamp where
--    toField = SQLText . localTimestampToBuilder
--    {-# INLINE toField #-}
--
--instance ToField Date where
--    toField = SQLText . dateToBuilder
--    {-# INLINE toField #-}