{-# LANGUAGE TypeApplications #-}
module Database.PostgreSQL.PQTypes.Array (
    -- * Array1
    Array1(..)
  , unArray1
  -- * CompositeArray1
  , CompositeArray1(..)
  , unCompositeArray1
  -- * Array2
  , Array2(..)
  , unArray2
  -- * CompositeArray2
  , CompositeArray2(..)
  , unCompositeArray2
  ) where

import Control.Monad
import Foreign.C
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import qualified Control.Exception as E
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Unsafe as BS
import qualified Data.Vector.Storable as V

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

-- | One dimensional array of non-composite elements.
newtype Array1 a = Array1 [a]
  deriving (Array1 a -> Array1 a -> Bool
forall a. Eq a => Array1 a -> Array1 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Array1 a -> Array1 a -> Bool
$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
Eq, 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
<$ :: forall a b. a -> Array1 b -> Array1 a
$c<$ :: forall a b. a -> Array1 b -> Array1 a
fmap :: forall a b. (a -> b) -> Array1 a -> Array1 b
$cfmap :: forall a b. (a -> b) -> Array1 a -> Array1 b
Functor, 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
min :: Array1 a -> Array1 a -> Array1 a
$cmin :: forall a. Ord a => Array1 a -> Array1 a -> Array1 a
max :: Array1 a -> Array1 a -> Array1 a
$cmax :: forall a. Ord a => Array1 a -> Array1 a -> Array1 a
>= :: 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
$c< :: forall a. Ord a => Array1 a -> Array1 a -> Bool
compare :: Array1 a -> Array1 a -> Ordering
$ccompare :: forall a. Ord a => Array1 a -> Array1 a -> Ordering
Ord, Int -> Array1 a -> ShowS
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
showList :: [Array1 a] -> ShowS
$cshowList :: forall a. Show a => [Array1 a] -> ShowS
show :: Array1 a -> String
$cshow :: forall a. Show a => Array1 a -> String
showsPrec :: Int -> Array1 a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Array1 a -> ShowS
Show)

-- | Extract list of elements from 'Array1'.
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 = forall a. IO a
unexpectedNULL
  fromSQL (Just PQBase (Array1 t)
arr) = 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. [a] -> Array1 a
Array1 PQBase (Array1 t)
arr 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)" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 forall a. Eq a => a -> a -> Bool
== CInt
1 then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase b)
ptr
        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 =
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> forall r. (Ptr PGparam -> IO r) -> IO r
allocParam forall a b. (a -> b) -> a -> b
$ \Ptr PGparam
param ->
    forall t r.
PQFormat t =>
[t]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
putArray1 [t]
arr Ptr PGparam
param Ptr (PQDest (Array1 t)) -> IO r
conv forall a b. (a -> b) -> a -> b
$ \CString
fmt t
item ->
      forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL t
item ParamAllocator
pa (forall t. Ptr PGparam -> Ptr PGerror -> CString -> Ptr t -> IO CInt
c_PQputf1 Ptr PGparam
param Ptr PGerror
err CString
fmt)
        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)"

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

-- | One dimensional array of composite elements.
newtype CompositeArray1 a = CompositeArray1 [a]
  deriving (CompositeArray1 a -> CompositeArray1 a -> Bool
forall a. Eq a => CompositeArray1 a -> CompositeArray1 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompositeArray1 a -> CompositeArray1 a -> Bool
$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
Eq, 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
<$ :: forall a b. a -> CompositeArray1 b -> CompositeArray1 a
$c<$ :: forall a b. a -> CompositeArray1 b -> CompositeArray1 a
fmap :: forall a b. (a -> b) -> CompositeArray1 a -> CompositeArray1 b
$cfmap :: forall a b. (a -> b) -> CompositeArray1 a -> CompositeArray1 b
Functor, 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
min :: CompositeArray1 a -> CompositeArray1 a -> CompositeArray1 a
$cmin :: forall a.
Ord a =>
CompositeArray1 a -> CompositeArray1 a -> CompositeArray1 a
max :: CompositeArray1 a -> CompositeArray1 a -> CompositeArray1 a
$cmax :: forall a.
Ord a =>
CompositeArray1 a -> CompositeArray1 a -> CompositeArray1 a
>= :: 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
$c< :: forall a. Ord a => CompositeArray1 a -> CompositeArray1 a -> Bool
compare :: CompositeArray1 a -> CompositeArray1 a -> Ordering
$ccompare :: forall a.
Ord a =>
CompositeArray1 a -> CompositeArray1 a -> Ordering
Ord, Int -> CompositeArray1 a -> ShowS
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
showList :: [CompositeArray1 a] -> ShowS
$cshowList :: forall a. Show a => [CompositeArray1 a] -> ShowS
show :: CompositeArray1 a -> String
$cshow :: forall a. Show a => CompositeArray1 a -> String
showsPrec :: Int -> CompositeArray1 a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CompositeArray1 a -> ShowS
Show)

-- | Extract list of elements from 'CompositeArray1'.
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 = forall a. IO a
unexpectedNULL
  fromSQL (Just PQBase (CompositeArray1 t)
arr) = 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. [a] -> CompositeArray1 a
CompositeArray1 PQBase (CompositeArray1 t)
arr 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
_ = forall t. CompositeFromSQL t => CompositeRow t -> t
toComposite forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 =
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> forall r. (Ptr PGparam -> IO r) -> IO r
allocParam forall a b. (a -> b) -> a -> b
$ \Ptr PGparam
param ->
    forall t r.
PQFormat t =>
[t]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
putArray1 [t]
arr Ptr PGparam
param Ptr (PQDest (CompositeArray1 t)) -> IO r
conv forall a b. (a -> b) -> a -> b
$ \CString
fmt t
item ->
      forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL (forall a. a -> Composite a
Composite t
item) ParamAllocator
pa (forall t. Ptr PGparam -> Ptr PGerror -> CString -> Ptr t -> IO CInt
c_PQputf1 Ptr PGparam
param Ptr PGerror
err CString
fmt)
        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)"

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

-- | Helper function for putting elements of
-- 'Array1' / 'CompositeArray1' into 'PGparam'.
putArray1 :: forall t r. PQFormat t
          => [t] -- ^ List of items to be put.
          -> Ptr PGparam -- ^ Inner 'PGparam' to put items into.
          -> (Ptr PGarray -> IO r) -- ^ Continuation that puts
          -- 'PGarray' into outer 'PGparam'.
          -> (CString -> t -> IO ()) -- ^ Function that takes item
          -- along with its format and puts it into inner 'PGparam'.
          -> 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 forall a. ByteString -> (CString -> IO a) -> IO a
`BS.unsafeUseAsCString` (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [t]
arr forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> t -> IO ()
putItem)
  forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (PGarray {
    pgArrayNDims :: CInt
pgArrayNDims = CInt
0
  , pgArrayLBound :: Vector CInt
pgArrayLBound = forall a. Storable a => Vector a
V.empty
  , pgArrayDims :: Vector CInt
pgArrayDims = forall a. Storable a => Vector a
V.empty
  , pgArrayParam :: Ptr PGparam
pgArrayParam = Ptr PGparam
param
  , pgArrayRes :: Ptr PGresult
pgArrayRes = forall a. Ptr a
nullPtr
  }) Ptr PGarray -> IO r
conv

-- | Helper function for getting elements of
-- 'Array1' / 'CompositeArray1' out of 'PGarray'.
getArray1 :: forall a array t. (PQFormat t, Storable a)
          => ([t] -> array) -- ^ Array constructor.
          -> PGarray -- ^ Source 'PGarray'.
          -> (Ptr PGresult -> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t) -- ^
          -- Function that takes an item with a given index
          -- out of 'PGresult' and stores it in provided 'Ptr'.
          -> 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
pgArrayRes :: Ptr PGresult
pgArrayParam :: Ptr PGparam
pgArrayDims :: Vector CInt
pgArrayLBound :: Vector CInt
pgArrayNDims :: CInt
pgArrayRes :: PGarray -> Ptr PGresult
pgArrayParam :: PGarray -> Ptr PGparam
pgArrayDims :: PGarray -> Vector CInt
pgArrayLBound :: PGarray -> Vector CInt
pgArrayNDims :: PGarray -> CInt
..} Ptr PGresult -> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t
getItem = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. IO a -> IO b -> IO a
E.finally (Ptr PGresult -> IO ()
c_PQclear Ptr PGresult
pgArrayRes) forall a b. (a -> b) -> a -> b
$
  if CInt
pgArrayNDims forall a. Ord a => a -> a -> Bool
> CInt
1
    then forall e a. Exception e => e -> IO a
E.throwIO ArrayDimensionMismatch {
        arrDimExpected :: Int
arrDimExpected = Int
1
      , arrDimDelivered :: Int
arrDimDelivered = 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
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> forall t. PQFormat t => ByteString
pqFormat0 @t
        forall a. ByteString -> (CString -> IO a) -> IO a
`BS.unsafeUseAsCString` [t] -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO array
loop [] (CInt
size 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [t] -> array
con 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 forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` forall a. CInt -> SomeException -> IO a
rethrowWithArrayError CInt
i
        [t] -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO array
loop (t
item forall a. a -> [a] -> [a]
: [t]
acc) (CInt
i forall a. Num a => a -> a -> a
- CInt
1) Ptr PGerror
err Ptr a
ptr CString
fmt

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

-- | Two dimensional array of non-composite elements.
newtype Array2 a = Array2 [[a]]
  deriving (Array2 a -> Array2 a -> Bool
forall a. Eq a => Array2 a -> Array2 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Array2 a -> Array2 a -> Bool
$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
Eq, 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
<$ :: forall a b. a -> Array2 b -> Array2 a
$c<$ :: forall a b. a -> Array2 b -> Array2 a
fmap :: forall a b. (a -> b) -> Array2 a -> Array2 b
$cfmap :: forall a b. (a -> b) -> Array2 a -> Array2 b
Functor, 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
min :: Array2 a -> Array2 a -> Array2 a
$cmin :: forall a. Ord a => Array2 a -> Array2 a -> Array2 a
max :: Array2 a -> Array2 a -> Array2 a
$cmax :: forall a. Ord a => Array2 a -> Array2 a -> Array2 a
>= :: 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
$c< :: forall a. Ord a => Array2 a -> Array2 a -> Bool
compare :: Array2 a -> Array2 a -> Ordering
$ccompare :: forall a. Ord a => Array2 a -> Array2 a -> Ordering
Ord, Int -> Array2 a -> ShowS
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
showList :: [Array2 a] -> ShowS
$cshowList :: forall a. Show a => [Array2 a] -> ShowS
show :: Array2 a -> String
$cshow :: forall a. Show a => Array2 a -> String
showsPrec :: Int -> Array2 a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Array2 a -> ShowS
Show)

-- | Extract list of elements from 'Array2'.
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 = forall a. IO a
unexpectedNULL
  fromSQL (Just PQBase (Array2 t)
arr) = 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. [[a]] -> Array2 a
Array2 PQBase (Array2 t)
arr 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)" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 forall a. Eq a => a -> a -> Bool
== CInt
1 then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr (PQBase b)
ptr
        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 =
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> forall r. (Ptr PGparam -> IO r) -> IO r
allocParam forall a b. (a -> b) -> a -> b
$ \Ptr PGparam
param ->
    forall t r.
PQFormat t =>
[[t]]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
putArray2 [[t]]
arr Ptr PGparam
param Ptr (PQDest (Array2 t)) -> IO r
conv forall a b. (a -> b) -> a -> b
$ \CString
fmt t
item ->
      forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL t
item ParamAllocator
pa (forall t. Ptr PGparam -> Ptr PGerror -> CString -> Ptr t -> IO CInt
c_PQputf1 Ptr PGparam
param Ptr PGerror
err CString
fmt)
          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)"

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

-- | Two dimensional array of composite elements.
newtype CompositeArray2 a = CompositeArray2 [[a]]
  deriving (CompositeArray2 a -> CompositeArray2 a -> Bool
forall a. Eq a => CompositeArray2 a -> CompositeArray2 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompositeArray2 a -> CompositeArray2 a -> Bool
$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
Eq, 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
<$ :: forall a b. a -> CompositeArray2 b -> CompositeArray2 a
$c<$ :: forall a b. a -> CompositeArray2 b -> CompositeArray2 a
fmap :: forall a b. (a -> b) -> CompositeArray2 a -> CompositeArray2 b
$cfmap :: forall a b. (a -> b) -> CompositeArray2 a -> CompositeArray2 b
Functor, 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
min :: CompositeArray2 a -> CompositeArray2 a -> CompositeArray2 a
$cmin :: forall a.
Ord a =>
CompositeArray2 a -> CompositeArray2 a -> CompositeArray2 a
max :: CompositeArray2 a -> CompositeArray2 a -> CompositeArray2 a
$cmax :: forall a.
Ord a =>
CompositeArray2 a -> CompositeArray2 a -> CompositeArray2 a
>= :: 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
$c< :: forall a. Ord a => CompositeArray2 a -> CompositeArray2 a -> Bool
compare :: CompositeArray2 a -> CompositeArray2 a -> Ordering
$ccompare :: forall a.
Ord a =>
CompositeArray2 a -> CompositeArray2 a -> Ordering
Ord, Int -> CompositeArray2 a -> ShowS
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
showList :: [CompositeArray2 a] -> ShowS
$cshowList :: forall a. Show a => [CompositeArray2 a] -> ShowS
show :: CompositeArray2 a -> String
$cshow :: forall a. Show a => CompositeArray2 a -> String
showsPrec :: Int -> CompositeArray2 a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CompositeArray2 a -> ShowS
Show)

-- | Extract list of elements from 'CompositeArray2'.
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 = forall a. IO a
unexpectedNULL
  fromSQL (Just PQBase (CompositeArray2 t)
arr) = 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. [[a]] -> CompositeArray2 a
CompositeArray2 PQBase (CompositeArray2 t)
arr 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
_ = forall t. CompositeFromSQL t => CompositeRow t -> t
toComposite forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 =
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> forall r. (Ptr PGparam -> IO r) -> IO r
allocParam forall a b. (a -> b) -> a -> b
$ \Ptr PGparam
param ->
    forall t r.
PQFormat t =>
[[t]]
-> Ptr PGparam
-> (Ptr PGarray -> IO r)
-> (CString -> t -> IO ())
-> IO r
putArray2 [[t]]
arr Ptr PGparam
param Ptr (PQDest (CompositeArray2 t)) -> IO r
conv forall a b. (a -> b) -> a -> b
$ \CString
fmt t
item ->
      forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL (forall a. a -> Composite a
Composite t
item) ParamAllocator
pa (forall t. Ptr PGparam -> Ptr PGerror -> CString -> Ptr t -> IO CInt
c_PQputf1 Ptr PGparam
param Ptr PGerror
err CString
fmt)
        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)"

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

-- | Helper function for putting elements of
-- 'Array2' / 'CompositeArray2' into 'PGparam'.
putArray2 :: forall t r. PQFormat t
          => [[t]] -- ^ List of items to be put.
          -> Ptr PGparam -- ^ Inner 'PGparam' to put items into.
          -> (Ptr PGarray -> IO r) -- ^ Continuation
          -- that puts 'PGarray' into outer 'PGparam'.
          -> (CString -> t -> IO ()) -- ^ Function that takes item
          -- along with its format and puts it into inner 'PGparam'.
          -> 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 forall a. ByteString -> (CString -> IO a) -> IO a
`BS.unsafeUseAsCString` [[t]] -> CInt -> CInt -> CString -> IO (Vector CInt)
loop [[t]]
arr CInt
0 CInt
0
  forall t r. Storable t => t -> (Ptr t -> IO r) -> IO r
putAsPtr (PGarray {
    pgArrayNDims :: CInt
pgArrayNDims = CInt
2
  , pgArrayLBound :: Vector CInt
pgArrayLBound = 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 = 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
      []           -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => [a] -> Vector a
V.fromList 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
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
size forall a. Ord a => a -> a -> Bool
> CInt
0 Bool -> Bool -> Bool
&& CInt
innerSize forall a. Eq a => a -> a -> Bool
/= CInt
nextInnerSize) forall a b. (a -> b) -> a -> b
$
          forall a. String -> IO a
hpqTypesError 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 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
      []            -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Num a => a -> a -> a
+ CInt
1) CString
fmt

-- | Helper function for getting elements of
-- 'Array2' / 'CompositeArray2' out of 'PGarray'.
getArray2 :: forall a array t. (PQFormat t, Storable a)
          => ([[t]] -> array) -- ^ Array constructor.
          -> PGarray -- ^ Source 'PGarray'.
          -> (Ptr PGresult -> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t) -- ^
          -- Function that takes an item with a given index
          -- out of 'PGresult' and stores it in provided 'Ptr'.
          -> 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
pgArrayRes :: Ptr PGresult
pgArrayParam :: Ptr PGparam
pgArrayDims :: Vector CInt
pgArrayLBound :: Vector CInt
pgArrayNDims :: CInt
pgArrayRes :: PGarray -> Ptr PGresult
pgArrayParam :: PGarray -> Ptr PGparam
pgArrayDims :: PGarray -> Vector CInt
pgArrayLBound :: PGarray -> Vector CInt
pgArrayNDims :: PGarray -> CInt
..} Ptr PGresult -> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t
getItem = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. IO a -> IO b -> IO a
E.finally (Ptr PGresult -> IO ()
c_PQclear Ptr PGresult
pgArrayRes) forall a b. (a -> b) -> a -> b
$ do
  if CInt
pgArrayNDims forall a. Eq a => a -> a -> Bool
/= CInt
0 Bool -> Bool -> Bool
&& CInt
pgArrayNDims forall a. Eq a => a -> a -> Bool
/= CInt
2
    then forall e a. Exception e => e -> IO a
E.throwIO ArrayDimensionMismatch {
        arrDimExpected :: Int
arrDimExpected = Int
2
      , arrDimDelivered :: Int
arrDimDelivered = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
pgArrayNDims
      }
    else do
      let dim2 :: CInt
dim2 = Vector CInt
pgArrayDims forall a. Storable a => Vector a -> Int -> a
V.! Int
1
      CInt
size <- Ptr PGresult -> IO CInt
c_PQntuples Ptr PGresult
pgArrayRes
      forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> forall t. PQFormat t => ByteString
pqFormat0 @t
        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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[t]] -> array
con forall a b. (a -> b) -> a -> b
$ [[t]]
acc
      CInt
_ -> do
        let i' :: CInt
i' = CInt
i forall a. Num a => a -> a -> a
- CInt
dim2
        [t]
arr <- [t] -> CInt -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO [t]
innLoop [] (CInt
dim2 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 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return [t]
acc
      CInt
_  -> do
        let i' :: CInt
i' = CInt
baseIdx 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 forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` forall a. CInt -> SomeException -> IO a
rethrowWithArrayError CInt
i'
        [t] -> CInt -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO [t]
innLoop (t
item forall a. a -> [a] -> [a]
: [t]
acc) (CInt
i forall a. Num a => a -> a -> a
- CInt
1) CInt
baseIdx Ptr PGerror
err Ptr a
ptr CString
fmt