module Database.PostgreSQL.PQTypes.FromSQL (
FromSQL(..)
) where
import Data.Int
import Data.Kind (Type)
import Data.Ratio
import Data.Text.Encoding
import Data.Time
import Data.Word
import Foreign.C
import Foreign.Storable
import qualified Control.Exception as E
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.UUID.Types as U
import Database.PostgreSQL.PQTypes.Format
import Database.PostgreSQL.PQTypes.Internal.C.Types
import Database.PostgreSQL.PQTypes.Internal.Utils
class (PQFormat t, Storable (PQBase t)) => FromSQL t where
type PQBase t :: Type
fromSQL :: Maybe (PQBase t)
-> IO t
instance FromSQL t => FromSQL (Maybe t) where
type PQBase (Maybe t) = PQBase t
fromSQL :: Maybe (PQBase (Maybe t)) -> IO (Maybe t)
fromSQL Maybe (PQBase (Maybe t))
mbase = case Maybe (PQBase (Maybe t))
mbase of
Just PQBase (Maybe t)
_ -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL Maybe (PQBase (Maybe t))
mbase
Maybe (PQBase (Maybe t))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
instance FromSQL Int16 where
type PQBase Int16 = CShort
fromSQL :: Maybe (PQBase Int16) -> IO Int16
fromSQL Maybe (PQBase Int16)
Nothing = forall a. IO a
unexpectedNULL
fromSQL (Just PQBase Int16
n) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ PQBase Int16
n
instance FromSQL Int32 where
type PQBase Int32 = CInt
fromSQL :: Maybe (PQBase Int32) -> IO Int32
fromSQL Maybe (PQBase Int32)
Nothing = forall a. IO a
unexpectedNULL
fromSQL (Just PQBase Int32
n) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ PQBase Int32
n
instance FromSQL Int64 where
type PQBase Int64 = CLLong
fromSQL :: Maybe (PQBase Int64) -> IO Int64
fromSQL Maybe (PQBase Int64)
Nothing = forall a. IO a
unexpectedNULL
fromSQL (Just PQBase Int64
n) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ PQBase Int64
n
instance FromSQL Float where
type PQBase Float = CFloat
fromSQL :: Maybe (PQBase Float) -> IO Float
fromSQL Maybe (PQBase Float)
Nothing = forall a. IO a
unexpectedNULL
fromSQL (Just PQBase Float
n) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ PQBase Float
n
instance FromSQL Double where
type PQBase Double = CDouble
fromSQL :: Maybe (PQBase Double) -> IO Double
fromSQL Maybe (PQBase Double)
Nothing = forall a. IO a
unexpectedNULL
fromSQL (Just PQBase Double
n) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ PQBase Double
n
instance FromSQL Char where
type PQBase Char = CChar
fromSQL :: Maybe (PQBase Char) -> IO Char
fromSQL Maybe (PQBase Char)
Nothing = forall a. IO a
unexpectedNULL
fromSQL (Just PQBase Char
c) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Char
castCCharToChar forall a b. (a -> b) -> a -> b
$ PQBase Char
c
instance FromSQL Word8 where
type PQBase Word8 = CChar
fromSQL :: Maybe (PQBase Word8) -> IO Word8
fromSQL Maybe (PQBase Word8)
Nothing = forall a. IO a
unexpectedNULL
fromSQL (Just PQBase Word8
c) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ PQBase Word8
c
instance FromSQL T.Text where
type PQBase T.Text = PGbytea
fromSQL :: Maybe (PQBase Text) -> IO Text
fromSQL Maybe (PQBase Text)
mbytea = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
E.throwIO forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
decodeUtf8' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL Maybe (PQBase Text)
mbytea
instance FromSQL TL.Text where
type PQBase TL.Text = PGbytea
fromSQL :: Maybe (PQBase Text) -> IO Text
fromSQL = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
TL.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL
instance FromSQL String where
type PQBase String = PGbytea
fromSQL :: Maybe (PQBase String) -> IO String
fromSQL Maybe (PQBase String)
mbytea = Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL Maybe (PQBase String)
mbytea
instance FromSQL U.UUID where
type PQBase U.UUID = PGuuid
fromSQL :: Maybe (PQBase UUID) -> IO UUID
fromSQL Maybe (PQBase UUID)
Nothing = forall a. IO a
unexpectedNULL
fromSQL (Just (PGuuid Word32
w1 Word32
w2 Word32
w3 Word32
w4)) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word32 -> Word32 -> UUID
U.fromWords Word32
w1 Word32
w2 Word32
w3 Word32
w4
instance FromSQL BS.ByteString where
type PQBase BS.ByteString = PGbytea
fromSQL :: Maybe (PQBase ByteString) -> IO ByteString
fromSQL Maybe (PQBase ByteString)
Nothing = forall a. IO a
unexpectedNULL
fromSQL (Just PQBase ByteString
bytea) = CStringLen -> IO ByteString
BS.packCStringLen forall a b. (a -> b) -> a -> b
$ PGbytea -> CStringLen
byteaToCStringLen PQBase ByteString
bytea
instance FromSQL BSL.ByteString where
type PQBase BSL.ByteString = PGbytea
fromSQL :: Maybe (PQBase ByteString) -> IO ByteString
fromSQL = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
BSL.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL
instance FromSQL Day where
type PQBase Day = PGdate
fromSQL :: Maybe (PQBase Day) -> IO Day
fromSQL Maybe (PQBase Day)
Nothing = forall a. IO a
unexpectedNULL
fromSQL (Just PQBase Day
date) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGdate -> Day
pgDateToDay forall a b. (a -> b) -> a -> b
$ PQBase Day
date
instance FromSQL TimeOfDay where
type PQBase TimeOfDay = PGtime
fromSQL :: Maybe (PQBase TimeOfDay) -> IO TimeOfDay
fromSQL Maybe (PQBase TimeOfDay)
Nothing = forall a. IO a
unexpectedNULL
fromSQL (Just PQBase TimeOfDay
time) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGtime -> TimeOfDay
pgTimeToTimeOfDay forall a b. (a -> b) -> a -> b
$ PQBase TimeOfDay
time
instance FromSQL LocalTime where
type PQBase LocalTime = PGtimestamp
fromSQL :: Maybe (PQBase LocalTime) -> IO LocalTime
fromSQL Maybe (PQBase LocalTime)
Nothing = forall a. IO a
unexpectedNULL
fromSQL (Just PGtimestamp{CLLong
PGtime
PGdate
pgTimestampTime :: PGtimestamp -> PGtime
pgTimestampDate :: PGtimestamp -> PGdate
pgTimestampEpoch :: PGtimestamp -> CLLong
pgTimestampTime :: PGtime
pgTimestampDate :: PGdate
pgTimestampEpoch :: CLLong
..}) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
tod
where
day :: Day
day = PGdate -> Day
pgDateToDay PGdate
pgTimestampDate
tod :: TimeOfDay
tod = PGtime -> TimeOfDay
pgTimeToTimeOfDay PGtime
pgTimestampTime
instance FromSQL UTCTime where
type PQBase UTCTime = PGtimestamp
fromSQL :: Maybe (PQBase UTCTime) -> IO UTCTime
fromSQL Maybe (PQBase UTCTime)
Nothing = forall a. IO a
unexpectedNULL
fromSQL jts :: Maybe (PQBase UTCTime)
jts@(Just PGtimestamp{CLLong
PGtime
PGdate
pgTimestampTime :: PGtime
pgTimestampDate :: PGdate
pgTimestampEpoch :: CLLong
pgTimestampTime :: PGtimestamp -> PGtime
pgTimestampDate :: PGtimestamp -> PGdate
pgTimestampEpoch :: PGtimestamp -> CLLong
..}) = do
LocalTime
localTime <- forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL Maybe (PQBase UTCTime)
jts
case Int
rest of
Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> LocalTime -> UTCTime
localTimeToUTC (Int -> TimeZone
minutesToTimeZone Int
mins) forall a b. (a -> b) -> a -> b
$ LocalTime
localTime
Int
_ -> forall a. String -> IO a
hpqTypesError forall a b. (a -> b) -> a -> b
$ String
"Invalid gmtoff: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CInt
gmtoff
where
gmtoff :: CInt
gmtoff = PGtime -> CInt
pgTimeGMTOff PGtime
pgTimestampTime
(Int
mins, Int
rest) = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
gmtoff forall a. Integral a => a -> a -> (a, a)
`divMod` Int
60
instance FromSQL Bool where
type PQBase Bool = CInt
fromSQL :: Maybe (PQBase Bool) -> IO Bool
fromSQL Maybe (PQBase Bool)
Nothing = forall a. IO a
unexpectedNULL
fromSQL (Just PQBase Bool
n) = case PQBase Bool
n of
PQBase Bool
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
PQBase Bool
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
pgDateToDay :: PGdate -> Day
pgDateToDay :: PGdate -> Day
pgDateToDay PGdate{CInt
pgDateWDay :: PGdate -> CInt
pgDateYDay :: PGdate -> CInt
pgDateJDay :: PGdate -> CInt
pgDateMDay :: PGdate -> CInt
pgDateMon :: PGdate -> CInt
pgDateYear :: PGdate -> CInt
pgDateIsBC :: PGdate -> CInt
pgDateWDay :: CInt
pgDateYDay :: CInt
pgDateJDay :: CInt
pgDateMDay :: CInt
pgDateMon :: CInt
pgDateYear :: CInt
pgDateIsBC :: CInt
..} = Integer -> Int -> Int -> Day
fromGregorian Integer
year Int
mon Int
mday
where
year :: Integer
year = Integer -> Integer
adjustBC forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
pgDateYear
mon :: Int
mon = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CInt
pgDateMon forall a. Num a => a -> a -> a
+ CInt
1
mday :: Int
mday = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
pgDateMDay
adjustBC :: Integer -> Integer
adjustBC = if CInt
pgDateIsBC forall a. Eq a => a -> a -> Bool
== CInt
1 then forall a. Num a => a -> a
negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> a
pred else forall a. a -> a
id
pgTimeToTimeOfDay :: PGtime -> TimeOfDay
pgTimeToTimeOfDay :: PGtime -> TimeOfDay
pgTimeToTimeOfDay PGtime{ByteString
CInt
pgTimeTZAbbr :: PGtime -> ByteString
pgTimeIsDST :: PGtime -> CInt
pgTimeWithTZ :: PGtime -> CInt
pgTimeUSec :: PGtime -> CInt
pgTimeSec :: PGtime -> CInt
pgTimeMin :: PGtime -> CInt
pgTimeHour :: PGtime -> CInt
pgTimeTZAbbr :: ByteString
pgTimeGMTOff :: CInt
pgTimeIsDST :: CInt
pgTimeWithTZ :: CInt
pgTimeUSec :: CInt
pgTimeSec :: CInt
pgTimeMin :: CInt
pgTimeHour :: CInt
pgTimeGMTOff :: PGtime -> CInt
..} = Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
hour Int
mins forall a b. (a -> b) -> a -> b
$ Pico
sec forall a. Num a => a -> a -> a
+ forall a. Fractional a => Rational -> a
fromRational (Integer
usec forall a. Integral a => a -> a -> Ratio a
% Integer
1000000)
where
hour :: Int
hour = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
pgTimeHour
mins :: Int
mins = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
pgTimeMin
sec :: Pico
sec = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
pgTimeSec
usec :: Integer
usec = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
pgTimeUSec