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

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

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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. [a] -> 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 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
"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
        { 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
        }