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 which represents \"from SQL (libpqtypes)
-- type to Haskell type\" transformation.
class (PQFormat t, Storable (PQBase t)) => FromSQL t where
  -- | Base type (used by libpqtypes).
  type PQBase t :: Type
  -- | Convert value of base type to target one.
  fromSQL :: Maybe (PQBase t) -- ^ base value (Nothing if NULL was delivered)
          -> IO t

-- NULLables

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

-- NUMERICS

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

-- CHAR

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

-- VARIABLE-LENGTH CHARACTER TYPES

-- | Assumes that source C string is UTF-8, so if you are working
-- with a different encoding, you should not rely on this instance.
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

-- | Assumes that source C string is UTF-8, so if you are working
-- with a different encoding, you should not rely on this instance
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

-- | Assumes that source C string is UTF-8, so if you are working
-- with a different encoding, you should not rely on this instance.
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

-- BYTEA

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

-- DATE

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

-- TIME

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

-- TIMESTAMP

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

-- TIMESTAMPTZ

-- | 'FromSQL' instance for 'ZonedTime' doesn't exist because
-- PostgreSQL doesn't provide zone offset information when returning
-- timestamps with time zone in a binary format.
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

-- BOOL

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

----------------------------------------

-- | Convert PGtime to Day.
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
    -- Note: libpqtypes represents months as numbers in range
    -- [0, 11], whereas Haskell uses [1, 12], hence plus one.
    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
    -- Note: PostgreSQL has no notion of '0th year', it's 1 AD
    -- and then before that 1 BC for it. Since Haskell represents
    -- date according to ISO-8601, where 0th year means 1 BC, we
    -- want to change the sign and adjust the year by one here,
    -- if appropriate.
    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

-- | Convert PGtime to TimeOfDay.
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