module Database.PostgreSQL.PQTypes.ToSQL (
ParamAllocator(..)
, ToSQL(..)
, putAsPtr
) where
import Data.ByteString.Unsafe
import Data.Int
import Data.Kind (Type)
import Data.Text.Encoding
import Data.Time
import Data.Word
import Foreign.C
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
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.Interface
import Database.PostgreSQL.PQTypes.Internal.C.Types
import Database.PostgreSQL.PQTypes.Internal.Utils
newtype ParamAllocator = ParamAllocator (forall r. (Ptr PGparam -> IO r) -> IO r)
class PQFormat t => ToSQL t where
type PQDest t :: Type
toSQL :: t
-> ParamAllocator
-> (Ptr (PQDest t) -> IO r)
-> IO r
putAsPtr :: Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr :: t -> (Ptr t -> IO r) -> IO r
putAsPtr t
x Ptr t -> IO r
conv = (Ptr t -> IO r) -> IO r
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr t -> IO r) -> IO r) -> (Ptr t -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr -> Ptr t -> t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr t
ptr t
x IO () -> IO r -> IO r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr t -> IO r
conv Ptr t
ptr
instance ToSQL t => ToSQL (Maybe t) where
type PQDest (Maybe t) = PQDest t
toSQL :: Maybe t
-> ParamAllocator -> (Ptr (PQDest (Maybe t)) -> IO r) -> IO r
toSQL Maybe t
mt ParamAllocator
allocParam Ptr (PQDest (Maybe t)) -> IO r
conv = case Maybe t
mt of
Maybe t
Nothing -> Ptr (PQDest (Maybe t)) -> IO r
conv Ptr (PQDest (Maybe t))
forall a. Ptr a
nullPtr
Just t
t -> t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL t
t ParamAllocator
allocParam Ptr (PQDest t) -> IO r
Ptr (PQDest (Maybe t)) -> IO r
conv
instance ToSQL Int16 where
type PQDest Int16 = CShort
toSQL :: Int16 -> ParamAllocator -> (Ptr (PQDest Int16) -> IO r) -> IO r
toSQL Int16
n ParamAllocator
_ = CShort -> (Ptr CShort -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (Int16 -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
n)
instance ToSQL Int32 where
type PQDest Int32 = CInt
toSQL :: Int32 -> ParamAllocator -> (Ptr (PQDest Int32) -> IO r) -> IO r
toSQL Int32
n ParamAllocator
_ = CInt -> (Ptr CInt -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (Int32 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n)
instance ToSQL Int64 where
type PQDest Int64 = CLLong
toSQL :: Int64 -> ParamAllocator -> (Ptr (PQDest Int64) -> IO r) -> IO r
toSQL Int64
n ParamAllocator
_ = CLLong -> (Ptr CLLong -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (Int64 -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n)
instance ToSQL Int where
type PQDest Int = CLLong
toSQL :: Int -> ParamAllocator -> (Ptr (PQDest Int) -> IO r) -> IO r
toSQL Int
n ParamAllocator
_ = CLLong -> (Ptr CLLong -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (Int -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
instance ToSQL Float where
type PQDest Float = CFloat
toSQL :: Float -> ParamAllocator -> (Ptr (PQDest Float) -> IO r) -> IO r
toSQL Float
n ParamAllocator
_ = CFloat -> (Ptr CFloat -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
n)
instance ToSQL Double where
type PQDest Double = CDouble
toSQL :: Double -> ParamAllocator -> (Ptr (PQDest Double) -> IO r) -> IO r
toSQL Double
n ParamAllocator
_ = CDouble -> (Ptr CDouble -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
n)
instance ToSQL Char where
type PQDest Char = CChar
toSQL :: Char -> ParamAllocator -> (Ptr (PQDest Char) -> IO r) -> IO r
toSQL Char
c ParamAllocator
_ Ptr (PQDest Char) -> IO r
conv
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\255' = String -> IO r
forall a. String -> IO a
hpqTypesError (String -> IO r) -> String -> IO r
forall a b. (a -> b) -> a -> b
$ String
"toSQL (Char): character " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" cannot be losslessly converted to CChar"
| Bool
otherwise = CChar -> (Ptr CChar -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (Char -> CChar
castCharToCChar Char
c) Ptr CChar -> IO r
Ptr (PQDest Char) -> IO r
conv
instance ToSQL Word8 where
type PQDest Word8 = CChar
toSQL :: Word8 -> ParamAllocator -> (Ptr (PQDest Word8) -> IO r) -> IO r
toSQL Word8
c ParamAllocator
_ = CChar -> (Ptr CChar -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (Word8 -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c)
instance ToSQL T.Text where
type PQDest T.Text = PGbytea
toSQL :: Text -> ParamAllocator -> (Ptr (PQDest Text) -> IO r) -> IO r
toSQL = ByteString -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL (ByteString -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r)
-> (Text -> ByteString)
-> Text
-> ParamAllocator
-> (Ptr PGbytea -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
instance ToSQL TL.Text where
type PQDest TL.Text = PGbytea
toSQL :: Text -> ParamAllocator -> (Ptr (PQDest Text) -> IO r) -> IO r
toSQL = Text -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL (Text -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r)
-> (Text -> Text)
-> Text
-> ParamAllocator
-> (Ptr PGbytea -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict
instance ToSQL String where
type PQDest String = PGbytea
toSQL :: String -> ParamAllocator -> (Ptr (PQDest String) -> IO r) -> IO r
toSQL = Text -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL (Text -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r)
-> (String -> Text)
-> String
-> ParamAllocator
-> (Ptr PGbytea -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
instance ToSQL U.UUID where
type PQDest U.UUID = PGuuid
toSQL :: UUID -> ParamAllocator -> (Ptr (PQDest UUID) -> IO r) -> IO r
toSQL UUID
uuid ParamAllocator
_ = PGuuid -> (Ptr PGuuid -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (PGuuid -> (Ptr PGuuid -> IO r) -> IO r)
-> PGuuid -> (Ptr PGuuid -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word32 -> Word32 -> PGuuid
PGuuid Word32
w1 Word32
w2 Word32
w3 Word32
w4
where
(Word32
w1, Word32
w2, Word32
w3, Word32
w4) = UUID -> (Word32, Word32, Word32, Word32)
U.toWords UUID
uuid
instance ToSQL BS.ByteString where
type PQDest BS.ByteString = PGbytea
toSQL :: ByteString
-> ParamAllocator -> (Ptr (PQDest ByteString) -> IO r) -> IO r
toSQL ByteString
bs ParamAllocator
_ Ptr (PQDest ByteString) -> IO r
conv = ByteString -> (CStringLen -> IO r) -> IO r
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO r) -> IO r) -> (CStringLen -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \CStringLen
cslen ->
(PGbytea -> (Ptr PGbytea -> IO r) -> IO r)
-> (Ptr PGbytea -> IO r) -> PGbytea -> IO r
forall a b c. (a -> b -> c) -> b -> a -> c
flip PGbytea -> (Ptr PGbytea -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr Ptr PGbytea -> IO r
Ptr (PQDest ByteString) -> IO r
conv (PGbytea -> IO r) -> (CStringLen -> PGbytea) -> CStringLen -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CStringLen -> PGbytea
cStringLenToBytea (CStringLen -> IO r) -> CStringLen -> IO r
forall a b. (a -> b) -> a -> b
$
if CStringLen -> Ptr CChar
forall a b. (a, b) -> a
fst CStringLen
cslen Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
then CStringLen
nullStringCStringLen
else CStringLen
cslen
instance ToSQL BSL.ByteString where
type PQDest BSL.ByteString = PGbytea
toSQL :: ByteString
-> ParamAllocator -> (Ptr (PQDest ByteString) -> IO r) -> IO r
toSQL = ByteString -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL (ByteString -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r)
-> (ByteString -> ByteString)
-> ByteString
-> ParamAllocator
-> (Ptr PGbytea -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict
instance ToSQL Day where
type PQDest Day = PGdate
toSQL :: Day -> ParamAllocator -> (Ptr (PQDest Day) -> IO r) -> IO r
toSQL Day
day ParamAllocator
_ = PGdate -> (Ptr PGdate -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (Day -> PGdate
dayToPGdate Day
day)
instance ToSQL TimeOfDay where
type PQDest TimeOfDay = PGtime
toSQL :: TimeOfDay
-> ParamAllocator -> (Ptr (PQDest TimeOfDay) -> IO r) -> IO r
toSQL TimeOfDay
tod ParamAllocator
_ = PGtime -> (Ptr PGtime -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (TimeOfDay -> PGtime
timeOfDayToPGtime TimeOfDay
tod)
instance ToSQL LocalTime where
type PQDest LocalTime = PGtimestamp
toSQL :: LocalTime
-> ParamAllocator -> (Ptr (PQDest LocalTime) -> IO r) -> IO r
toSQL LocalTime{TimeOfDay
Day
localDay :: LocalTime -> Day
localTimeOfDay :: LocalTime -> TimeOfDay
localTimeOfDay :: TimeOfDay
localDay :: Day
..} ParamAllocator
_ = PGtimestamp -> (Ptr PGtimestamp -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr PGtimestamp :: CLLong -> PGdate -> PGtime -> PGtimestamp
PGtimestamp {
pgTimestampEpoch :: CLLong
pgTimestampEpoch = CLLong
0
, pgTimestampDate :: PGdate
pgTimestampDate = Day -> PGdate
dayToPGdate Day
localDay
, pgTimestampTime :: PGtime
pgTimestampTime = TimeOfDay -> PGtime
timeOfDayToPGtime TimeOfDay
localTimeOfDay
}
instance ToSQL UTCTime where
type PQDest UTCTime = PGtimestamp
toSQL :: UTCTime -> ParamAllocator -> (Ptr (PQDest UTCTime) -> IO r) -> IO r
toSQL UTCTime{DiffTime
Day
utctDay :: UTCTime -> Day
utctDayTime :: UTCTime -> DiffTime
utctDayTime :: DiffTime
utctDay :: Day
..} ParamAllocator
_ = PGtimestamp -> (Ptr PGtimestamp -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr PGtimestamp :: CLLong -> PGdate -> PGtime -> PGtimestamp
PGtimestamp {
pgTimestampEpoch :: CLLong
pgTimestampEpoch = CLLong
0
, pgTimestampDate :: PGdate
pgTimestampDate = Day -> PGdate
dayToPGdate Day
utctDay
, pgTimestampTime :: PGtime
pgTimestampTime = TimeOfDay -> PGtime
timeOfDayToPGtime (TimeOfDay -> PGtime) -> TimeOfDay -> PGtime
forall a b. (a -> b) -> a -> b
$ DiffTime -> TimeOfDay
timeToTimeOfDay DiffTime
utctDayTime
}
instance ToSQL ZonedTime where
type PQDest ZonedTime = PGtimestamp
toSQL :: ZonedTime
-> ParamAllocator -> (Ptr (PQDest ZonedTime) -> IO r) -> IO r
toSQL ZonedTime{LocalTime
TimeZone
zonedTimeToLocalTime :: ZonedTime -> LocalTime
zonedTimeZone :: ZonedTime -> TimeZone
zonedTimeZone :: TimeZone
zonedTimeToLocalTime :: LocalTime
..} ParamAllocator
_ = PGtimestamp -> (Ptr PGtimestamp -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr PGtimestamp :: CLLong -> PGdate -> PGtime -> PGtimestamp
PGtimestamp {
pgTimestampEpoch :: CLLong
pgTimestampEpoch = CLLong
0
, pgTimestampDate :: PGdate
pgTimestampDate = Day -> PGdate
dayToPGdate (Day -> PGdate) -> Day -> PGdate
forall a b. (a -> b) -> a -> b
$ LocalTime -> Day
localDay LocalTime
zonedTimeToLocalTime
, pgTimestampTime :: PGtime
pgTimestampTime = (TimeOfDay -> PGtime
timeOfDayToPGtime (TimeOfDay -> PGtime) -> TimeOfDay -> PGtime
forall a b. (a -> b) -> a -> b
$ LocalTime -> TimeOfDay
localTimeOfDay LocalTime
zonedTimeToLocalTime) {
pgTimeGMTOff :: CInt
pgTimeGMTOff = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TimeZone -> Int
timeZoneMinutes TimeZone
zonedTimeZone) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* CInt
60
}
}
instance ToSQL Bool where
type PQDest Bool = CInt
toSQL :: Bool -> ParamAllocator -> (Ptr (PQDest Bool) -> IO r) -> IO r
toSQL Bool
True ParamAllocator
_ = CInt -> (Ptr CInt -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr CInt
1
toSQL Bool
False ParamAllocator
_ = CInt -> (Ptr CInt -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr CInt
0
timeOfDayToPGtime :: TimeOfDay -> PGtime
timeOfDayToPGtime :: TimeOfDay -> PGtime
timeOfDayToPGtime TimeOfDay{Int
Pico
todHour :: TimeOfDay -> Int
todMin :: TimeOfDay -> Int
todSec :: TimeOfDay -> Pico
todSec :: Pico
todMin :: Int
todHour :: Int
..} = PGtime :: CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> ByteString
-> PGtime
PGtime {
pgTimeHour :: CInt
pgTimeHour = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
todHour
, pgTimeMin :: CInt
pgTimeMin = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
todMin
, pgTimeSec :: CInt
pgTimeSec = CInt
sec
, pgTimeUSec :: CInt
pgTimeUSec = CInt
usec
, pgTimeWithTZ :: CInt
pgTimeWithTZ = CInt
0
, pgTimeIsDST :: CInt
pgTimeIsDST = CInt
0
, pgTimeGMTOff :: CInt
pgTimeGMTOff = CInt
0
, pgTimeTZAbbr :: ByteString
pgTimeTZAbbr = ByteString
BS.empty
}
where
(CInt
sec, CInt
usec) = Rational -> CInt
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Pico -> Rational
forall a. Real a => a -> Rational
toRational Pico
todSec) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1000000) CInt -> CInt -> (CInt, CInt)
forall a. Integral a => a -> a -> (a, a)
`divMod` CInt
1000000
dayToPGdate :: Day -> PGdate
dayToPGdate :: Day -> PGdate
dayToPGdate Day
day = PGdate :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> PGdate
PGdate {
pgDateIsBC :: CInt
pgDateIsBC = CInt
isBC
, pgDateYear :: CInt
pgDateYear = Integer -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> CInt) -> Integer -> CInt
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
adjustBC Integer
year
, pgDateMon :: CInt
pgDateMon = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Int
mon Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
, pgDateMDay :: CInt
pgDateMDay = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mday
, pgDateJDay :: CInt
pgDateJDay = CInt
0
, pgDateYDay :: CInt
pgDateYDay = CInt
0
, pgDateWDay :: CInt
pgDateWDay = CInt
0
}
where
(Integer
year, Int
mon, Int
mday) = Day -> (Integer, Int, Int)
toGregorian Day
day
isBC :: CInt
isBC = if Integer
year Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 then CInt
1 else CInt
0
adjustBC :: Integer -> Integer
adjustBC = if CInt
isBC CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1 then Integer -> Integer
forall a. Enum a => a -> a
succ (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
negate else Integer -> Integer
forall a. a -> a
id