module Database.PostgreSQL.PQTypes.Internal.Composite (
    registerComposites
  ) where

import Foreign.ForeignPtr
import Foreign.ForeignPtr.Unsafe
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Ptr
import qualified Data.Text as T

import Database.PostgreSQL.PQTypes.Internal.C.Interface
import Database.PostgreSQL.PQTypes.Internal.C.Types
import Database.PostgreSQL.PQTypes.Internal.Utils

-- | Register a list of composite types.
registerComposites :: Ptr PGconn -> [T.Text] -> IO ()
registerComposites :: Ptr PGconn -> [Text] -> IO ()
registerComposites Ptr PGconn
_ [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
registerComposites Ptr PGconn
conn [Text]
names = do
  [ForeignPtr CChar]
cnames <- (Text -> IO (ForeignPtr CChar)) -> [Text] -> IO [ForeignPtr CChar]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> IO (ForeignPtr CChar)
textToCString [Text]
names
  [PGregisterType] -> (Ptr PGregisterType -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray ((ForeignPtr CChar -> PGregisterType)
-> [ForeignPtr CChar] -> [PGregisterType]
forall a b. (a -> b) -> [a] -> [b]
map ForeignPtr CChar -> PGregisterType
nameToTypeRep [ForeignPtr CChar]
cnames) ((Ptr PGregisterType -> IO ()) -> IO ())
-> (Ptr PGregisterType -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PGregisterType
typereps -> (Ptr PGerror -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr PGerror -> IO ()) -> IO ())
-> (Ptr PGerror -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PGerror
err -> do
    let len :: CInt
len = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ [ForeignPtr CChar] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ForeignPtr CChar]
cnames
    Ptr PGconn
-> Ptr PGerror
-> TypeClass
-> Ptr PGregisterType
-> CInt
-> CInt
-> IO CInt
c_PQregisterTypes Ptr PGconn
conn Ptr PGerror
err TypeClass
c_PQT_COMPOSITE Ptr PGregisterType
typereps CInt
len CInt
0
      IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr PGerror -> String -> CInt -> IO ()
verifyPQTRes Ptr PGerror
err String
"registerComposites"
    (ForeignPtr CChar -> IO ()) -> [ForeignPtr CChar] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ForeignPtr CChar -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr [ForeignPtr CChar]
cnames
  where
    nameToTypeRep :: ForeignPtr CChar -> PGregisterType
nameToTypeRep ForeignPtr CChar
name = PGregisterType :: CString
-> FunPtr (Ptr PGtypeArgs -> IO CInt)
-> FunPtr (Ptr PGtypeArgs -> IO CInt)
-> PGregisterType
PGregisterType {
      pgRegisterTypeTypName :: CString
pgRegisterTypeTypName = ForeignPtr CChar -> CString
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr CChar
name
    , pgRegisterTypeTypPut :: FunPtr (Ptr PGtypeArgs -> IO CInt)
pgRegisterTypeTypPut = FunPtr (Ptr PGtypeArgs -> IO CInt)
forall a. FunPtr a
nullFunPtr
    , pgRegisterTypeTypGet :: FunPtr (Ptr PGtypeArgs -> IO CInt)
pgRegisterTypeTypGet = FunPtr (Ptr PGtypeArgs -> IO CInt)
forall a. FunPtr a
nullFunPtr
    }