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 :: forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr t
x Ptr t -> IO r
conv = forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr t
ptr -> forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr t
ptr t
x 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 forall a. Ptr a
nullPtr
Just t
t -> forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL t
t ParamAllocator
allocParam 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
_ = forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (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
_ = forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (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
_ = forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (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
_ = forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (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
_ = forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (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
_ = forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (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 forall a. Ord a => a -> a -> Bool
> Char
'\255' = forall a. [Char] -> IO a
hpqTypesError forall a b. (a -> b) -> a -> b
$ [Char]
"toSQL (Char): character " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Char
c forall a. [a] -> [a] -> [a]
++ [Char]
" cannot be losslessly converted to CChar"
| Bool
otherwise = forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (Char -> CChar
castCharToCChar Char
c) 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
_ = forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (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 = forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL 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 = forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL 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 = forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL 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
_ = forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr 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 = forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \CStringLen
cslen ->
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr Ptr (PQDest ByteString) -> IO r
conv forall b c a. (b -> c) -> (a -> b) -> a -> c
. CStringLen -> PGbytea
cStringLenToBytea forall a b. (a -> b) -> a -> b
$
if forall a b. (a, b) -> a
fst CStringLen
cslen forall a. Eq a => a -> a -> Bool
== 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 = forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL 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
_ = 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
_ = 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{TimeOfDay
Day
localDay :: LocalTime -> Day
localTimeOfDay :: LocalTime -> TimeOfDay
localTimeOfDay :: TimeOfDay
localDay :: Day
..} ParamAllocator
_ = 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{DiffTime
Day
utctDay :: UTCTime -> Day
utctDayTime :: UTCTime -> DiffTime
utctDayTime :: DiffTime
utctDay :: Day
..} ParamAllocator
_ = 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 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{LocalTime
TimeZone
zonedTimeToLocalTime :: ZonedTime -> LocalTime
zonedTimeZone :: ZonedTime -> TimeZone
zonedTimeZone :: TimeZone
zonedTimeToLocalTime :: LocalTime
..} ParamAllocator
_ = 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 forall a b. (a -> b) -> a -> b
$ LocalTime -> Day
localDay LocalTime
zonedTimeToLocalTime
, pgTimestampTime :: PGtime
pgTimestampTime = (TimeOfDay -> PGtime
timeOfDayToPGtime forall a b. (a -> b) -> a -> b
$ LocalTime -> TimeOfDay
localTimeOfDay LocalTime
zonedTimeToLocalTime) {
pgTimeGMTOff :: CInt
pgTimeGMTOff = forall a b. (Integral a, Num b) => a -> b
fromIntegral (TimeZone -> MonthOfYear
timeZoneMinutes TimeZone
zonedTimeZone) forall a. Num a => a -> a -> a
* CInt
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
_ = forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr CInt
1
toSQL Bool
False ParamAllocator
_ = 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 :: TimeOfDay -> MonthOfYear
todMin :: TimeOfDay -> MonthOfYear
todSec :: TimeOfDay -> Pico
todSec :: Pico
todMin :: MonthOfYear
todHour :: MonthOfYear
..} = PGtime {
pgTimeHour :: CInt
pgTimeHour = forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
todHour
, pgTimeMin :: CInt
pgTimeMin = 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) = forall a b. (RealFrac a, Integral b) => a -> b
floor ((forall a. Real a => a -> Rational
toRational Pico
todSec) forall a. Num a => a -> a -> a
* Rational
1000000) 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Year -> Year
adjustBC Year
year
, pgDateMon :: CInt
pgDateMon = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ MonthOfYear
mon forall a. Num a => a -> a -> a
- MonthOfYear
1
, pgDateMDay :: CInt
pgDateMDay = 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 forall a. Ord a => a -> a -> Bool
<= Year
0 then CInt
1 else CInt
0
adjustBC :: Year -> Year
adjustBC = if CInt
isBC forall a. Eq a => a -> a -> Bool
== CInt
1 then forall a. Enum a => a -> a
succ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
negate else forall a. a -> a
id