module Database.PostgreSQL.PQTypes.Array
(
Array1 (..)
, unArray1
, CompositeArray1 (..)
, unCompositeArray1
, Array2 (..)
, unArray2
, CompositeArray2 (..)
, unCompositeArray2
) where
import Control.Exception qualified as E
import Control.Monad
import Data.ByteString.Char8 qualified as BS
import Data.ByteString.Unsafe qualified as BS
import Data.Vector.Storable qualified as V
import Foreign.C
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import Database.PostgreSQL.PQTypes.Composite
import Database.PostgreSQL.PQTypes.Format
import Database.PostgreSQL.PQTypes.FromRow
import Database.PostgreSQL.PQTypes.FromSQL
import Database.PostgreSQL.PQTypes.Internal.C.Get
import Database.PostgreSQL.PQTypes.Internal.C.Interface
import Database.PostgreSQL.PQTypes.Internal.C.Put
import Database.PostgreSQL.PQTypes.Internal.C.Types
import Database.PostgreSQL.PQTypes.Internal.Error
import Database.PostgreSQL.PQTypes.Internal.Utils
import Database.PostgreSQL.PQTypes.ToSQL
newtype Array1 a = Array1 [a]
deriving (Array1 a -> Array1 a -> Bool
(Array1 a -> Array1 a -> Bool)
-> (Array1 a -> Array1 a -> Bool) -> Eq (Array1 a)
forall a. Eq a => Array1 a -> Array1 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Array1 a -> Array1 a -> Bool
== :: Array1 a -> Array1 a -> Bool
$c/= :: forall a. Eq a => Array1 a -> Array1 a -> Bool
/= :: Array1 a -> Array1 a -> Bool
Eq, (forall a b. (a -> b) -> Array1 a -> Array1 b)
-> (forall a b. a -> Array1 b -> Array1 a) -> Functor Array1
forall a b. a -> Array1 b -> Array1 a
forall a b. (a -> b) -> Array1 a -> Array1 b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Array1 a -> Array1 b
fmap :: forall a b. (a -> b) -> Array1 a -> Array1 b
$c<$ :: forall a b. a -> Array1 b -> Array1 a
<$ :: forall a b. a -> Array1 b -> Array1 a
Functor, Eq (Array1 a)
Eq (Array1 a) =>
(Array1 a -> Array1 a -> Ordering)
-> (Array1 a -> Array1 a -> Bool)
-> (Array1 a -> Array1 a -> Bool)
-> (Array1 a -> Array1 a -> Bool)
-> (Array1 a -> Array1 a -> Bool)
-> (Array1 a -> Array1 a -> Array1 a)
-> (Array1 a -> Array1 a -> Array1 a)
-> Ord (Array1 a)
Array1 a -> Array1 a -> Bool
Array1 a -> Array1 a -> Ordering
Array1 a -> Array1 a -> Array1 a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Array1 a)
forall a. Ord a => Array1 a -> Array1 a -> Bool
forall a. Ord a => Array1 a -> Array1 a -> Ordering
forall a. Ord a => Array1 a -> Array1 a -> Array1 a
$ccompare :: forall a. Ord a => Array1 a -> Array1 a -> Ordering
compare :: Array1 a -> Array1 a -> Ordering
$c< :: forall a. Ord a => Array1 a -> Array1 a -> Bool
< :: Array1 a -> Array1 a -> Bool
$c<= :: forall a. Ord a => Array1 a -> Array1 a -> Bool
<= :: Array1 a -> Array1 a -> Bool
$c> :: forall a. Ord a => Array1 a -> Array1 a -> Bool
> :: Array1 a -> Array1 a -> Bool
$c>= :: forall a. Ord a => Array1 a -> Array1 a -> Bool
>= :: Array1 a -> Array1 a -> Bool
$cmax :: forall a. Ord a => Array1 a -> Array1 a -> Array1 a
max :: Array1 a -> Array1 a -> Array1 a
$cmin :: forall a. Ord a => Array1 a -> Array1 a -> Array1 a
min :: Array1 a -> Array1 a -> Array1 a
Ord, Int -> Array1 a -> ShowS
[Array1 a] -> ShowS
Array1 a -> String
(Int -> Array1 a -> ShowS)
-> (Array1 a -> String) -> ([Array1 a] -> ShowS) -> Show (Array1 a)
forall a. Show a => Int -> Array1 a -> ShowS
forall a. Show a => [Array1 a] -> ShowS
forall a. Show a => Array1 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Array1 a -> ShowS
showsPrec :: Int -> Array1 a -> ShowS
$cshow :: forall a. Show a => Array1 a -> String
show :: Array1 a -> String
$cshowList :: forall a. Show a => [Array1 a] -> ShowS
showList :: [Array1 a] -> ShowS
Show)
unArray1 :: Array1 a -> [a]
unArray1 :: forall a. Array1 a -> [a]
unArray1 (Array1 [a]
a) = [a]
a
instance PQFormat t => PQFormat (Array1 t) where
pqFormat :: ByteString
pqFormat = forall t. PQFormat t => ByteString
pqFormat @t ByteString -> ByteString -> ByteString
`BS.append` String -> ByteString
BS.pack String
"[]"
instance FromSQL t => FromSQL (Array1 t) where
type PQBase (Array1 t) = PGarray
fromSQL :: Maybe (PQBase (Array1 t)) -> IO (Array1 t)
fromSQL Maybe (PQBase (Array1 t))
Nothing = IO (Array1 t)
forall a. IO a
unexpectedNULL
fromSQL (Just PQBase (Array1 t)
arr) = ([t] -> Array1 t)
-> PGarray
-> (Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr (PQBase t) -> CString -> IO t)
-> IO (Array1 t)
forall a array t.
(PQFormat t, Storable a) =>
([t] -> array)
-> PGarray
-> (Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t)
-> IO array
getArray1 [t] -> Array1 t
forall a. [a] -> Array1 a
Array1 PGarray
PQBase (Array1 t)
arr Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr (PQBase t) -> CString -> IO t
forall {b}.
FromSQL b =>
Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr (PQBase b) -> CString -> IO b
getItem
where
getItem :: Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr (PQBase b) -> CString -> IO b
getItem Ptr PGresult
res Ptr PGerror
err CInt
i Ptr (PQBase b)
ptr CString
fmt = do
Ptr PGerror -> String -> CInt -> IO ()
verifyPQTRes Ptr PGerror
err String
"fromSQL (Array1)" (CInt -> IO ()) -> IO CInt -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr (PQBase b)
-> IO CInt
forall t1.
Ptr PGresult
-> Ptr PGerror -> CInt -> CString -> CInt -> Ptr t1 -> IO CInt
c_PQgetf1 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
0 Ptr (PQBase b)
ptr
CInt
isNull <- Ptr PGresult -> CInt -> CInt -> IO CInt
c_PQgetisnull Ptr PGresult
res CInt
i CInt
0
Maybe (PQBase b)
mbase <- if CInt
isNull CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1 then Maybe (PQBase b) -> IO (Maybe (PQBase b))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (PQBase b)
forall a. Maybe a
Nothing else PQBase b -> Maybe (PQBase b)
forall a. a -> Maybe a
Just (PQBase b -> Maybe (PQBase b))
-> IO (PQBase b) -> IO (Maybe (PQBase b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (PQBase b) -> IO (PQBase b)
forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase b)
ptr
Maybe (PQBase b) -> IO b
forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL Maybe (PQBase b)
mbase
instance ToSQL t => ToSQL (Array1 t) where
type PQDest (Array1 t) = PGarray
toSQL :: forall r.
Array1 t
-> ParamAllocator -> (Ptr (PQDest (Array1 t)) -> IO r) -> IO r
toSQL (Array1 [t]
arr) pa :: ParamAllocator
pa@(ParamAllocator forall r. (Ptr PGparam -> IO r) -> IO r
allocParam) Ptr (PQDest (Array1 t)) -> IO r
conv =
(Ptr PGerror -> IO r) -> IO r
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr PGerror -> IO r) -> IO r) -> (Ptr PGerror -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> (Ptr PGparam -> IO r) -> IO r
forall r. (Ptr PGparam -> IO r) -> IO r
allocParam ((Ptr PGparam -> IO r) -> IO r) -> (Ptr PGparam -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr PGparam
param ->
[t]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
forall t r.
PQFormat t =>
[t]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
putArray1 [t]
arr Ptr PGparam
param Ptr PGarray -> IO r
Ptr (PQDest (Array1 t)) -> IO r
conv ((CString -> t -> IO ()) -> IO r)
-> (CString -> t -> IO ()) -> IO r
forall a b. (a -> b) -> a -> b
$ \CString
fmt t
item ->
t -> ParamAllocator -> (Ptr (PQDest t) -> IO CInt) -> IO CInt
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
item ParamAllocator
pa (Ptr PGparam -> Ptr PGerror -> CString -> Ptr (PQDest t) -> IO CInt
forall t. Ptr PGparam -> Ptr PGerror -> CString -> Ptr t -> IO CInt
c_PQputf1 Ptr PGparam
param Ptr PGerror
err CString
fmt)
IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr PGerror -> String -> CInt -> IO ()
verifyPQTRes Ptr PGerror
err String
"toSQL (Array1)"
newtype CompositeArray1 a = CompositeArray1 [a]
deriving (CompositeArray1 a -> CompositeArray1 a -> Bool
(CompositeArray1 a -> CompositeArray1 a -> Bool)
-> (CompositeArray1 a -> CompositeArray1 a -> Bool)
-> Eq (CompositeArray1 a)
forall a. Eq a => CompositeArray1 a -> CompositeArray1 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => CompositeArray1 a -> CompositeArray1 a -> Bool
== :: CompositeArray1 a -> CompositeArray1 a -> Bool
$c/= :: forall a. Eq a => CompositeArray1 a -> CompositeArray1 a -> Bool
/= :: CompositeArray1 a -> CompositeArray1 a -> Bool
Eq, (forall a b. (a -> b) -> CompositeArray1 a -> CompositeArray1 b)
-> (forall a b. a -> CompositeArray1 b -> CompositeArray1 a)
-> Functor CompositeArray1
forall a b. a -> CompositeArray1 b -> CompositeArray1 a
forall a b. (a -> b) -> CompositeArray1 a -> CompositeArray1 b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CompositeArray1 a -> CompositeArray1 b
fmap :: forall a b. (a -> b) -> CompositeArray1 a -> CompositeArray1 b
$c<$ :: forall a b. a -> CompositeArray1 b -> CompositeArray1 a
<$ :: forall a b. a -> CompositeArray1 b -> CompositeArray1 a
Functor, Eq (CompositeArray1 a)
Eq (CompositeArray1 a) =>
(CompositeArray1 a -> CompositeArray1 a -> Ordering)
-> (CompositeArray1 a -> CompositeArray1 a -> Bool)
-> (CompositeArray1 a -> CompositeArray1 a -> Bool)
-> (CompositeArray1 a -> CompositeArray1 a -> Bool)
-> (CompositeArray1 a -> CompositeArray1 a -> Bool)
-> (CompositeArray1 a -> CompositeArray1 a -> CompositeArray1 a)
-> (CompositeArray1 a -> CompositeArray1 a -> CompositeArray1 a)
-> Ord (CompositeArray1 a)
CompositeArray1 a -> CompositeArray1 a -> Bool
CompositeArray1 a -> CompositeArray1 a -> Ordering
CompositeArray1 a -> CompositeArray1 a -> CompositeArray1 a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (CompositeArray1 a)
forall a. Ord a => CompositeArray1 a -> CompositeArray1 a -> Bool
forall a.
Ord a =>
CompositeArray1 a -> CompositeArray1 a -> Ordering
forall a.
Ord a =>
CompositeArray1 a -> CompositeArray1 a -> CompositeArray1 a
$ccompare :: forall a.
Ord a =>
CompositeArray1 a -> CompositeArray1 a -> Ordering
compare :: CompositeArray1 a -> CompositeArray1 a -> Ordering
$c< :: forall a. Ord a => CompositeArray1 a -> CompositeArray1 a -> Bool
< :: CompositeArray1 a -> CompositeArray1 a -> Bool
$c<= :: forall a. Ord a => CompositeArray1 a -> CompositeArray1 a -> Bool
<= :: CompositeArray1 a -> CompositeArray1 a -> Bool
$c> :: forall a. Ord a => CompositeArray1 a -> CompositeArray1 a -> Bool
> :: CompositeArray1 a -> CompositeArray1 a -> Bool
$c>= :: forall a. Ord a => CompositeArray1 a -> CompositeArray1 a -> Bool
>= :: CompositeArray1 a -> CompositeArray1 a -> Bool
$cmax :: forall a.
Ord a =>
CompositeArray1 a -> CompositeArray1 a -> CompositeArray1 a
max :: CompositeArray1 a -> CompositeArray1 a -> CompositeArray1 a
$cmin :: forall a.
Ord a =>
CompositeArray1 a -> CompositeArray1 a -> CompositeArray1 a
min :: CompositeArray1 a -> CompositeArray1 a -> CompositeArray1 a
Ord, Int -> CompositeArray1 a -> ShowS
[CompositeArray1 a] -> ShowS
CompositeArray1 a -> String
(Int -> CompositeArray1 a -> ShowS)
-> (CompositeArray1 a -> String)
-> ([CompositeArray1 a] -> ShowS)
-> Show (CompositeArray1 a)
forall a. Show a => Int -> CompositeArray1 a -> ShowS
forall a. Show a => [CompositeArray1 a] -> ShowS
forall a. Show a => CompositeArray1 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> CompositeArray1 a -> ShowS
showsPrec :: Int -> CompositeArray1 a -> ShowS
$cshow :: forall a. Show a => CompositeArray1 a -> String
show :: CompositeArray1 a -> String
$cshowList :: forall a. Show a => [CompositeArray1 a] -> ShowS
showList :: [CompositeArray1 a] -> ShowS
Show)
unCompositeArray1 :: CompositeArray1 a -> [a]
unCompositeArray1 :: forall a. CompositeArray1 a -> [a]
unCompositeArray1 (CompositeArray1 [a]
a) = [a]
a
instance PQFormat t => PQFormat (CompositeArray1 t) where
pqFormat :: ByteString
pqFormat = forall t. PQFormat t => ByteString
pqFormat @(Array1 t)
instance CompositeFromSQL t => FromSQL (CompositeArray1 t) where
type PQBase (CompositeArray1 t) = PGarray
fromSQL :: Maybe (PQBase (CompositeArray1 t)) -> IO (CompositeArray1 t)
fromSQL Maybe (PQBase (CompositeArray1 t))
Nothing = IO (CompositeArray1 t)
forall a. IO a
unexpectedNULL
fromSQL (Just PQBase (CompositeArray1 t)
arr) = ([t] -> CompositeArray1 t)
-> PGarray
-> (Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr CInt -> CString -> IO t)
-> IO (CompositeArray1 t)
forall a array t.
(PQFormat t, Storable a) =>
([t] -> array)
-> PGarray
-> (Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t)
-> IO array
getArray1 [t] -> CompositeArray1 t
forall a. [a] -> CompositeArray1 a
CompositeArray1 PGarray
PQBase (CompositeArray1 t)
arr Ptr PGresult -> Ptr PGerror -> CInt -> Ptr CInt -> CString -> IO t
forall {b} {p}.
CompositeFromSQL b =>
Ptr PGresult -> Ptr PGerror -> CInt -> Ptr CInt -> p -> IO b
getItem
where
getItem :: Ptr PGresult -> Ptr PGerror -> CInt -> Ptr CInt -> p -> IO b
getItem Ptr PGresult
res Ptr PGerror
err CInt
i (Ptr CInt
_ :: Ptr CInt) p
_ = CompositeRow b -> b
forall t. CompositeFromSQL t => CompositeRow t -> t
toComposite (CompositeRow b -> b) -> IO (CompositeRow b) -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> IO (CompositeRow b)
forall row.
FromRow row =>
Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> IO row
fromRow Ptr PGresult
res Ptr PGerror
err CInt
0 CInt
i
instance CompositeToSQL t => ToSQL (CompositeArray1 t) where
type PQDest (CompositeArray1 t) = PGarray
toSQL :: forall r.
CompositeArray1 t
-> ParamAllocator
-> (Ptr (PQDest (CompositeArray1 t)) -> IO r)
-> IO r
toSQL (CompositeArray1 [t]
arr) pa :: ParamAllocator
pa@(ParamAllocator forall r. (Ptr PGparam -> IO r) -> IO r
allocParam) Ptr (PQDest (CompositeArray1 t)) -> IO r
conv =
(Ptr PGerror -> IO r) -> IO r
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr PGerror -> IO r) -> IO r) -> (Ptr PGerror -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> (Ptr PGparam -> IO r) -> IO r
forall r. (Ptr PGparam -> IO r) -> IO r
allocParam ((Ptr PGparam -> IO r) -> IO r) -> (Ptr PGparam -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr PGparam
param ->
[t]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
forall t r.
PQFormat t =>
[t]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
putArray1 [t]
arr Ptr PGparam
param Ptr PGarray -> IO r
Ptr (PQDest (CompositeArray1 t)) -> IO r
conv ((CString -> t -> IO ()) -> IO r)
-> (CString -> t -> IO ()) -> IO r
forall a b. (a -> b) -> a -> b
$ \CString
fmt t
item ->
Composite t
-> ParamAllocator
-> (Ptr (PQDest (Composite t)) -> IO CInt)
-> IO CInt
forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
forall r.
Composite t
-> ParamAllocator -> (Ptr (PQDest (Composite t)) -> IO r) -> IO r
toSQL (t -> Composite t
forall a. a -> Composite a
Composite t
item) ParamAllocator
pa (Ptr PGparam -> Ptr PGerror -> CString -> Ptr PGparam -> IO CInt
forall t. Ptr PGparam -> Ptr PGerror -> CString -> Ptr t -> IO CInt
c_PQputf1 Ptr PGparam
param Ptr PGerror
err CString
fmt)
IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr PGerror -> String -> CInt -> IO ()
verifyPQTRes Ptr PGerror
err String
"toSQL (CompositeArray1)"
putArray1
:: forall t r
. PQFormat t
=> [t]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
putArray1 :: forall t r.
PQFormat t =>
[t]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
putArray1 [t]
arr Ptr PGparam
param Ptr PGarray -> IO r
conv CString -> t -> IO ()
putItem = do
forall t. PQFormat t => ByteString
pqFormat0 @t ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
`BS.unsafeUseAsCString` ([t] -> (t -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [t]
arr ((t -> IO ()) -> IO ())
-> (CString -> t -> IO ()) -> CString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> t -> IO ()
putItem)
PGarray -> (Ptr PGarray -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr
( PGarray
{ pgArrayNDims :: CInt
pgArrayNDims = CInt
0
, pgArrayLBound :: Vector CInt
pgArrayLBound = Vector CInt
forall a. Storable a => Vector a
V.empty
, pgArrayDims :: Vector CInt
pgArrayDims = Vector CInt
forall a. Storable a => Vector a
V.empty
, pgArrayParam :: Ptr PGparam
pgArrayParam = Ptr PGparam
param
, pgArrayRes :: Ptr PGresult
pgArrayRes = Ptr PGresult
forall a. Ptr a
nullPtr
}
)
Ptr PGarray -> IO r
conv
getArray1
:: forall a array t
. (PQFormat t, Storable a)
=> ([t] -> array)
-> PGarray
-> (Ptr PGresult -> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t)
-> IO array
getArray1 :: forall a array t.
(PQFormat t, Storable a) =>
([t] -> array)
-> PGarray
-> (Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t)
-> IO array
getArray1 [t] -> array
con PGarray {Ptr PGresult
Ptr PGparam
CInt
Vector CInt
pgArrayNDims :: PGarray -> CInt
pgArrayLBound :: PGarray -> Vector CInt
pgArrayDims :: PGarray -> Vector CInt
pgArrayParam :: PGarray -> Ptr PGparam
pgArrayRes :: PGarray -> Ptr PGresult
pgArrayNDims :: CInt
pgArrayLBound :: Vector CInt
pgArrayDims :: Vector CInt
pgArrayParam :: Ptr PGparam
pgArrayRes :: Ptr PGresult
..} Ptr PGresult -> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t
getItem =
(IO array -> IO () -> IO array) -> IO () -> IO array -> IO array
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO array -> IO () -> IO array
forall a b. IO a -> IO b -> IO a
E.finally (Ptr PGresult -> IO ()
c_PQclear Ptr PGresult
pgArrayRes) (IO array -> IO array) -> IO array -> IO array
forall a b. (a -> b) -> a -> b
$
if CInt
pgArrayNDims CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
1
then
ArrayDimensionMismatch -> IO array
forall e a. Exception e => e -> IO a
E.throwIO
ArrayDimensionMismatch
{ arrDimExpected :: Int
arrDimExpected = Int
1
, arrDimDelivered :: Int
arrDimDelivered = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
pgArrayNDims
}
else do
CInt
size <- Ptr PGresult -> IO CInt
c_PQntuples Ptr PGresult
pgArrayRes
(Ptr PGerror -> IO array) -> IO array
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr PGerror -> IO array) -> IO array)
-> (Ptr PGerror -> IO array) -> IO array
forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> (Ptr a -> IO array) -> IO array
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr a -> IO array) -> IO array)
-> (Ptr a -> IO array) -> IO array
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr ->
forall t. PQFormat t => ByteString
pqFormat0 @t
ByteString -> (CString -> IO array) -> IO array
forall a. ByteString -> (CString -> IO a) -> IO a
`BS.unsafeUseAsCString` [t] -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO array
loop [] (CInt
size CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1) Ptr PGerror
err Ptr a
ptr
where
loop :: [t] -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO array
loop :: [t] -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO array
loop [t]
acc !CInt
i Ptr PGerror
err Ptr a
ptr CString
fmt = case CInt
i of
-1 -> array -> IO array
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (array -> IO array) -> ([t] -> array) -> [t] -> IO array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [t] -> array
con ([t] -> IO array) -> [t] -> IO array
forall a b. (a -> b) -> a -> b
$ [t]
acc
CInt
_ -> do
t
item <- Ptr PGresult -> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t
getItem Ptr PGresult
pgArrayRes Ptr PGerror
err CInt
i Ptr a
ptr CString
fmt IO t -> (SomeException -> IO t) -> IO t
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` CInt -> SomeException -> IO t
forall a. CInt -> SomeException -> IO a
rethrowWithArrayError CInt
i
[t] -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO array
loop (t
item t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
acc) (CInt
i CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1) Ptr PGerror
err Ptr a
ptr CString
fmt
newtype Array2 a = Array2 [[a]]
deriving (Array2 a -> Array2 a -> Bool
(Array2 a -> Array2 a -> Bool)
-> (Array2 a -> Array2 a -> Bool) -> Eq (Array2 a)
forall a. Eq a => Array2 a -> Array2 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Array2 a -> Array2 a -> Bool
== :: Array2 a -> Array2 a -> Bool
$c/= :: forall a. Eq a => Array2 a -> Array2 a -> Bool
/= :: Array2 a -> Array2 a -> Bool
Eq, (forall a b. (a -> b) -> Array2 a -> Array2 b)
-> (forall a b. a -> Array2 b -> Array2 a) -> Functor Array2
forall a b. a -> Array2 b -> Array2 a
forall a b. (a -> b) -> Array2 a -> Array2 b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Array2 a -> Array2 b
fmap :: forall a b. (a -> b) -> Array2 a -> Array2 b
$c<$ :: forall a b. a -> Array2 b -> Array2 a
<$ :: forall a b. a -> Array2 b -> Array2 a
Functor, Eq (Array2 a)
Eq (Array2 a) =>
(Array2 a -> Array2 a -> Ordering)
-> (Array2 a -> Array2 a -> Bool)
-> (Array2 a -> Array2 a -> Bool)
-> (Array2 a -> Array2 a -> Bool)
-> (Array2 a -> Array2 a -> Bool)
-> (Array2 a -> Array2 a -> Array2 a)
-> (Array2 a -> Array2 a -> Array2 a)
-> Ord (Array2 a)
Array2 a -> Array2 a -> Bool
Array2 a -> Array2 a -> Ordering
Array2 a -> Array2 a -> Array2 a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Array2 a)
forall a. Ord a => Array2 a -> Array2 a -> Bool
forall a. Ord a => Array2 a -> Array2 a -> Ordering
forall a. Ord a => Array2 a -> Array2 a -> Array2 a
$ccompare :: forall a. Ord a => Array2 a -> Array2 a -> Ordering
compare :: Array2 a -> Array2 a -> Ordering
$c< :: forall a. Ord a => Array2 a -> Array2 a -> Bool
< :: Array2 a -> Array2 a -> Bool
$c<= :: forall a. Ord a => Array2 a -> Array2 a -> Bool
<= :: Array2 a -> Array2 a -> Bool
$c> :: forall a. Ord a => Array2 a -> Array2 a -> Bool
> :: Array2 a -> Array2 a -> Bool
$c>= :: forall a. Ord a => Array2 a -> Array2 a -> Bool
>= :: Array2 a -> Array2 a -> Bool
$cmax :: forall a. Ord a => Array2 a -> Array2 a -> Array2 a
max :: Array2 a -> Array2 a -> Array2 a
$cmin :: forall a. Ord a => Array2 a -> Array2 a -> Array2 a
min :: Array2 a -> Array2 a -> Array2 a
Ord, Int -> Array2 a -> ShowS
[Array2 a] -> ShowS
Array2 a -> String
(Int -> Array2 a -> ShowS)
-> (Array2 a -> String) -> ([Array2 a] -> ShowS) -> Show (Array2 a)
forall a. Show a => Int -> Array2 a -> ShowS
forall a. Show a => [Array2 a] -> ShowS
forall a. Show a => Array2 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Array2 a -> ShowS
showsPrec :: Int -> Array2 a -> ShowS
$cshow :: forall a. Show a => Array2 a -> String
show :: Array2 a -> String
$cshowList :: forall a. Show a => [Array2 a] -> ShowS
showList :: [Array2 a] -> ShowS
Show)
unArray2 :: Array2 a -> [[a]]
unArray2 :: forall a. Array2 a -> [[a]]
unArray2 (Array2 [[a]]
a) = [[a]]
a
instance PQFormat t => PQFormat (Array2 t) where
pqFormat :: ByteString
pqFormat = forall t. PQFormat t => ByteString
pqFormat @(Array1 t)
instance FromSQL t => FromSQL (Array2 t) where
type PQBase (Array2 t) = PGarray
fromSQL :: Maybe (PQBase (Array2 t)) -> IO (Array2 t)
fromSQL Maybe (PQBase (Array2 t))
Nothing = IO (Array2 t)
forall a. IO a
unexpectedNULL
fromSQL (Just PQBase (Array2 t)
arr) = ([[t]] -> Array2 t)
-> PGarray
-> (Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr (PQBase t) -> CString -> IO t)
-> IO (Array2 t)
forall a array t.
(PQFormat t, Storable a) =>
([[t]] -> array)
-> PGarray
-> (Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t)
-> IO array
getArray2 [[t]] -> Array2 t
forall a. [[a]] -> Array2 a
Array2 PGarray
PQBase (Array2 t)
arr Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr (PQBase t) -> CString -> IO t
forall {b}.
FromSQL b =>
Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr (PQBase b) -> CString -> IO b
getItem
where
getItem :: Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr (PQBase b) -> CString -> IO b
getItem Ptr PGresult
res Ptr PGerror
err CInt
i Ptr (PQBase b)
ptr CString
fmt = do
Ptr PGerror -> String -> CInt -> IO ()
verifyPQTRes Ptr PGerror
err String
"fromSQL (Array2)" (CInt -> IO ()) -> IO CInt -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr PGresult
-> Ptr PGerror
-> CInt
-> CString
-> CInt
-> Ptr (PQBase b)
-> IO CInt
forall t1.
Ptr PGresult
-> Ptr PGerror -> CInt -> CString -> CInt -> Ptr t1 -> IO CInt
c_PQgetf1 Ptr PGresult
res Ptr PGerror
err CInt
i CString
fmt CInt
0 Ptr (PQBase b)
ptr
CInt
isNull <- Ptr PGresult -> CInt -> CInt -> IO CInt
c_PQgetisnull Ptr PGresult
res CInt
i CInt
0
Maybe (PQBase b)
mbase <- if CInt
isNull CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1 then Maybe (PQBase b) -> IO (Maybe (PQBase b))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (PQBase b)
forall a. Maybe a
Nothing else PQBase b -> Maybe (PQBase b)
forall a. a -> Maybe a
Just (PQBase b -> Maybe (PQBase b))
-> IO (PQBase b) -> IO (Maybe (PQBase b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (PQBase b) -> IO (PQBase b)
forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase b)
ptr
Maybe (PQBase b) -> IO b
forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL Maybe (PQBase b)
mbase
instance ToSQL t => ToSQL (Array2 t) where
type PQDest (Array2 t) = PGarray
toSQL :: forall r.
Array2 t
-> ParamAllocator -> (Ptr (PQDest (Array2 t)) -> IO r) -> IO r
toSQL (Array2 [[t]]
arr) pa :: ParamAllocator
pa@(ParamAllocator forall r. (Ptr PGparam -> IO r) -> IO r
allocParam) Ptr (PQDest (Array2 t)) -> IO r
conv =
(Ptr PGerror -> IO r) -> IO r
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr PGerror -> IO r) -> IO r) -> (Ptr PGerror -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> (Ptr PGparam -> IO r) -> IO r
forall r. (Ptr PGparam -> IO r) -> IO r
allocParam ((Ptr PGparam -> IO r) -> IO r) -> (Ptr PGparam -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr PGparam
param ->
[[t]]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
forall t r.
PQFormat t =>
[[t]]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
putArray2 [[t]]
arr Ptr PGparam
param Ptr PGarray -> IO r
Ptr (PQDest (Array2 t)) -> IO r
conv ((CString -> t -> IO ()) -> IO r)
-> (CString -> t -> IO ()) -> IO r
forall a b. (a -> b) -> a -> b
$ \CString
fmt t
item ->
t -> ParamAllocator -> (Ptr (PQDest t) -> IO CInt) -> IO CInt
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
item ParamAllocator
pa (Ptr PGparam -> Ptr PGerror -> CString -> Ptr (PQDest t) -> IO CInt
forall t. Ptr PGparam -> Ptr PGerror -> CString -> Ptr t -> IO CInt
c_PQputf1 Ptr PGparam
param Ptr PGerror
err CString
fmt)
IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr PGerror -> String -> CInt -> IO ()
verifyPQTRes Ptr PGerror
err String
"toSQL (Array2)"
newtype CompositeArray2 a = CompositeArray2 [[a]]
deriving (CompositeArray2 a -> CompositeArray2 a -> Bool
(CompositeArray2 a -> CompositeArray2 a -> Bool)
-> (CompositeArray2 a -> CompositeArray2 a -> Bool)
-> Eq (CompositeArray2 a)
forall a. Eq a => CompositeArray2 a -> CompositeArray2 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => CompositeArray2 a -> CompositeArray2 a -> Bool
== :: CompositeArray2 a -> CompositeArray2 a -> Bool
$c/= :: forall a. Eq a => CompositeArray2 a -> CompositeArray2 a -> Bool
/= :: CompositeArray2 a -> CompositeArray2 a -> Bool
Eq, (forall a b. (a -> b) -> CompositeArray2 a -> CompositeArray2 b)
-> (forall a b. a -> CompositeArray2 b -> CompositeArray2 a)
-> Functor CompositeArray2
forall a b. a -> CompositeArray2 b -> CompositeArray2 a
forall a b. (a -> b) -> CompositeArray2 a -> CompositeArray2 b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CompositeArray2 a -> CompositeArray2 b
fmap :: forall a b. (a -> b) -> CompositeArray2 a -> CompositeArray2 b
$c<$ :: forall a b. a -> CompositeArray2 b -> CompositeArray2 a
<$ :: forall a b. a -> CompositeArray2 b -> CompositeArray2 a
Functor, Eq (CompositeArray2 a)
Eq (CompositeArray2 a) =>
(CompositeArray2 a -> CompositeArray2 a -> Ordering)
-> (CompositeArray2 a -> CompositeArray2 a -> Bool)
-> (CompositeArray2 a -> CompositeArray2 a -> Bool)
-> (CompositeArray2 a -> CompositeArray2 a -> Bool)
-> (CompositeArray2 a -> CompositeArray2 a -> Bool)
-> (CompositeArray2 a -> CompositeArray2 a -> CompositeArray2 a)
-> (CompositeArray2 a -> CompositeArray2 a -> CompositeArray2 a)
-> Ord (CompositeArray2 a)
CompositeArray2 a -> CompositeArray2 a -> Bool
CompositeArray2 a -> CompositeArray2 a -> Ordering
CompositeArray2 a -> CompositeArray2 a -> CompositeArray2 a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (CompositeArray2 a)
forall a. Ord a => CompositeArray2 a -> CompositeArray2 a -> Bool
forall a.
Ord a =>
CompositeArray2 a -> CompositeArray2 a -> Ordering
forall a.
Ord a =>
CompositeArray2 a -> CompositeArray2 a -> CompositeArray2 a
$ccompare :: forall a.
Ord a =>
CompositeArray2 a -> CompositeArray2 a -> Ordering
compare :: CompositeArray2 a -> CompositeArray2 a -> Ordering
$c< :: forall a. Ord a => CompositeArray2 a -> CompositeArray2 a -> Bool
< :: CompositeArray2 a -> CompositeArray2 a -> Bool
$c<= :: forall a. Ord a => CompositeArray2 a -> CompositeArray2 a -> Bool
<= :: CompositeArray2 a -> CompositeArray2 a -> Bool
$c> :: forall a. Ord a => CompositeArray2 a -> CompositeArray2 a -> Bool
> :: CompositeArray2 a -> CompositeArray2 a -> Bool
$c>= :: forall a. Ord a => CompositeArray2 a -> CompositeArray2 a -> Bool
>= :: CompositeArray2 a -> CompositeArray2 a -> Bool
$cmax :: forall a.
Ord a =>
CompositeArray2 a -> CompositeArray2 a -> CompositeArray2 a
max :: CompositeArray2 a -> CompositeArray2 a -> CompositeArray2 a
$cmin :: forall a.
Ord a =>
CompositeArray2 a -> CompositeArray2 a -> CompositeArray2 a
min :: CompositeArray2 a -> CompositeArray2 a -> CompositeArray2 a
Ord, Int -> CompositeArray2 a -> ShowS
[CompositeArray2 a] -> ShowS
CompositeArray2 a -> String
(Int -> CompositeArray2 a -> ShowS)
-> (CompositeArray2 a -> String)
-> ([CompositeArray2 a] -> ShowS)
-> Show (CompositeArray2 a)
forall a. Show a => Int -> CompositeArray2 a -> ShowS
forall a. Show a => [CompositeArray2 a] -> ShowS
forall a. Show a => CompositeArray2 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> CompositeArray2 a -> ShowS
showsPrec :: Int -> CompositeArray2 a -> ShowS
$cshow :: forall a. Show a => CompositeArray2 a -> String
show :: CompositeArray2 a -> String
$cshowList :: forall a. Show a => [CompositeArray2 a] -> ShowS
showList :: [CompositeArray2 a] -> ShowS
Show)
unCompositeArray2 :: CompositeArray2 a -> [[a]]
unCompositeArray2 :: forall a. CompositeArray2 a -> [[a]]
unCompositeArray2 (CompositeArray2 [[a]]
a) = [[a]]
a
instance PQFormat t => PQFormat (CompositeArray2 t) where
pqFormat :: ByteString
pqFormat = forall t. PQFormat t => ByteString
pqFormat @(Array2 t)
instance CompositeFromSQL t => FromSQL (CompositeArray2 t) where
type PQBase (CompositeArray2 t) = PGarray
fromSQL :: Maybe (PQBase (CompositeArray2 t)) -> IO (CompositeArray2 t)
fromSQL Maybe (PQBase (CompositeArray2 t))
Nothing = IO (CompositeArray2 t)
forall a. IO a
unexpectedNULL
fromSQL (Just PQBase (CompositeArray2 t)
arr) = ([[t]] -> CompositeArray2 t)
-> PGarray
-> (Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr CInt -> CString -> IO t)
-> IO (CompositeArray2 t)
forall a array t.
(PQFormat t, Storable a) =>
([[t]] -> array)
-> PGarray
-> (Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t)
-> IO array
getArray2 [[t]] -> CompositeArray2 t
forall a. [[a]] -> CompositeArray2 a
CompositeArray2 PGarray
PQBase (CompositeArray2 t)
arr Ptr PGresult -> Ptr PGerror -> CInt -> Ptr CInt -> CString -> IO t
forall {b} {p}.
CompositeFromSQL b =>
Ptr PGresult -> Ptr PGerror -> CInt -> Ptr CInt -> p -> IO b
getItem
where
getItem :: Ptr PGresult -> Ptr PGerror -> CInt -> Ptr CInt -> p -> IO b
getItem Ptr PGresult
res Ptr PGerror
err CInt
i (Ptr CInt
_ :: Ptr CInt) p
_ = CompositeRow b -> b
forall t. CompositeFromSQL t => CompositeRow t -> t
toComposite (CompositeRow b -> b) -> IO (CompositeRow b) -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> IO (CompositeRow b)
forall row.
FromRow row =>
Ptr PGresult -> Ptr PGerror -> CInt -> CInt -> IO row
fromRow Ptr PGresult
res Ptr PGerror
err CInt
0 CInt
i
instance CompositeToSQL t => ToSQL (CompositeArray2 t) where
type PQDest (CompositeArray2 t) = PGarray
toSQL :: forall r.
CompositeArray2 t
-> ParamAllocator
-> (Ptr (PQDest (CompositeArray2 t)) -> IO r)
-> IO r
toSQL (CompositeArray2 [[t]]
arr) pa :: ParamAllocator
pa@(ParamAllocator forall r. (Ptr PGparam -> IO r) -> IO r
allocParam) Ptr (PQDest (CompositeArray2 t)) -> IO r
conv =
(Ptr PGerror -> IO r) -> IO r
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr PGerror -> IO r) -> IO r) -> (Ptr PGerror -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> (Ptr PGparam -> IO r) -> IO r
forall r. (Ptr PGparam -> IO r) -> IO r
allocParam ((Ptr PGparam -> IO r) -> IO r) -> (Ptr PGparam -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr PGparam
param ->
[[t]]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
forall t r.
PQFormat t =>
[[t]]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
putArray2 [[t]]
arr Ptr PGparam
param Ptr PGarray -> IO r
Ptr (PQDest (CompositeArray2 t)) -> IO r
conv ((CString -> t -> IO ()) -> IO r)
-> (CString -> t -> IO ()) -> IO r
forall a b. (a -> b) -> a -> b
$ \CString
fmt t
item ->
Composite t
-> ParamAllocator
-> (Ptr (PQDest (Composite t)) -> IO CInt)
-> IO CInt
forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
forall r.
Composite t
-> ParamAllocator -> (Ptr (PQDest (Composite t)) -> IO r) -> IO r
toSQL (t -> Composite t
forall a. a -> Composite a
Composite t
item) ParamAllocator
pa (Ptr PGparam -> Ptr PGerror -> CString -> Ptr PGparam -> IO CInt
forall t. Ptr PGparam -> Ptr PGerror -> CString -> Ptr t -> IO CInt
c_PQputf1 Ptr PGparam
param Ptr PGerror
err CString
fmt)
IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr PGerror -> String -> CInt -> IO ()
verifyPQTRes Ptr PGerror
err String
"toSQL (CompositeArray2)"
putArray2
:: forall t r
. PQFormat t
=> [[t]]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
putArray2 :: forall t r.
PQFormat t =>
[[t]]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
putArray2 [[t]]
arr Ptr PGparam
param Ptr PGarray -> IO r
conv CString -> t -> IO ()
putItem = do
Vector CInt
dims <- forall t. PQFormat t => ByteString
pqFormat0 @t ByteString -> (CString -> IO (Vector CInt)) -> IO (Vector CInt)
forall a. ByteString -> (CString -> IO a) -> IO a
`BS.unsafeUseAsCString` [[t]] -> CInt -> CInt -> CString -> IO (Vector CInt)
loop [[t]]
arr CInt
0 CInt
0
PGarray -> (Ptr PGarray -> IO r) -> IO r
forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr
( PGarray
{ pgArrayNDims :: CInt
pgArrayNDims = CInt
2
, pgArrayLBound :: Vector CInt
pgArrayLBound = [CInt] -> Vector CInt
forall a. Storable a => [a] -> Vector a
V.fromList [CInt
1, CInt
1]
, pgArrayDims :: Vector CInt
pgArrayDims = Vector CInt
dims
, pgArrayParam :: Ptr PGparam
pgArrayParam = Ptr PGparam
param
, pgArrayRes :: Ptr PGresult
pgArrayRes = Ptr PGresult
forall a. Ptr a
nullPtr
}
)
Ptr PGarray -> IO r
conv
where
loop :: [[t]] -> CInt -> CInt -> CString -> IO (V.Vector CInt)
loop :: [[t]] -> CInt -> CInt -> CString -> IO (Vector CInt)
loop [[t]]
rows !CInt
size !CInt
innerSize CString
fmt = case [[t]]
rows of
[] -> Vector CInt -> IO (Vector CInt)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector CInt -> IO (Vector CInt))
-> ([CInt] -> Vector CInt) -> [CInt] -> IO (Vector CInt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CInt] -> Vector CInt
forall a. Storable a => [a] -> Vector a
V.fromList ([CInt] -> IO (Vector CInt)) -> [CInt] -> IO (Vector CInt)
forall a b. (a -> b) -> a -> b
$ [CInt
size, CInt
innerSize]
([t]
row : [[t]]
rest) -> do
CInt
nextInnerSize <- [t] -> CInt -> CString -> IO CInt
innLoop [t]
row CInt
0 CString
fmt
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
size CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
0 Bool -> Bool -> Bool
&& CInt
innerSize CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
nextInnerSize) (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
forall a. String -> IO a
hpqTypesError (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"putArray2: inner rows have different sizes"
[[t]] -> CInt -> CInt -> CString -> IO (Vector CInt)
loop [[t]]
rest (CInt
size CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
1) CInt
nextInnerSize CString
fmt
innLoop :: [t] -> CInt -> CString -> IO CInt
innLoop :: [t] -> CInt -> CString -> IO CInt
innLoop [t]
items !CInt
size CString
fmt = case [t]
items of
[] -> CInt -> IO CInt
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CInt
size
(t
item : [t]
rest) -> do
CString -> t -> IO ()
putItem CString
fmt t
item
[t] -> CInt -> CString -> IO CInt
innLoop [t]
rest (CInt
size CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
1) CString
fmt
getArray2
:: forall a array t
. (PQFormat t, Storable a)
=> ([[t]] -> array)
-> PGarray
-> (Ptr PGresult -> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t)
-> IO array
getArray2 :: forall a array t.
(PQFormat t, Storable a) =>
([[t]] -> array)
-> PGarray
-> (Ptr PGresult
-> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t)
-> IO array
getArray2 [[t]] -> array
con PGarray {Ptr PGresult
Ptr PGparam
CInt
Vector CInt
pgArrayNDims :: PGarray -> CInt
pgArrayLBound :: PGarray -> Vector CInt
pgArrayDims :: PGarray -> Vector CInt
pgArrayParam :: PGarray -> Ptr PGparam
pgArrayRes :: PGarray -> Ptr PGresult
pgArrayNDims :: CInt
pgArrayLBound :: Vector CInt
pgArrayDims :: Vector CInt
pgArrayParam :: Ptr PGparam
pgArrayRes :: Ptr PGresult
..} Ptr PGresult -> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t
getItem = (IO array -> IO () -> IO array) -> IO () -> IO array -> IO array
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO array -> IO () -> IO array
forall a b. IO a -> IO b -> IO a
E.finally (Ptr PGresult -> IO ()
c_PQclear Ptr PGresult
pgArrayRes) (IO array -> IO array) -> IO array -> IO array
forall a b. (a -> b) -> a -> b
$ do
if CInt
pgArrayNDims CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0 Bool -> Bool -> Bool
&& CInt
pgArrayNDims CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
2
then
ArrayDimensionMismatch -> IO array
forall e a. Exception e => e -> IO a
E.throwIO
ArrayDimensionMismatch
{ arrDimExpected :: Int
arrDimExpected = Int
2
, arrDimDelivered :: Int
arrDimDelivered = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
pgArrayNDims
}
else do
let dim2 :: CInt
dim2 = Vector CInt
pgArrayDims Vector CInt -> Int -> CInt
forall a. Storable a => Vector a -> Int -> a
V.! Int
1
CInt
size <- Ptr PGresult -> IO CInt
c_PQntuples Ptr PGresult
pgArrayRes
(Ptr a -> IO array) -> IO array
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr a -> IO array) -> IO array)
-> (Ptr a -> IO array) -> IO array
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> (Ptr PGerror -> IO array) -> IO array
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr PGerror -> IO array) -> IO array)
-> (Ptr PGerror -> IO array) -> IO array
forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err ->
forall t. PQFormat t => ByteString
pqFormat0 @t
ByteString -> (CString -> IO array) -> IO array
forall a. ByteString -> (CString -> IO a) -> IO a
`BS.unsafeUseAsCString` [[t]]
-> CInt -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO array
loop [] CInt
dim2 CInt
size Ptr PGerror
err Ptr a
ptr
where
loop :: [[t]] -> CInt -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO array
loop :: [[t]]
-> CInt -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO array
loop [[t]]
acc CInt
dim2 !CInt
i Ptr PGerror
err Ptr a
ptr CString
fmt = case CInt
i of
CInt
0 -> array -> IO array
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (array -> IO array) -> ([[t]] -> array) -> [[t]] -> IO array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[t]] -> array
con ([[t]] -> IO array) -> [[t]] -> IO array
forall a b. (a -> b) -> a -> b
$ [[t]]
acc
CInt
_ -> do
let i' :: CInt
i' = CInt
i CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
dim2
[t]
arr <- [t] -> CInt -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO [t]
innLoop [] (CInt
dim2 CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1) CInt
i' Ptr PGerror
err Ptr a
ptr CString
fmt
[[t]]
-> CInt -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO array
loop ([t]
arr [t] -> [[t]] -> [[t]]
forall a. a -> [a] -> [a]
: [[t]]
acc) CInt
dim2 CInt
i' Ptr PGerror
err Ptr a
ptr CString
fmt
innLoop :: [t] -> CInt -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO [t]
innLoop :: [t] -> CInt -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO [t]
innLoop [t]
acc !CInt
i CInt
baseIdx Ptr PGerror
err Ptr a
ptr CString
fmt = case CInt
i of
-1 -> [t] -> IO [t]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [t]
acc
CInt
_ -> do
let i' :: CInt
i' = CInt
baseIdx CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
i
t
item <- Ptr PGresult -> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t
getItem Ptr PGresult
pgArrayRes Ptr PGerror
err CInt
i' Ptr a
ptr CString
fmt IO t -> (SomeException -> IO t) -> IO t
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` CInt -> SomeException -> IO t
forall a. CInt -> SomeException -> IO a
rethrowWithArrayError CInt
i'
[t] -> CInt -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO [t]
innLoop (t
item t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
acc) (CInt
i CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1) CInt
baseIdx Ptr PGerror
err Ptr a
ptr CString
fmt