module Database.PostgreSQL.PQTypes.ToSQL
( ParamAllocator (..)
, ToSQL (..)
, putAsPtr
) where
import Data.ByteString.Char8 qualified as BS
import Data.ByteString.Lazy.Char8 qualified as BSL
import Data.ByteString.Unsafe
import Data.Int
import Data.Kind (Type)
import Data.Text qualified as T
import Data.Text.Encoding
import Data.Text.Lazy qualified as TL
import Data.Time
import Data.UUID.Types qualified as U
import Data.Word
import Foreign.C
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
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 :: forall t r. Storable t => 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 a b. IO a -> IO b -> IO b
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 :: forall r.
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 t)
Ptr (PQDest (Maybe t))
forall a. Ptr a
nullPtr
Just t
t -> t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
forall r. 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 :: forall r.
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 :: forall r.
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 :: forall r.
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 :: forall r.
MonthOfYear
-> ParamAllocator -> (Ptr (PQDest MonthOfYear) -> IO r) -> IO r
toSQL MonthOfYear
n ParamAllocator
_ = CLLong -> (Ptr CLLong -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (MonthOfYear -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
n)
instance ToSQL Float where
type PQDest Float = CFloat
toSQL :: forall r.
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 :: forall r.
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 :: forall r.
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' = [Char] -> IO r
forall a. [Char] -> IO a
hpqTypesError ([Char] -> IO r) -> [Char] -> IO r
forall a b. (a -> b) -> a -> b
$ [Char]
"toSQL (Char): character " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char -> [Char]
forall a. Show a => a -> [Char]
show Char
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" 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 :: forall r.
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 :: forall r.
Text -> ParamAllocator -> (Ptr (PQDest Text) -> IO r) -> IO r
toSQL = ByteString -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
ByteString
-> ParamAllocator -> (Ptr (PQDest ByteString) -> IO r) -> IO r
forall r.
ByteString
-> ParamAllocator -> (Ptr (PQDest ByteString) -> 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 :: forall r.
Text -> ParamAllocator -> (Ptr (PQDest Text) -> IO r) -> IO r
toSQL = Text -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
Text -> ParamAllocator -> (Ptr (PQDest Text) -> IO r) -> IO r
forall r.
Text -> ParamAllocator -> (Ptr (PQDest Text) -> 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 :: forall r.
[Char] -> ParamAllocator -> (Ptr (PQDest [Char]) -> IO r) -> IO r
toSQL = Text -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
Text -> ParamAllocator -> (Ptr (PQDest Text) -> IO r) -> IO r
forall r.
Text -> ParamAllocator -> (Ptr (PQDest Text) -> 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)
-> ([Char] -> Text)
-> [Char]
-> ParamAllocator
-> (Ptr PGbytea -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
instance ToSQL U.UUID where
type PQDest U.UUID = PGuuid
toSQL :: forall r.
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 :: forall r.
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 :: forall r.
ByteString
-> ParamAllocator -> (Ptr (PQDest ByteString) -> IO r) -> IO r
toSQL = ByteString -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
ByteString
-> ParamAllocator -> (Ptr (PQDest ByteString) -> IO r) -> IO r
forall r.
ByteString
-> ParamAllocator -> (Ptr (PQDest ByteString) -> 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 :: forall r.
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 :: forall r.
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 :: forall r.
LocalTime
-> ParamAllocator -> (Ptr (PQDest LocalTime) -> IO r) -> IO r
toSQL LocalTime {Day
TimeOfDay
localDay :: Day
localTimeOfDay :: TimeOfDay
localDay :: LocalTime -> Day
localTimeOfDay :: LocalTime -> TimeOfDay
..} ParamAllocator
_ =
PGtimestamp -> (Ptr PGtimestamp -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr
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 :: forall r.
UTCTime -> ParamAllocator -> (Ptr (PQDest UTCTime) -> IO r) -> IO r
toSQL UTCTime {Day
DiffTime
utctDay :: Day
utctDayTime :: DiffTime
utctDay :: UTCTime -> Day
utctDayTime :: UTCTime -> DiffTime
..} ParamAllocator
_ =
PGtimestamp -> (Ptr PGtimestamp -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr
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 :: forall r.
ZonedTime
-> ParamAllocator -> (Ptr (PQDest ZonedTime) -> IO r) -> IO r
toSQL ZonedTime {TimeZone
LocalTime
zonedTimeToLocalTime :: LocalTime
zonedTimeZone :: TimeZone
zonedTimeToLocalTime :: ZonedTime -> LocalTime
zonedTimeZone :: ZonedTime -> TimeZone
..} ParamAllocator
_ =
PGtimestamp -> (Ptr PGtimestamp -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr
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 = fromIntegral (timeZoneMinutes zonedTimeZone) * 60
}
}
instance ToSQL Bool where
type PQDest Bool = CInt
toSQL :: forall r.
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 {MonthOfYear
Pico
todHour :: MonthOfYear
todMin :: MonthOfYear
todSec :: Pico
todHour :: TimeOfDay -> MonthOfYear
todMin :: TimeOfDay -> MonthOfYear
todSec :: TimeOfDay -> Pico
..} =
PGtime
{ pgTimeHour :: CInt
pgTimeHour = MonthOfYear -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
todHour
, pgTimeMin :: CInt
pgTimeMin = MonthOfYear -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
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 b. Integral b => Rational -> b
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
{ pgDateIsBC :: CInt
pgDateIsBC = CInt
isBC
, pgDateYear :: CInt
pgDateYear = Year -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Year -> CInt) -> Year -> CInt
forall a b. (a -> b) -> a -> b
$ Year -> Year
adjustBC Year
year
, pgDateMon :: CInt
pgDateMon = MonthOfYear -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MonthOfYear -> CInt) -> MonthOfYear -> CInt
forall a b. (a -> b) -> a -> b
$ MonthOfYear
mon MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
- MonthOfYear
1
, pgDateMDay :: CInt
pgDateMDay = MonthOfYear -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
mday
, pgDateJDay :: CInt
pgDateJDay = CInt
0
, pgDateYDay :: CInt
pgDateYDay = CInt
0
, pgDateWDay :: CInt
pgDateWDay = CInt
0
}
where
(Year
year, MonthOfYear
mon, MonthOfYear
mday) = Day -> (Year, MonthOfYear, MonthOfYear)
toGregorian Day
day
isBC :: CInt
isBC = if Year
year Year -> Year -> Bool
forall a. Ord a => a -> a -> Bool
<= Year
0 then CInt
1 else CInt
0
adjustBC :: Year -> Year
adjustBC = if CInt
isBC CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1 then Year -> Year
forall a. Enum a => a -> a
succ (Year -> Year) -> (Year -> Year) -> Year -> Year
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Year -> Year
forall a. Num a => a -> a
negate else Year -> Year
forall a. a -> a
id