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
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)
instance Typeable SqlValue where
typeOf _ = mkTypeName "SqlValue"
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)
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
#ifndef TIME_GT_113
instance Typeable Day where
typeOf _ = mkTypeName "Day"
instance Typeable TimeOfDay where
typeOf _ = mkTypeName "TimeOfDay"
instance Typeable LocalTime where
typeOf _ = mkTypeName "LocalTime"
instance Typeable ZonedTime where
typeOf _ = mkTypeName "ZonedTime"
instance Typeable DiffTime where
typeOf _ = mkTypeName "DiffTime"
instance Typeable TimeZone where
typeOf _ = mkTypeName "TimeZone"
#endif
instance Typeable ST.ClockTime where
typeOf _ = mkTypeName "ClockTime"
instance Typeable ST.TimeDiff where
typeOf _ = mkTypeName "TimeDiff"
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
tz <- case parseTime defaultTimeLocale "%T%Q %z" x of
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 =
case parseTime defaultTimeLocale fmtstr inpstr of
Nothing -> convError ("Cannot parse using default format string " ++ show fmtstr)
(SqlString inpstr)
Just x -> Right x
#endif