#if ! (MIN_VERSION_time(1,1,3))
#endif
module Database.HDBI.SqlValue
(
ToSql(..)
, FromSql(..)
, ConvertError(..)
, BitField(..)
, SqlValue(..)
)
where
import Database.HDBI.Formaters
import Database.HDBI.Parsers
import Control.Applicative ((<$>))
import Control.Exception
import Data.Attoparsec.Text.Lazy
import Data.Data (Data)
import Data.Ix (Ix)
import Data.Bits (Bits)
import Data.Decimal
import Data.Int
import Data.List (intercalate)
import Data.Time
import Data.Typeable
import Data.UUID (UUID, fromString, toString)
import Data.Word
import qualified Blaze.ByteString.Builder as BB
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
data ConvertError =
ConvertError { ceReason :: String
}
| IncompatibleTypes { ceFromType :: String
, ceToType :: String
}
deriving (Show, Typeable, Eq)
instance Exception ConvertError
newtype BitField = BitField { unBitField :: Word64 }
deriving (Bounded, Enum, Eq, Integral, Data, Num, Ord, Real, Ix, Typeable, Bits)
instance Show BitField where
show = formatBitField . unBitField
class ToSql a where
toSql :: a -> SqlValue
class FromSql a where
safeFromSql :: SqlValue -> Either ConvertError a
fromSql :: SqlValue -> a
fromSql s = case safeFromSql s of
Left e -> throw e
Right a -> a
showFail :: [String]
-> String
-> String
showFail cont msg = "Parser failed in context "
++ (show $ intercalate ", " cont)
++ " with message "
++ (show msg)
incompatibleTypes :: (Typeable a, Typeable b) => a -> b -> Either ConvertError c
incompatibleTypes a b = Left $ IncompatibleTypes (show $ typeOf a) (show $ typeOf b)
nullConvertError :: (Typeable a) => a -> Either ConvertError b
nullConvertError a = Left $ ConvertError ("could not convert SqlNull to " ++ (show $ typeOf a))
convertToBounded :: forall b. (Integral b, Typeable b, Bounded b) => Integer -> Either ConvertError b
convertToBounded a = if a > bmax
then errorval
else if a < bmin
then errorval
else Right $ fromIntegral a
where
bmin = toInteger (minBound :: b)
bmax = toInteger (maxBound :: b)
errorval = Left $ ConvertError ("The value " ++ show a ++ " is out of bounds of " ++ (show $ typeOf (undefined :: b)))
tryParse :: TL.Text -> Parser a -> Either ConvertError a
tryParse t parser = case parse parser t of
Fail _ cont desc -> Left $ ConvertError $ showFail cont desc
Done _ res -> Right res
data SqlValue =
SqlDecimal Decimal
| SqlInteger Integer
| SqlDouble Double
| SqlText TL.Text
| SqlBlob B.ByteString
| SqlBool Bool
| SqlBitField BitField
| SqlUUID UUID
| SqlUTCTime UTCTime
| SqlLocalDate Day
| SqlLocalTimeOfDay TimeOfDay
| SqlLocalTime LocalTime
| SqlNull
deriving (Show, Typeable, Ord)
instance Eq SqlValue where
(SqlDecimal a) == (SqlDecimal b) = a == b
(SqlInteger a) == (SqlInteger b) = a == b
(SqlDouble a) == (SqlDouble b) = a == b
(SqlText a) == (SqlText b) = a == b
(SqlBlob a) == (SqlBlob b) = a == b
(SqlBool a) == (SqlBool b) = a == b
(SqlBitField a) == (SqlBitField b) = a == b
(SqlUUID a) == (SqlUUID b) = a == b
(SqlUTCTime a) == (SqlUTCTime b) = a == b
(SqlLocalDate a) == (SqlLocalDate b) = a == b
(SqlLocalTimeOfDay a) == (SqlLocalTimeOfDay b) = a == b
(SqlLocalTime a) == (SqlLocalTime b) = a == b
SqlNull == SqlNull = True
SqlNull == _ = False
_ == SqlNull = False
a == b = case convres of
Left _ -> False
Right r -> r
where
convres = do
(x :: String) <- safeFromSql a
y <- safeFromSql b
return $ x == y
instance ToSql Decimal where
toSql = SqlDecimal
instance FromSql Decimal where
safeFromSql (SqlDecimal d) = Right d
safeFromSql (SqlInteger i) = Right $ fromIntegral i
safeFromSql (SqlDouble d) = Right $ realToFrac d
safeFromSql (SqlText t) = tryParse t $ signed rational
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: Decimal)
safeFromSql (SqlBool b) = Right $ if b then 1 else 0
safeFromSql (SqlBitField bf) = Right $ fromIntegral bf
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: Decimal)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: Decimal)
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: Decimal)
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Decimal)
safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Decimal)
safeFromSql SqlNull = nullConvertError (undefined :: Decimal)
instance ToSql Int where
toSql i = SqlInteger $ toInteger i
instance FromSql Int where
safeFromSql (SqlDecimal d) = convertToBounded $ truncate d
safeFromSql (SqlInteger i) = convertToBounded i
safeFromSql (SqlDouble d) = convertToBounded $ truncate d
safeFromSql (SqlText t) = tryParse t $ signed decimal
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: Int)
safeFromSql (SqlBool b) = Right $ if b then 1 else 0
safeFromSql (SqlBitField bf) = convertToBounded $ toInteger bf
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: Int)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: Int)
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: Int)
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Int)
safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Int)
safeFromSql SqlNull = nullConvertError (undefined :: Int)
instance ToSql Int32 where
toSql i = SqlInteger $ toInteger i
instance FromSql Int32 where
safeFromSql (SqlDecimal d) = convertToBounded $ truncate d
safeFromSql (SqlInteger i) = convertToBounded i
safeFromSql (SqlDouble d) = convertToBounded $ truncate d
safeFromSql (SqlText t) = tryParse t $ signed decimal
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: Int32)
safeFromSql (SqlBool b) = Right $ if b then 1 else 0
safeFromSql (SqlBitField bf) = convertToBounded $ toInteger bf
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: Int32)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: Int32)
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: Int32)
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Int32)
safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Int32)
safeFromSql SqlNull = nullConvertError (undefined :: Int32)
instance ToSql Int64 where
toSql i = SqlInteger $ toInteger i
instance FromSql Int64 where
safeFromSql (SqlDecimal d) = convertToBounded $ truncate d
safeFromSql (SqlInteger i) = convertToBounded i
safeFromSql (SqlDouble d) = convertToBounded $ truncate d
safeFromSql (SqlText t) = tryParse t $ signed decimal
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: Int64)
safeFromSql (SqlBool b) = Right $ if b then 1 else 0
safeFromSql (SqlBitField bf) = convertToBounded $ toInteger bf
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: Int64)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: Int64)
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: Int64)
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Int64)
safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Int64)
safeFromSql SqlNull = nullConvertError (undefined :: Int64)
instance ToSql Integer where
toSql = SqlInteger
instance FromSql Integer where
safeFromSql (SqlDecimal d) = Right $ truncate d
safeFromSql (SqlInteger i) = Right i
safeFromSql (SqlDouble d) = Right $ truncate d
safeFromSql (SqlText t) = tryParse t $ signed decimal
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: Integer)
safeFromSql (SqlBool b) = Right $ if b then 1 else 0
safeFromSql (SqlBitField bf) = Right $ toInteger bf
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: Integer)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: Integer)
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: Integer)
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Integer)
safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Integer)
safeFromSql SqlNull = nullConvertError (undefined :: Integer)
instance ToSql Word32 where
toSql i = SqlInteger $ toInteger i
instance FromSql Word32 where
safeFromSql (SqlDecimal d) = convertToBounded $ truncate d
safeFromSql (SqlInteger i) = convertToBounded i
safeFromSql (SqlDouble d) = convertToBounded $ truncate d
safeFromSql (SqlText t) = tryParse t (decimal <?> "Word32 parser")
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: Word32)
safeFromSql (SqlBool b) = Right $ if b then 1 else 0
safeFromSql (SqlBitField bf) = convertToBounded $ toInteger bf
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: Word32)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: Word32)
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: Word32)
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Word32)
safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Word32)
safeFromSql SqlNull = nullConvertError (undefined :: Word32)
instance ToSql Word64 where
toSql i = SqlInteger $ toInteger i
instance FromSql Word64 where
safeFromSql (SqlDecimal d) = convertToBounded $ truncate d
safeFromSql (SqlInteger i) = convertToBounded i
safeFromSql (SqlDouble d) = convertToBounded $ truncate d
safeFromSql (SqlText t) = tryParse t (decimal <?> "Word64 parser")
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: Word64)
safeFromSql (SqlBool b) = Right $ if b then 1 else 0
safeFromSql (SqlBitField bf) = Right $ unBitField bf
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: Word64)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: Word64)
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: Word64)
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Word64)
safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Word64)
safeFromSql SqlNull = nullConvertError (undefined :: Word64)
instance ToSql Word where
toSql i = SqlInteger $ toInteger i
instance FromSql Word where
safeFromSql (SqlDecimal d) = convertToBounded $ truncate d
safeFromSql (SqlInteger i) = convertToBounded i
safeFromSql (SqlDouble d) = convertToBounded $ truncate d
safeFromSql (SqlText t) = tryParse t (decimal <?> "Word parser")
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: Word)
safeFromSql (SqlBool b) = Right $ if b then 1 else 0
safeFromSql (SqlBitField bf) = convertToBounded $ toInteger bf
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: Word)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: Word)
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: Word)
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Word)
safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Word)
safeFromSql SqlNull = nullConvertError (undefined :: Word)
instance ToSql Double where
toSql = SqlDouble
instance FromSql Double where
safeFromSql (SqlDecimal d) = Right $ realToFrac d
safeFromSql (SqlInteger i) = Right $ fromIntegral i
safeFromSql (SqlDouble d) = Right d
safeFromSql (SqlText t) = tryParse t $ signed double
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: Double)
safeFromSql (SqlBool b) = Right $ if b then 1 else 0
safeFromSql (SqlBitField bf) = Right $ fromIntegral bf
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: Double)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: Double)
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: Double)
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Double)
safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Double)
safeFromSql SqlNull = nullConvertError (undefined :: Double)
instance ToSql [Char] where
toSql s = SqlText $ TL.pack s
instance FromSql [Char] where
safeFromSql (SqlDecimal d) = Right $ show d
safeFromSql (SqlInteger i) = Right $ show i
safeFromSql (SqlDouble d) = Right $ show d
safeFromSql (SqlText t) = Right $ TL.unpack t
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: String)
safeFromSql (SqlBool b) = Right $ if b then "t" else "f"
safeFromSql (SqlBitField bf) = Right $ formatBitField $ unBitField bf
safeFromSql (SqlUUID u) = Right $ toString u
safeFromSql (SqlUTCTime ut) = Right $ formatIsoUTCTime ut
safeFromSql (SqlLocalDate ld) = Right $ formatIsoDay ld
safeFromSql (SqlLocalTimeOfDay tod) = Right $ formatIsoTimeOfDay tod
safeFromSql (SqlLocalTime lt) = Right $ formatIsoLocalTime lt
safeFromSql SqlNull = nullConvertError (undefined :: String)
instance ToSql TL.Text where
toSql = SqlText
instance FromSql TL.Text where
safeFromSql (SqlText t) = Right t
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: TL.Text)
safeFromSql SqlNull = nullConvertError (undefined :: TL.Text)
safeFromSql x = TL.pack <$> safeFromSql x
instance ToSql T.Text where
toSql t = SqlText $ TL.fromChunks [t]
instance FromSql T.Text where
safeFromSql (SqlText t) = Right $ TL.toStrict t
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: T.Text)
safeFromSql SqlNull = nullConvertError (undefined :: T.Text)
safeFromSql x = T.pack <$> safeFromSql x
instance ToSql B.ByteString where
toSql = SqlBlob
instance FromSql B.ByteString where
safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: B.ByteString)
safeFromSql (SqlInteger i) = incompatibleTypes i (undefined :: B.ByteString)
safeFromSql (SqlDouble d) = incompatibleTypes d (undefined :: B.ByteString)
safeFromSql (SqlText t) = incompatibleTypes t (undefined :: B.ByteString)
safeFromSql (SqlBlob b) = Right b
safeFromSql (SqlBool b) = incompatibleTypes b (undefined :: B.ByteString)
safeFromSql (SqlBitField bf) = incompatibleTypes bf (undefined :: B.ByteString)
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: B.ByteString)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: B.ByteString)
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: B.ByteString)
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: B.ByteString)
safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: B.ByteString)
safeFromSql SqlNull = nullConvertError (undefined :: B.ByteString)
instance ToSql BL.ByteString where
toSql b = SqlBlob $ BB.toByteString $ BB.fromLazyByteString b
instance FromSql BL.ByteString where
safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: BL.ByteString)
safeFromSql (SqlInteger i) = incompatibleTypes i (undefined :: BL.ByteString)
safeFromSql (SqlDouble d) = incompatibleTypes d (undefined :: BL.ByteString)
safeFromSql (SqlText t) = incompatibleTypes t (undefined :: BL.ByteString)
safeFromSql (SqlBlob b) = Right $ BL.fromChunks [b]
safeFromSql (SqlBool b) = incompatibleTypes b (undefined :: BL.ByteString)
safeFromSql (SqlBitField bf) = incompatibleTypes bf (undefined :: BL.ByteString)
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: BL.ByteString)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: BL.ByteString)
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: BL.ByteString)
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: BL.ByteString)
safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: BL.ByteString)
safeFromSql SqlNull = nullConvertError (undefined :: BL.ByteString)
instance ToSql Bool where
toSql = SqlBool
instance FromSql Bool where
safeFromSql (SqlDecimal d) = Right $ d /= 0
safeFromSql (SqlInteger i) = Right $ i /= 0
safeFromSql (SqlDouble d) = Right $ d /= 0
safeFromSql (SqlText t) = case TL.toLower t of
"t" -> Right True
"true" -> Right True
"1" -> Right True
"f" -> Right False
"false" -> Right False
"0" -> Right False
_ -> Left $ ConvertError
$ "Could not convert string \"" ++ (show t) ++ "\" to Bool"
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: Bool)
safeFromSql (SqlBool b) = Right b
safeFromSql (SqlBitField bf) = Right $ bf /= 0
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: Bool)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: Bool)
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: Bool)
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Bool)
safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Bool)
safeFromSql SqlNull = nullConvertError (undefined :: Bool)
instance ToSql BitField where
toSql = SqlBitField
instance FromSql BitField where
safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: BitField)
safeFromSql (SqlInteger i) = BitField <$> convertToBounded i
safeFromSql (SqlDouble d) = incompatibleTypes d (undefined :: BitField)
safeFromSql (SqlText t) = BitField <$> tryParse t parseBitField
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: BitField)
safeFromSql (SqlBool b) = Right $ BitField $ if b then 1 else 0
safeFromSql (SqlBitField bf) = Right bf
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: BitField)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: BitField)
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: BitField)
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: BitField)
safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: BitField)
safeFromSql SqlNull = nullConvertError (undefined :: BitField)
instance ToSql UUID where
toSql = SqlUUID
instance FromSql UUID where
safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: UUID)
safeFromSql (SqlInteger i) = incompatibleTypes i (undefined :: UUID)
safeFromSql (SqlDouble d) = incompatibleTypes d (undefined :: UUID)
safeFromSql (SqlText t) = case fromString $ TL.unpack t of
Nothing -> Left $ ConvertError $ "Could not convert \"" ++ (show t) ++ "\" to UUID"
Just u -> Right u
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: UUID)
safeFromSql (SqlBool b) = incompatibleTypes b (undefined :: UUID)
safeFromSql (SqlBitField bf) = incompatibleTypes bf (undefined :: UUID)
safeFromSql (SqlUUID u) = Right u
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: UUID)
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: UUID)
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: UUID)
safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: UUID)
safeFromSql SqlNull = nullConvertError (undefined :: UUID)
instance ToSql UTCTime where
toSql = SqlUTCTime
instance FromSql UTCTime where
safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: UTCTime)
safeFromSql (SqlInteger i) = incompatibleTypes i (undefined :: UTCTime)
safeFromSql (SqlDouble d) = incompatibleTypes d (undefined :: UTCTime)
safeFromSql (SqlText t) = zonedTimeToUTC <$> tryParse t parseIsoZonedTime
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: UTCTime)
safeFromSql (SqlBool b) = incompatibleTypes b (undefined :: UTCTime)
safeFromSql (SqlBitField bf) = incompatibleTypes bf (undefined :: UTCTime)
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: UTCTime)
safeFromSql (SqlUTCTime ut) = Right ut
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: UTCTime)
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: UTCTime)
safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: UTCTime)
safeFromSql SqlNull = nullConvertError (undefined :: UTCTime)
instance ToSql Day where
toSql = SqlLocalDate
instance FromSql Day where
safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: Day)
safeFromSql (SqlInteger i) = incompatibleTypes i (undefined :: Day)
safeFromSql (SqlDouble d) = incompatibleTypes d (undefined :: Day)
safeFromSql (SqlText t) = tryParse t parseIsoDay
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: Day)
safeFromSql (SqlBool b) = incompatibleTypes b (undefined :: Day)
safeFromSql (SqlBitField bf) = incompatibleTypes bf (undefined :: Day)
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: Day)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: Day)
safeFromSql (SqlLocalDate ld) = Right $ ld
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Day)
safeFromSql (SqlLocalTime lt) = Right $ localDay lt
safeFromSql SqlNull = nullConvertError (undefined :: Day)
instance ToSql TimeOfDay where
toSql = SqlLocalTimeOfDay
instance FromSql TimeOfDay where
safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: TimeOfDay)
safeFromSql (SqlInteger i) = incompatibleTypes i (undefined :: TimeOfDay)
safeFromSql (SqlDouble d) = incompatibleTypes d (undefined :: TimeOfDay)
safeFromSql (SqlText t) = tryParse t parseIsoTimeOfDay
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: TimeOfDay)
safeFromSql (SqlBool b) = incompatibleTypes b (undefined :: TimeOfDay)
safeFromSql (SqlBitField bf) = incompatibleTypes bf (undefined :: TimeOfDay)
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: TimeOfDay)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: TimeOfDay)
safeFromSql (SqlLocalDate ld) = incompatibleTypes ld (undefined :: TimeOfDay)
safeFromSql (SqlLocalTimeOfDay tod) = Right $ tod
safeFromSql (SqlLocalTime lt) = Right $ localTimeOfDay lt
safeFromSql SqlNull = nullConvertError (undefined :: TimeOfDay)
instance ToSql LocalTime where
toSql = SqlLocalTime
instance FromSql LocalTime where
safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: LocalTime)
safeFromSql (SqlInteger i) = incompatibleTypes i (undefined :: LocalTime)
safeFromSql (SqlDouble d) = incompatibleTypes d (undefined :: LocalTime)
safeFromSql (SqlText t) = tryParse t parseIsoLocalTime
safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: LocalTime)
safeFromSql (SqlBool b) = incompatibleTypes b (undefined :: LocalTime)
safeFromSql (SqlBitField bf) = incompatibleTypes bf (undefined :: LocalTime)
safeFromSql (SqlUUID u) = incompatibleTypes u (undefined :: LocalTime)
safeFromSql (SqlUTCTime ut) = incompatibleTypes ut (undefined :: LocalTime)
safeFromSql (SqlLocalDate ld) = Right $ LocalTime ld midnight
safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: LocalTime)
safeFromSql (SqlLocalTime lt) = Right $ lt
safeFromSql SqlNull = nullConvertError (undefined :: LocalTime)
instance (ToSql a) => ToSql (Maybe a) where
toSql m = case m of
Nothing -> SqlNull
Just a -> toSql a
instance (FromSql a) => FromSql (Maybe a) where
safeFromSql SqlNull = Right Nothing
safeFromSql x = Just <$> safeFromSql x
instance ToSql SqlValue where
toSql = id
instance FromSql SqlValue where
safeFromSql x = Right x
fromSql = id