{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
module Database.HDBC.SqlValue
(
SqlValue(..),
safeFromSql, toSql, fromSql,
nToSql, iToSql, posixToSql
)
where
import Data.Dynamic
import qualified Data.ByteString.UTF8 as BUTF8
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BSL
import Data.Char(ord,toUpper)
import Data.Word
import Data.Int
import qualified System.Time as ST
import Data.Time ( Day (ModifiedJulianDay), DiffTime, LocalTime, NominalDiffTime, ParseTime
, TimeOfDay, TimeZone, UTCTime, ZonedTime, formatTime, localDay, localTimeOfDay
, timeOfDayToTime, timeToTimeOfDay, toModifiedJulianDay, utc
, utcToZonedTime, zonedTimeToLocalTime, zonedTimeToUTC, zonedTimeZone
#if MIN_TIME_15
, parseTimeM
#else
, parseTime
#endif
)
import Data.Time.Clock.POSIX
import Database.HDBC.Locale (defaultTimeLocale, iso8601DateFormat)
import Data.Ratio
import Data.Convertible
import Data.Fixed
import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL
quickError :: (Typeable a, Convertible SqlValue a) => SqlValue -> ConvertResult a
quickError sv = convError "incompatible types" sv
toSql :: Convertible a SqlValue => a -> SqlValue
toSql = convert
safeFromSql :: Convertible SqlValue a => SqlValue -> ConvertResult a
safeFromSql = safeConvert
fromSql :: Convertible SqlValue a => SqlValue -> a
fromSql = convert
nToSql :: Integral a => a -> SqlValue
nToSql n = SqlInteger (toInteger n)
iToSql :: Int -> SqlValue
iToSql = toSql
posixToSql :: POSIXTime -> SqlValue
posixToSql x = SqlPOSIXTime x
data SqlValue = SqlString String
| SqlByteString B.ByteString
| SqlWord32 Word32
| SqlWord64 Word64
| SqlInt32 Int32
| SqlInt64 Int64
| SqlInteger Integer
| SqlChar Char
| SqlBool Bool
| SqlDouble Double
| SqlRational Rational
| SqlLocalDate Day
| SqlLocalTimeOfDay TimeOfDay
| SqlZonedLocalTimeOfDay TimeOfDay TimeZone
| SqlLocalTime LocalTime
| SqlZonedTime ZonedTime
| SqlUTCTime UTCTime
| SqlDiffTime NominalDiffTime
| SqlPOSIXTime POSIXTime
| SqlEpochTime Integer
| SqlTimeDiff Integer
| SqlNull
deriving (Show, Typeable)
instance Eq SqlValue where
SqlString a == SqlString b = a == b
SqlByteString a == SqlByteString b = a == b
SqlWord32 a == SqlWord32 b = a == b
SqlWord64 a == SqlWord64 b = a == b
SqlInt32 a == SqlInt32 b = a == b
SqlInt64 a == SqlInt64 b = a == b
SqlInteger a == SqlInteger b = a == b
SqlChar a == SqlChar b = a == b
SqlBool a == SqlBool b = a == b
SqlDouble a == SqlDouble b = a == b
SqlRational a == SqlRational b = a == b
SqlLocalTimeOfDay a == SqlLocalTimeOfDay b = a == b
SqlZonedLocalTimeOfDay a b == SqlZonedLocalTimeOfDay c d = a == c && b == d
SqlLocalTime a == SqlLocalTime b = a == b
SqlLocalDate a == SqlLocalDate b = a == b
SqlZonedTime a == SqlZonedTime b = zonedTimeToUTC a == zonedTimeToUTC b
SqlUTCTime a == SqlUTCTime b = a == b
SqlPOSIXTime a == SqlPOSIXTime b = a == b
SqlDiffTime a == SqlDiffTime b = a == b
SqlEpochTime a == SqlEpochTime b = a == b
SqlTimeDiff a == SqlTimeDiff b = a == b
SqlNull == SqlNull = True
SqlNull == _ = False
_ == SqlNull = False
a == b = ((safeFromSql a)::ConvertResult String) ==
((safeFromSql b)::ConvertResult String)
deriving instance Typeable ST.ClockTime
deriving instance Typeable ST.TimeDiff
instance Convertible SqlValue SqlValue where
safeConvert = return
instance Convertible String SqlValue where
safeConvert = return . SqlString
instance Convertible SqlValue String where
safeConvert (SqlString x) = return x
safeConvert (SqlByteString x) = return . BUTF8.toString $ x
safeConvert (SqlInt32 x) = return . show $ x
safeConvert (SqlInt64 x) = return . show $ x
safeConvert (SqlWord32 x) = return . show $ x
safeConvert (SqlWord64 x) = return . show $ x
safeConvert (SqlInteger x) = return . show $ x
safeConvert (SqlChar x) = return [x]
safeConvert (SqlBool x) = return . show $ x
safeConvert (SqlDouble x) = return . show $ x
safeConvert (SqlRational x) = return . show $ x
safeConvert (SqlLocalDate x) =
return . formatTime defaultTimeLocale (iso8601DateFormat Nothing) $ x
safeConvert (SqlLocalTimeOfDay x) =
return . formatTime defaultTimeLocale "%T%Q" $ x
safeConvert (SqlZonedLocalTimeOfDay tod tz) =
return $ formatTime defaultTimeLocale "%T%Q " tod ++
formatTime defaultTimeLocale "%z" tz
safeConvert (SqlLocalTime x) =
return . formatTime defaultTimeLocale (iso8601DateFormat (Just "%T%Q")) $ x
safeConvert (SqlZonedTime x) =
return . formatTime defaultTimeLocale (iso8601DateFormat (Just "%T%Q %z")) $ x
safeConvert (SqlUTCTime x) =
return . formatTime defaultTimeLocale (iso8601DateFormat (Just "%T%Q")) $ x
safeConvert (SqlDiffTime x) = return $ showFixed True fixedval
where fixedval :: Pico
fixedval = fromRational . toRational $ x
safeConvert (SqlPOSIXTime x) = return $ showFixed True fixedval
where fixedval :: Pico
fixedval = fromRational . toRational $ x
safeConvert (SqlEpochTime x) = return . show $ x
safeConvert (SqlTimeDiff x) = return . show $ x
safeConvert y@(SqlNull) = quickError y
instance Convertible TS.Text SqlValue where
safeConvert = return . SqlString . TS.unpack
instance Convertible SqlValue TS.Text where
safeConvert = fmap TS.pack . safeConvert
instance Convertible TL.Text SqlValue where
safeConvert = return . SqlString . TL.unpack
instance Convertible SqlValue TL.Text where
safeConvert = fmap TL.pack . safeConvert
#ifdef __HUGS__
instance Typeable B.ByteString where
typeOf _ = mkTypeName "ByteString"
#endif
instance Convertible B.ByteString SqlValue where
safeConvert = return . SqlByteString
instance Convertible SqlValue B.ByteString where
safeConvert (SqlByteString x) = return x
safeConvert y@(SqlNull) = quickError y
safeConvert x = safeConvert x >>= return . BUTF8.fromString
instance Convertible BSL.ByteString SqlValue where
safeConvert = return . SqlByteString . B.concat . BSL.toChunks
instance Convertible SqlValue BSL.ByteString where
safeConvert x = do bs <- safeConvert x
return (BSL.fromChunks [bs])
instance Convertible Int SqlValue where
safeConvert x =
do i <- ((safeConvert x)::ConvertResult Int64)
return $ SqlInt64 i
instance Convertible SqlValue Int where
safeConvert (SqlString x) = read' x
safeConvert (SqlByteString x) = (read' . BUTF8.toString) x
safeConvert (SqlInt32 x) = safeConvert x
safeConvert (SqlInt64 x) = safeConvert x
safeConvert (SqlWord32 x) = safeConvert x
safeConvert (SqlWord64 x) = safeConvert x
safeConvert (SqlInteger x) = safeConvert x
safeConvert (SqlChar x) = safeConvert x
safeConvert (SqlBool x) = return (if x then 1 else 0)
safeConvert (SqlDouble x) = safeConvert x
safeConvert (SqlRational x) = safeConvert x
safeConvert y@(SqlLocalDate _) = viaInteger y fromIntegral
safeConvert y@(SqlLocalTimeOfDay _) = viaInteger y fromIntegral
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert y@(SqlLocalTime _) = viaInteger y fromIntegral
safeConvert y@(SqlZonedTime _) = viaInteger y fromIntegral
safeConvert (SqlUTCTime x) = safeConvert x
safeConvert (SqlDiffTime x) = safeConvert x
safeConvert (SqlPOSIXTime x) = safeConvert x
safeConvert (SqlEpochTime x) = safeConvert x
safeConvert (SqlTimeDiff x) = safeConvert x
safeConvert y@(SqlNull) = quickError y
instance Convertible Int32 SqlValue where
safeConvert = return . SqlInt32
instance Convertible SqlValue Int32 where
safeConvert (SqlString x) = read' x
safeConvert (SqlByteString x) = (read' . BUTF8.toString) x
safeConvert (SqlInt32 x) = return x
safeConvert (SqlInt64 x) = safeConvert x
safeConvert (SqlWord32 x) = safeConvert x
safeConvert (SqlWord64 x) = safeConvert x
safeConvert (SqlInteger x) = safeConvert x
safeConvert (SqlChar x) = safeConvert x
safeConvert (SqlBool x) = return (if x then 1 else 0)
safeConvert (SqlDouble x) = safeConvert x
safeConvert (SqlRational x) = safeConvert x
safeConvert y@(SqlLocalDate _) = viaInteger y fromIntegral
safeConvert y@(SqlLocalTimeOfDay _) = viaInteger y fromIntegral
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert y@(SqlLocalTime _) = viaInteger y fromIntegral
safeConvert y@(SqlZonedTime _) = viaInteger y fromIntegral
safeConvert y@(SqlUTCTime _) = viaInteger y fromIntegral
safeConvert y@(SqlDiffTime _) = viaInteger y fromIntegral
safeConvert y@(SqlPOSIXTime _) = viaInteger y fromIntegral
safeConvert (SqlEpochTime x) = safeConvert x
safeConvert (SqlTimeDiff x) = safeConvert x
safeConvert y@(SqlNull) = quickError y
instance Convertible Int64 SqlValue where
safeConvert = return . SqlInt64
instance Convertible SqlValue Int64 where
safeConvert (SqlString x) = read' x
safeConvert (SqlByteString x) = (read' . BUTF8.toString) x
safeConvert (SqlInt32 x) = safeConvert x
safeConvert (SqlInt64 x) = return x
safeConvert (SqlWord32 x) = safeConvert x
safeConvert (SqlWord64 x) = safeConvert x
safeConvert (SqlInteger x) = safeConvert x
safeConvert (SqlChar x) = safeConvert x
safeConvert (SqlBool x) = return (if x then 1 else 0)
safeConvert (SqlDouble x) = safeConvert x
safeConvert (SqlRational x) = safeConvert x
safeConvert y@(SqlLocalDate _) = viaInteger y fromIntegral
safeConvert y@(SqlLocalTimeOfDay _) = viaInteger y fromIntegral
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert y@(SqlLocalTime _) = viaInteger y fromIntegral
safeConvert y@(SqlZonedTime _) = viaInteger y fromIntegral
safeConvert y@(SqlUTCTime _) = viaInteger y fromIntegral
safeConvert y@(SqlDiffTime _) = viaInteger y fromIntegral
safeConvert y@(SqlPOSIXTime _) = viaInteger y fromIntegral
safeConvert (SqlEpochTime x) = safeConvert x
safeConvert (SqlTimeDiff x) = safeConvert x
safeConvert y@(SqlNull) = quickError y
instance Convertible Word32 SqlValue where
safeConvert = return . SqlWord32
instance Convertible SqlValue Word32 where
safeConvert (SqlString x) = read' x
safeConvert (SqlByteString x) = (read' . BUTF8.toString) x
safeConvert (SqlInt32 x) = safeConvert x
safeConvert (SqlInt64 x) = safeConvert x
safeConvert (SqlWord32 x) = return x
safeConvert (SqlWord64 x) = safeConvert x
safeConvert (SqlInteger x) = safeConvert x
safeConvert (SqlChar x) = safeConvert x
safeConvert (SqlBool x) = return (if x then 1 else 0)
safeConvert (SqlDouble x) = safeConvert x
safeConvert (SqlRational x) = safeConvert x
safeConvert y@(SqlLocalDate _) = viaInteger y fromIntegral
safeConvert y@(SqlLocalTimeOfDay _) = viaInteger y fromIntegral
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert y@(SqlLocalTime _) = viaInteger y fromIntegral
safeConvert y@(SqlZonedTime _) = viaInteger y fromIntegral
safeConvert y@(SqlUTCTime _) = viaInteger y fromIntegral
safeConvert y@(SqlDiffTime _) = viaInteger y fromIntegral
safeConvert y@(SqlPOSIXTime _) = viaInteger y fromIntegral
safeConvert (SqlEpochTime x) = safeConvert x
safeConvert (SqlTimeDiff x) = safeConvert x
safeConvert y@(SqlNull) = quickError y
instance Convertible Word64 SqlValue where
safeConvert = return . SqlWord64
instance Convertible SqlValue Word64 where
safeConvert (SqlString x) = read' x
safeConvert (SqlByteString x) = (read' . BUTF8.toString) x
safeConvert (SqlInt32 x) = safeConvert x
safeConvert (SqlInt64 x) = safeConvert x
safeConvert (SqlWord32 x) = safeConvert x
safeConvert (SqlWord64 x) = return x
safeConvert (SqlInteger x) = safeConvert x
safeConvert (SqlChar x) = safeConvert x
safeConvert (SqlBool x) = return (if x then 1 else 0)
safeConvert (SqlDouble x) = safeConvert x
safeConvert (SqlRational x) = safeConvert x
safeConvert y@(SqlLocalDate _) = viaInteger y fromIntegral
safeConvert y@(SqlLocalTimeOfDay _) = viaInteger y fromIntegral
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert y@(SqlLocalTime _) = viaInteger y fromIntegral
safeConvert y@(SqlZonedTime _) = viaInteger y fromIntegral
safeConvert y@(SqlUTCTime _) = viaInteger y fromIntegral
safeConvert y@(SqlDiffTime _) = viaInteger y fromIntegral
safeConvert y@(SqlPOSIXTime _) = viaInteger y fromIntegral
safeConvert (SqlEpochTime x) = safeConvert x
safeConvert (SqlTimeDiff x) = safeConvert x
safeConvert y@(SqlNull) = quickError y
instance Convertible Integer SqlValue where
safeConvert = return . SqlInteger
instance Convertible SqlValue Integer where
safeConvert (SqlString x) = read' x
safeConvert (SqlByteString x) = (read' . BUTF8.toString) x
safeConvert (SqlInt32 x) = safeConvert x
safeConvert (SqlInt64 x) = safeConvert x
safeConvert (SqlWord32 x) = safeConvert x
safeConvert (SqlWord64 x) = safeConvert x
safeConvert (SqlInteger x) = return x
safeConvert (SqlChar x) = safeConvert x
safeConvert (SqlBool x) = return (if x then 1 else 0)
safeConvert (SqlDouble x) = safeConvert x
safeConvert (SqlRational x) = safeConvert x
safeConvert (SqlLocalDate x) = return . toModifiedJulianDay $ x
safeConvert (SqlLocalTimeOfDay x) =
return . fromIntegral . fromEnum . timeOfDayToTime $ x
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert y@(SqlLocalTime _) = quickError y
safeConvert (SqlZonedTime x) =
return . truncate . utcTimeToPOSIXSeconds . zonedTimeToUTC $ x
safeConvert (SqlUTCTime x) = safeConvert x
safeConvert (SqlDiffTime x) = safeConvert x
safeConvert (SqlPOSIXTime x) = safeConvert x
safeConvert (SqlEpochTime x) = return x
safeConvert (SqlTimeDiff x) = return x
safeConvert y@(SqlNull) = quickError y
instance Convertible Bool SqlValue where
safeConvert = return . SqlBool
instance Convertible SqlValue Bool where
safeConvert y@(SqlString x) =
case map toUpper x of
"TRUE" -> Right True
"T" -> Right True
"FALSE" -> Right False
"F" -> Right False
"0" -> Right False
"1" -> Right True
_ -> convError "Cannot parse given String as Bool" y
safeConvert (SqlByteString x) = (safeConvert . SqlString . BUTF8.toString) x
safeConvert (SqlInt32 x) = numToBool x
safeConvert (SqlInt64 x) = numToBool x
safeConvert (SqlWord32 x) = numToBool x
safeConvert (SqlWord64 x) = numToBool x
safeConvert (SqlInteger x) = numToBool x
safeConvert (SqlChar x) = numToBool (ord x)
safeConvert (SqlBool x) = return x
safeConvert (SqlDouble x) = numToBool x
safeConvert (SqlRational x) = numToBool x
safeConvert y@(SqlLocalDate _) = quickError y
safeConvert y@(SqlLocalTimeOfDay _) = quickError y
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert y@(SqlLocalTime _) = quickError y
safeConvert y@(SqlZonedTime _) = quickError y
safeConvert y@(SqlUTCTime _) = quickError y
safeConvert y@(SqlDiffTime _) = quickError y
safeConvert y@(SqlPOSIXTime _) = quickError y
safeConvert (SqlEpochTime x) = numToBool x
safeConvert (SqlTimeDiff x) = numToBool x
safeConvert y@(SqlNull) = quickError y
numToBool :: (Eq a, Num a) => a -> ConvertResult Bool
numToBool x = Right (x /= 0)
instance Convertible Char SqlValue where
safeConvert = return . SqlChar
instance Convertible SqlValue Char where
safeConvert (SqlString [x]) = return x
safeConvert y@(SqlString _) = convError "String length /= 1" y
safeConvert (SqlByteString x) =
safeConvert . SqlString . BUTF8.toString $ x
safeConvert y@(SqlInt32 _) = quickError y
safeConvert y@(SqlInt64 _) = quickError y
safeConvert y@(SqlWord32 _) = quickError y
safeConvert y@(SqlWord64 _) = quickError y
safeConvert y@(SqlInteger _) = quickError y
safeConvert (SqlChar x) = return x
safeConvert (SqlBool x) = return (if x then '1' else '0')
safeConvert y@(SqlDouble _) = quickError y
safeConvert y@(SqlRational _) = quickError y
safeConvert y@(SqlLocalDate _) = quickError y
safeConvert y@(SqlLocalTimeOfDay _) = quickError y
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert y@(SqlLocalTime _) = quickError y
safeConvert y@(SqlZonedTime _) = quickError y
safeConvert y@(SqlUTCTime _) = quickError y
safeConvert y@(SqlDiffTime _) = quickError y
safeConvert y@(SqlPOSIXTime _) = quickError y
safeConvert y@(SqlEpochTime _) = quickError y
safeConvert y@(SqlTimeDiff _) = quickError y
safeConvert y@(SqlNull) = quickError y
instance Convertible Double SqlValue where
safeConvert = return . SqlDouble
instance Convertible SqlValue Double where
safeConvert (SqlString x) = read' x
safeConvert (SqlByteString x) = (read' . BUTF8.toString) x
safeConvert (SqlInt32 x) = safeConvert x
safeConvert (SqlInt64 x) = safeConvert x
safeConvert (SqlWord32 x) = safeConvert x
safeConvert (SqlWord64 x) = safeConvert x
safeConvert (SqlInteger x) = safeConvert x
safeConvert (SqlChar x) = return . fromIntegral . fromEnum $ x
safeConvert (SqlBool x) = return (if x then 1.0 else 0.0)
safeConvert (SqlDouble x) = return x
safeConvert (SqlRational x) = safeConvert x
safeConvert y@(SqlLocalDate _) = ((safeConvert y)::ConvertResult Integer) >>=
(return . fromIntegral)
safeConvert (SqlLocalTimeOfDay x) =
return . fromRational . toRational . timeOfDayToTime $ x
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert y@(SqlLocalTime _) = quickError y
safeConvert (SqlZonedTime x) =
safeConvert . SqlUTCTime . zonedTimeToUTC $ x
safeConvert (SqlUTCTime x) =
return . fromRational . toRational . utcTimeToPOSIXSeconds $ x
safeConvert (SqlDiffTime x) = safeConvert x
safeConvert (SqlPOSIXTime x) = safeConvert x
safeConvert (SqlEpochTime x) = safeConvert x
safeConvert (SqlTimeDiff x) = safeConvert x
safeConvert y@(SqlNull) = quickError y
instance Convertible Rational SqlValue where
safeConvert = return . SqlRational
instance Convertible SqlValue Rational where
safeConvert (SqlString x) = read' x
safeConvert (SqlByteString x) = (read' . BUTF8.toString) x
safeConvert (SqlInt32 x) = safeConvert x
safeConvert (SqlInt64 x) = safeConvert x
safeConvert (SqlWord32 x) = safeConvert x
safeConvert (SqlWord64 x) = safeConvert x
safeConvert (SqlInteger x) = safeConvert x
safeConvert (SqlChar x) = return . fromIntegral . fromEnum $ x
safeConvert (SqlBool x) = return $ if x then fromIntegral (1::Int)
else fromIntegral (0::Int)
safeConvert (SqlDouble x) = safeConvert x
safeConvert (SqlRational x) = return x
safeConvert y@(SqlLocalDate _) = ((safeConvert y)::ConvertResult Integer) >>=
(return . fromIntegral)
safeConvert (SqlLocalTimeOfDay x) = return . toRational . timeOfDayToTime $ x
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert y@(SqlLocalTime _) = quickError y
safeConvert (SqlZonedTime x) = safeConvert . SqlUTCTime . zonedTimeToUTC $ x
safeConvert (SqlUTCTime x) = safeConvert x
safeConvert (SqlDiffTime x) = safeConvert x
safeConvert (SqlPOSIXTime x) = safeConvert x
safeConvert (SqlEpochTime x) = return . fromIntegral $ x
safeConvert (SqlTimeDiff x) = return . fromIntegral $ x
safeConvert y@(SqlNull) = quickError y
instance Convertible Day SqlValue where
safeConvert = return . SqlLocalDate
instance Convertible SqlValue Day where
safeConvert (SqlString x) = parseTime' (iso8601DateFormat Nothing) x
safeConvert (SqlByteString x) = safeConvert (SqlString (BUTF8.toString x))
safeConvert (SqlInt32 x) =
return $ ModifiedJulianDay {toModifiedJulianDay = fromIntegral x}
safeConvert (SqlInt64 x) =
return $ ModifiedJulianDay {toModifiedJulianDay = fromIntegral x}
safeConvert (SqlWord32 x) =
return $ ModifiedJulianDay {toModifiedJulianDay = fromIntegral x}
safeConvert (SqlWord64 x) =
return $ ModifiedJulianDay {toModifiedJulianDay = fromIntegral x}
safeConvert (SqlInteger x) =
return $ ModifiedJulianDay {toModifiedJulianDay = x}
safeConvert y@(SqlChar _) = quickError y
safeConvert y@(SqlBool _) = quickError y
safeConvert (SqlDouble x) =
return $ ModifiedJulianDay {toModifiedJulianDay = truncate x}
safeConvert (SqlRational x) = safeConvert . SqlDouble . fromRational $ x
safeConvert (SqlLocalDate x) = return x
safeConvert y@(SqlLocalTimeOfDay _) = quickError y
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert (SqlLocalTime x) = return . localDay $ x
safeConvert y@(SqlZonedTime _) = safeConvert y >>= return . localDay
safeConvert y@(SqlUTCTime _) = safeConvert y >>= return . localDay
safeConvert y@(SqlDiffTime _) = quickError y
safeConvert y@(SqlPOSIXTime _) = safeConvert y >>= return . localDay
safeConvert y@(SqlEpochTime _) = safeConvert y >>= return . localDay
safeConvert y@(SqlTimeDiff _) = quickError y
safeConvert y@(SqlNull) = quickError y
instance Convertible TimeOfDay SqlValue where
safeConvert = return . SqlLocalTimeOfDay
instance Convertible SqlValue TimeOfDay where
safeConvert (SqlString x) = parseTime' "%T%Q" x
safeConvert (SqlByteString x) = safeConvert (SqlString (BUTF8.toString x))
safeConvert (SqlInt32 x) = return . timeToTimeOfDay . fromIntegral $ x
safeConvert (SqlInt64 x) = return . timeToTimeOfDay . fromIntegral $ x
safeConvert (SqlWord32 x) = return . timeToTimeOfDay . fromIntegral $ x
safeConvert (SqlWord64 x) = return . timeToTimeOfDay . fromIntegral $ x
safeConvert (SqlInteger x) = return . timeToTimeOfDay . fromInteger $ x
safeConvert y@(SqlChar _) = quickError y
safeConvert y@(SqlBool _) = quickError y
safeConvert (SqlDouble x) =
return . timeToTimeOfDay . fromIntegral $ ((truncate x)::Integer)
safeConvert (SqlRational x) = safeConvert . SqlDouble . fromRational $ x
safeConvert y@(SqlLocalDate _) = quickError y
safeConvert (SqlLocalTimeOfDay x) = return x
safeConvert (SqlZonedLocalTimeOfDay tod _) = return tod
safeConvert (SqlLocalTime x) = return . localTimeOfDay $ x
safeConvert y@(SqlZonedTime _) = safeConvert y >>= return . localTimeOfDay
safeConvert y@(SqlUTCTime _) = safeConvert y >>= return . localTimeOfDay
safeConvert y@(SqlDiffTime _) = quickError y
safeConvert y@(SqlPOSIXTime _) = safeConvert y >>= return . localTimeOfDay
safeConvert y@(SqlEpochTime _) = safeConvert y >>= return . localTimeOfDay
safeConvert y@(SqlTimeDiff _) = quickError y
safeConvert y@SqlNull = quickError y
instance Convertible (TimeOfDay, TimeZone) SqlValue where
safeConvert (tod, tz) = return (SqlZonedLocalTimeOfDay tod tz)
instance Convertible SqlValue (TimeOfDay, TimeZone) where
safeConvert (SqlString x) =
do tod <- parseTime' "%T%Q %z" x
#if MIN_TIME_15
tz <- case parseTimeM True defaultTimeLocale "%T%Q %z" x of
#else
tz <- case parseTime defaultTimeLocale "%T%Q %z" x of
#endif
Nothing -> convError "Couldn't extract timezone in" (SqlString x)
Just y -> Right y
return (tod, tz)
safeConvert (SqlByteString x) = safeConvert (SqlString (BUTF8.toString x))
safeConvert y@(SqlInt32 _) = quickError y
safeConvert y@(SqlInt64 _) = quickError y
safeConvert y@(SqlWord32 _) = quickError y
safeConvert y@(SqlWord64 _) = quickError y
safeConvert y@(SqlInteger _) = quickError y
safeConvert y@(SqlChar _) = quickError y
safeConvert y@(SqlBool _) = quickError y
safeConvert y@(SqlDouble _) = quickError y
safeConvert y@(SqlRational _) = quickError y
safeConvert y@(SqlLocalDate _) = quickError y
safeConvert y@(SqlLocalTimeOfDay _) = quickError y
safeConvert (SqlZonedLocalTimeOfDay x y) = return (x, y)
safeConvert y@(SqlLocalTime _) = quickError y
safeConvert (SqlZonedTime x) = return (localTimeOfDay . zonedTimeToLocalTime $ x,
zonedTimeZone x)
safeConvert y@(SqlUTCTime _) = quickError y
safeConvert y@(SqlDiffTime _) = quickError y
safeConvert y@(SqlPOSIXTime _) = quickError y
safeConvert y@(SqlEpochTime _) = quickError y
safeConvert y@(SqlTimeDiff _) = quickError y
safeConvert y@SqlNull = quickError y
instance Convertible LocalTime SqlValue where
safeConvert = return . SqlLocalTime
instance Convertible SqlValue LocalTime where
safeConvert (SqlString x) = parseTime' (iso8601DateFormat (Just "%T%Q")) x
safeConvert (SqlByteString x) = safeConvert (SqlString (BUTF8.toString x))
safeConvert y@(SqlInt32 _) = quickError y
safeConvert y@(SqlInt64 _) = quickError y
safeConvert y@(SqlWord32 _) = quickError y
safeConvert y@(SqlWord64 _) = quickError y
safeConvert y@(SqlInteger _) = quickError y
safeConvert y@(SqlChar _) = quickError y
safeConvert y@(SqlBool _) = quickError y
safeConvert y@(SqlDouble _) = quickError y
safeConvert y@(SqlRational _) = quickError y
safeConvert y@(SqlLocalDate _) = quickError y
safeConvert y@(SqlLocalTimeOfDay _) = quickError y
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert (SqlLocalTime x) = return x
safeConvert (SqlZonedTime x) = return . zonedTimeToLocalTime $ x
safeConvert y@(SqlUTCTime _) = safeConvert y >>= return . zonedTimeToLocalTime
safeConvert y@(SqlDiffTime _) = quickError y
safeConvert y@(SqlPOSIXTime _) = safeConvert y >>= return . zonedTimeToLocalTime
safeConvert y@(SqlEpochTime _) = safeConvert y >>= return . zonedTimeToLocalTime
safeConvert y@(SqlTimeDiff _) = quickError y
safeConvert y@SqlNull = quickError y
instance Convertible ZonedTime SqlValue where
safeConvert = return . SqlZonedTime
instance Convertible SqlValue ZonedTime where
safeConvert (SqlString x) = parseTime' (iso8601DateFormat (Just "%T%Q %z")) x
safeConvert (SqlByteString x) = safeConvert (SqlString (BUTF8.toString x))
safeConvert (SqlInt32 x) = safeConvert (SqlInteger (fromIntegral x))
safeConvert (SqlInt64 x) = safeConvert (SqlInteger (fromIntegral x))
safeConvert (SqlWord32 x) = safeConvert (SqlInteger (fromIntegral x))
safeConvert (SqlWord64 x) = safeConvert (SqlInteger (fromIntegral x))
safeConvert y@(SqlInteger _) = safeConvert y >>= return . utcToZonedTime utc
safeConvert y@(SqlChar _) = quickError y
safeConvert y@(SqlBool _) = quickError y
safeConvert y@(SqlDouble _) = safeConvert y >>= return . utcToZonedTime utc
safeConvert y@(SqlRational _) = safeConvert y >>= return . utcToZonedTime utc
safeConvert y@(SqlLocalDate _) = quickError y
safeConvert y@(SqlLocalTime _) = quickError y
safeConvert y@(SqlLocalTimeOfDay _) = quickError y
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert (SqlZonedTime x) = return x
safeConvert (SqlUTCTime x) = return . utcToZonedTime utc $ x
safeConvert y@(SqlDiffTime _) = quickError y
safeConvert y@(SqlPOSIXTime _) = safeConvert y >>= return . utcToZonedTime utc
safeConvert y@(SqlEpochTime _) = safeConvert y >>= return . utcToZonedTime utc
safeConvert y@(SqlTimeDiff _) = quickError y
safeConvert y@SqlNull = quickError y
instance Convertible UTCTime SqlValue where
safeConvert = return . SqlUTCTime
instance Convertible SqlValue UTCTime where
safeConvert (SqlString x) = parseTime' (iso8601DateFormat (Just "%T%Q")) x
safeConvert (SqlByteString x) = safeConvert (SqlString (BUTF8.toString x))
safeConvert y@(SqlInt32 _) = safeConvert y >>= return . posixSecondsToUTCTime
safeConvert y@(SqlInt64 _) = safeConvert y >>= return . posixSecondsToUTCTime
safeConvert y@(SqlWord32 _) = safeConvert y >>= return . posixSecondsToUTCTime
safeConvert y@(SqlWord64 _) = safeConvert y >>= return . posixSecondsToUTCTime
safeConvert y@(SqlInteger _) = safeConvert y >>= return . posixSecondsToUTCTime
safeConvert y@(SqlChar _) = quickError y
safeConvert y@(SqlBool _) = quickError y
safeConvert y@(SqlDouble _) = safeConvert y >>= return . posixSecondsToUTCTime
safeConvert y@(SqlRational _) = safeConvert y >>= return . posixSecondsToUTCTime
safeConvert y@(SqlLocalDate _) = quickError y
safeConvert y@(SqlLocalTimeOfDay _) = quickError y
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert y@(SqlLocalTime _) = quickError y
safeConvert (SqlZonedTime x) = return . zonedTimeToUTC $ x
safeConvert (SqlUTCTime x) = return x
safeConvert y@(SqlDiffTime _) = convError "incompatible types (did you mean SqlPOSIXTime?)" y
safeConvert (SqlPOSIXTime x) = return . posixSecondsToUTCTime $ x
safeConvert y@(SqlEpochTime _) = safeConvert y >>= return . posixSecondsToUTCTime
safeConvert y@(SqlTimeDiff _) = convError "incompatible types (did you mean SqlPOSIXTime?)" y
safeConvert y@SqlNull = quickError y
stringToPico :: String -> ConvertResult Pico
stringToPico s =
let (base, fracwithdot) = span (/= '.') s
shortfrac = drop 1 fracwithdot
frac = take 12 (rpad 12 '0' shortfrac)
rpad :: Int -> a -> [a] -> [a]
rpad n c xs = xs ++ replicate (n - length xs) c
mkPico :: Integer -> Integer -> Pico
mkPico i f = fromInteger i + fromRational (f % 1000000000000)
in do parsedBase <- read' base
parsedFrac <- read' frac
return (mkPico parsedBase parsedFrac)
instance Convertible NominalDiffTime SqlValue where
safeConvert = return . SqlDiffTime
instance Convertible SqlValue NominalDiffTime where
safeConvert (SqlString x) = stringToPico x >>=
return . realToFrac
safeConvert (SqlByteString x) = (stringToPico (BUTF8.toString x)) >>=
return . realToFrac
safeConvert (SqlInt32 x) = return . fromIntegral $ x
safeConvert (SqlInt64 x) = return . fromIntegral $ x
safeConvert (SqlWord32 x) = return . fromIntegral $ x
safeConvert (SqlWord64 x) = return . fromIntegral $ x
safeConvert (SqlInteger x) = return . fromIntegral $ x
safeConvert y@(SqlChar _) = quickError y
safeConvert y@(SqlBool _) = quickError y
safeConvert (SqlDouble x) = return . fromRational . toRational $ x
safeConvert (SqlRational x) = return . fromRational $ x
safeConvert (SqlLocalDate x) = return . fromIntegral . (\y -> y * 60 * 60 * 24) .
toModifiedJulianDay $ x
safeConvert (SqlLocalTimeOfDay x) =
return . fromRational . toRational . timeOfDayToTime $ x
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert y@(SqlLocalTime _) = quickError y
safeConvert (SqlZonedTime x) = return . utcTimeToPOSIXSeconds . zonedTimeToUTC $ x
safeConvert (SqlUTCTime x) = return . utcTimeToPOSIXSeconds $ x
safeConvert (SqlDiffTime x) = return x
safeConvert (SqlPOSIXTime x) = return x
safeConvert (SqlEpochTime x) = return . fromIntegral $ x
safeConvert (SqlTimeDiff x) = return . fromIntegral $ x
safeConvert y@SqlNull = quickError y
instance Convertible ST.ClockTime SqlValue where
safeConvert x = safeConvert x >>= return . SqlPOSIXTime
instance Convertible SqlValue ST.ClockTime where
safeConvert (SqlString x) = do r <- read' x
return $ ST.TOD r 0
safeConvert (SqlByteString x) = safeConvert . SqlString . BUTF8.toString $ x
safeConvert (SqlInt32 x) = return $ ST.TOD (fromIntegral x) 0
safeConvert (SqlInt64 x) = return $ ST.TOD (fromIntegral x) 0
safeConvert (SqlWord32 x) = return $ ST.TOD (fromIntegral x) 0
safeConvert (SqlWord64 x) = return $ ST.TOD (fromIntegral x) 0
safeConvert (SqlInteger x) = return $ ST.TOD x 0
safeConvert y@(SqlChar _) = quickError y
safeConvert y@(SqlBool _) = quickError y
safeConvert (SqlDouble x) = return $ ST.TOD (truncate x) 0
safeConvert (SqlRational x) = return $ ST.TOD (truncate x) 0
safeConvert y@(SqlLocalDate _) = quickError y
safeConvert y@(SqlLocalTimeOfDay _) = quickError y
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert y@(SqlLocalTime _) = quickError y
safeConvert y@(SqlZonedTime _) = safeConvert y >>= (\z -> return $ ST.TOD z 0)
safeConvert y@(SqlUTCTime _) = safeConvert y >>= (\z -> return $ ST.TOD z 0)
safeConvert y@(SqlDiffTime _) = quickError y
safeConvert y@(SqlPOSIXTime _) = safeConvert y >>= (\z -> return $ ST.TOD z 0)
safeConvert (SqlEpochTime x) = return $ ST.TOD x 0
safeConvert y@(SqlTimeDiff _) = quickError y
safeConvert y@SqlNull = quickError y
instance Convertible ST.TimeDiff SqlValue where
safeConvert x = safeConvert x >>= return . SqlDiffTime
instance Convertible SqlValue ST.TimeDiff where
safeConvert y@(SqlString _) =
do r <- safeConvert y
safeConvert (SqlDiffTime r)
safeConvert (SqlByteString x) = safeConvert . SqlString . BUTF8.toString $ x
safeConvert (SqlInt32 x) = secs2td (fromIntegral x)
safeConvert (SqlInt64 x) = secs2td (fromIntegral x)
safeConvert (SqlWord32 x) = secs2td (fromIntegral x)
safeConvert (SqlWord64 x) = secs2td (fromIntegral x)
safeConvert (SqlInteger x) = secs2td x
safeConvert y@(SqlChar _) = quickError y
safeConvert y@(SqlBool _) = quickError y
safeConvert (SqlDouble x) = secs2td (truncate x)
safeConvert (SqlRational x) = secs2td (truncate x)
safeConvert y@(SqlLocalDate _) = quickError y
safeConvert y@(SqlLocalTimeOfDay _) = quickError y
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert y@(SqlLocalTime _) = quickError y
safeConvert y@(SqlZonedTime _) = quickError y
safeConvert y@(SqlUTCTime _) = quickError y
safeConvert y@(SqlPOSIXTime _) = quickError y
safeConvert (SqlDiffTime x) = safeConvert x
safeConvert y@(SqlEpochTime _) = quickError y
safeConvert (SqlTimeDiff x) = secs2td x
safeConvert y@SqlNull = quickError y
instance Convertible DiffTime SqlValue where
safeConvert = return . SqlDiffTime . fromRational . toRational
instance Convertible SqlValue DiffTime where
safeConvert (SqlString x) = read' x >>= return . fromInteger
safeConvert (SqlByteString x) = safeConvert . SqlString . BUTF8.toString $ x
safeConvert (SqlInt32 x) = return . fromIntegral $ x
safeConvert (SqlInt64 x) = return . fromIntegral $ x
safeConvert (SqlWord32 x) = return . fromIntegral $ x
safeConvert (SqlWord64 x) = return . fromIntegral $ x
safeConvert (SqlInteger x) = return . fromIntegral $ x
safeConvert y@(SqlChar _) = quickError y
safeConvert y@(SqlBool _) = quickError y
safeConvert (SqlDouble x) = return . fromRational . toRational $ x
safeConvert (SqlRational x) = return . fromRational $ x
safeConvert y@(SqlLocalDate _) = quickError y
safeConvert y@(SqlLocalTimeOfDay _) = quickError y
safeConvert y@(SqlZonedLocalTimeOfDay _ _) = quickError y
safeConvert y@(SqlLocalTime _) = quickError y
safeConvert y@(SqlZonedTime _) = quickError y
safeConvert y@(SqlUTCTime _) = quickError y
safeConvert (SqlDiffTime x) = return . fromRational . toRational $ x
safeConvert y@(SqlPOSIXTime _) = quickError y
safeConvert y@(SqlEpochTime _) = quickError y
safeConvert (SqlTimeDiff x) = return . fromIntegral $ x
safeConvert y@SqlNull = quickError y
instance Convertible ST.CalendarTime SqlValue where
safeConvert x = safeConvert x >>= return . SqlZonedTime
instance Convertible SqlValue ST.CalendarTime where
safeConvert = convertVia (undefined::ZonedTime)
instance (Convertible a SqlValue) => Convertible (Maybe a) SqlValue where
safeConvert Nothing = return SqlNull
safeConvert (Just a) = safeConvert a
instance (Convertible SqlValue a) => Convertible SqlValue (Maybe a) where
safeConvert SqlNull = return Nothing
safeConvert a = safeConvert a >>= (return . Just)
viaInteger' :: (Convertible SqlValue a, Bounded a, Show a, Convertible a Integer,
Typeable a) => SqlValue -> (Integer -> ConvertResult a) -> ConvertResult a
viaInteger' sv func =
do i <- ((safeConvert sv)::ConvertResult Integer)
boundedConversion func i
viaInteger :: (Convertible SqlValue a, Bounded a, Show a, Convertible a Integer,
Typeable a) => SqlValue -> (Integer -> a) -> ConvertResult a
viaInteger sv func = viaInteger' sv (return . func)
secs2td :: Integer -> ConvertResult ST.TimeDiff
secs2td x = safeConvert x
read' :: (Typeable a, Read a, Convertible SqlValue a) => String -> ConvertResult a
read' s =
case reads s of
[(x,"")] -> Right x
_ -> convError "Cannot read source value as dest type" (SqlString s)
#ifdef __HUGS__
parseTime' :: (Typeable t, Convertible SqlValue t) => String -> String -> ConvertResult t
parseTime' _ inpstr =
convError "Hugs does not support time parsing" (SqlString inpstr)
#else
parseTime' :: (Typeable t, Convertible SqlValue t, ParseTime t) => String -> String -> ConvertResult t
parseTime' fmtstr inpstr =
#if MIN_TIME_15
case parseTimeM True defaultTimeLocale fmtstr inpstr of
#else
case parseTime defaultTimeLocale fmtstr inpstr of
#endif
Nothing -> convError ("Cannot parse using default format string " ++ show fmtstr)
(SqlString inpstr)
Just x -> Right x
#endif