{-# LINE 1 "Data/GI/Base/BasicConversions.hsc" #-}
{-# LANGUAGE ScopedTypeVariables, ConstraintKinds, FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
module Data.GI.Base.BasicConversions
    ( gflagsToWord
    , wordToGFlags

    , packGList
    , unpackGList
    , packGSList
    , unpackGSList
    , packGArray
    , unpackGArray
    , unrefGArray
    , packGPtrArray
    , unpackGPtrArray
    , unrefPtrArray
    , packGByteArray
    , unpackGByteArray
    , unrefGByteArray
    , packGHashTable
    , unpackGHashTable
    , unrefGHashTable
    , packByteString
    , packZeroTerminatedByteString
    , unpackByteStringWithLength
    , unpackZeroTerminatedByteString
    , packFileNameArray
    , packZeroTerminatedFileNameArray
    , unpackZeroTerminatedFileNameArray
    , unpackFileNameArrayWithLength
    , packUTF8CArray
    , packZeroTerminatedUTF8CArray
    , unpackUTF8CArrayWithLength
    , unpackZeroTerminatedUTF8CArray
    , packStorableArray
    , packZeroTerminatedStorableArray
    , unpackStorableArrayWithLength
    , unpackZeroTerminatedStorableArray
    , packMapStorableArray
    , packMapZeroTerminatedStorableArray
    , unpackMapStorableArrayWithLength
    , unpackMapZeroTerminatedStorableArray
    , packPtrArray
    , packZeroTerminatedPtrArray
    , unpackPtrArrayWithLength
    , unpackZeroTerminatedPtrArray
    , packBlockArray
    , unpackBlockArrayWithLength
    , unpackBoxedArrayWithLength

    , stringToCString
    , cstringToString
    , textToCString
    , withTextCString
    , cstringToText
    , byteStringToCString
    , cstringToByteString

    , mapZeroTerminatedCArray
    , mapCArrayWithLength
    , mapGArray
    , mapPtrArray
    , mapGList
    , mapGSList
    ) where


{-# LINE 70 "Data/GI/Base/BasicConversions.hsc" #-}
import Control.Exception.Base (bracket)
import Control.Monad (foldM)

import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BI
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Foreign as TF

import Foreign.Ptr (Ptr, plusPtr, nullPtr, nullFunPtr, castPtr)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Storable (Storable, peek, poke, sizeOf)
import Foreign.C.Types (CInt(..), CUInt(..), CSize(..), CChar(..))
import Foreign.C.String (CString, withCString, peekCString)
import Data.Word
import Data.Int (Int32)
import Data.Bits (Bits, (.|.), (.&.), shift)

import Data.GI.Base.BasicTypes
import Data.GI.Base.CallStack (HasCallStack)
import Data.GI.Base.ManagedPtr (copyBoxedPtr)
import Data.GI.Base.Utils (allocBytes, callocBytes, memcpy, freeMem,
                           checkUnexpectedReturnNULL)



gflagsToWord :: (Num b, IsGFlag a) => [a] -> b
gflagsToWord :: forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [a]
flags = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([a] -> Int
forall {a}. Enum a => [a] -> Int
go [a]
flags)
    where go :: [a] -> Int
go (a
f:[a]
fs) = a -> Int
forall a. Enum a => a -> Int
fromEnum a
f Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. [a] -> Int
go [a]
fs
          go [] = Int
0

wordToGFlags :: (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags :: forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags a
w = Int -> [b]
go Int
0
    where
      nbits :: Int
nbits = (a -> Int
forall a. Storable a => a -> Int
sizeOf a
w)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8
      go :: Int -> [b]
go Int
k
          | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nbits = []
          | Bool
otherwise = if a
mask a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0
                        then Int -> b
forall a. Enum a => Int -> a
toEnum (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
mask) b -> [b] -> [b]
forall a. a -> [a] -> [a]
: Int -> [b]
go (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                        else Int -> [b]
go (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
          where mask :: a
mask = a -> Int -> a
forall a. Bits a => a -> Int -> a
shift a
1 Int
k

foreign import ccall "g_list_prepend" g_list_prepend ::
    Ptr (GList (Ptr a)) -> Ptr a -> IO (Ptr (GList (Ptr a)))

-- | Given a Haskell list of items, construct a GList with those values.
packGList   :: [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList :: forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr a]
l = (Ptr (GList (Ptr a)) -> Ptr a -> IO (Ptr (GList (Ptr a))))
-> Ptr (GList (Ptr a)) -> [Ptr a] -> IO (Ptr (GList (Ptr a)))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Ptr (GList (Ptr a)) -> Ptr a -> IO (Ptr (GList (Ptr a)))
forall a. Ptr (GList (Ptr a)) -> Ptr a -> IO (Ptr (GList (Ptr a)))
g_list_prepend Ptr (GList (Ptr a))
forall a. Ptr a
nullPtr ([Ptr a] -> IO (Ptr (GList (Ptr a))))
-> [Ptr a] -> IO (Ptr (GList (Ptr a)))
forall a b. (a -> b) -> a -> b
$ [Ptr a] -> [Ptr a]
forall a. [a] -> [a]
reverse [Ptr a]
l

-- | Given a GSList construct the corresponding Haskell list.
unpackGList   :: Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList :: forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr a))
gsl
    | Ptr (GList (Ptr a))
gsl Ptr (GList (Ptr a)) -> Ptr (GList (Ptr a)) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (GList (Ptr a))
forall a. Ptr a
nullPtr = [Ptr a] -> IO [Ptr a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    | Bool
otherwise =
        do x <- Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek (Ptr (GList (Ptr a)) -> Ptr (Ptr a)
forall a b. Ptr a -> Ptr b
castPtr Ptr (GList (Ptr a))
gsl)
           next <- peek (gsl `plusPtr` sizeOf x)
           xs <- unpackGList next
           return $ x : xs

-- Same thing for singly linked lists

foreign import ccall "g_slist_prepend" g_slist_prepend ::
    Ptr (GSList (Ptr a)) -> Ptr a -> IO (Ptr (GSList (Ptr a)))

-- | Given a Haskell list of items, construct a GSList with those values.
packGSList   :: [Ptr a] -> IO (Ptr (GSList (Ptr a)))
packGSList :: forall a. [Ptr a] -> IO (Ptr (GSList (Ptr a)))
packGSList [Ptr a]
l = (Ptr (GSList (Ptr a)) -> Ptr a -> IO (Ptr (GSList (Ptr a))))
-> Ptr (GSList (Ptr a)) -> [Ptr a] -> IO (Ptr (GSList (Ptr a)))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Ptr (GSList (Ptr a)) -> Ptr a -> IO (Ptr (GSList (Ptr a)))
forall a.
Ptr (GSList (Ptr a)) -> Ptr a -> IO (Ptr (GSList (Ptr a)))
g_slist_prepend Ptr (GSList (Ptr a))
forall a. Ptr a
nullPtr ([Ptr a] -> IO (Ptr (GSList (Ptr a))))
-> [Ptr a] -> IO (Ptr (GSList (Ptr a)))
forall a b. (a -> b) -> a -> b
$ [Ptr a] -> [Ptr a]
forall a. [a] -> [a]
reverse [Ptr a]
l

-- | Given a GSList construct the corresponding Haskell list.
unpackGSList   :: Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList :: forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr a))
gsl = Ptr (GList (Ptr a)) -> IO [Ptr a]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList (Ptr (GSList (Ptr a)) -> Ptr (GList (Ptr a))
forall a b. Ptr a -> Ptr b
castPtr Ptr (GSList (Ptr a))
gsl)

foreign import ccall "g_array_new" g_array_new ::
   CInt -> CInt -> CUInt -> IO (Ptr (GArray ()))
foreign import ccall "g_array_set_size" g_array_set_size ::
    Ptr (GArray ()) -> CUInt -> IO (Ptr (GArray ()))
foreign import ccall "g_array_unref" unrefGArray ::
   Ptr (GArray a) -> IO ()

packGArray :: forall a. Storable a => [a] -> IO (Ptr (GArray a))
packGArray :: forall a. Storable a => [a] -> IO (Ptr (GArray a))
packGArray [a]
elems = do
  let elemsize :: Int
elemsize = a -> Int
forall a. Storable a => a -> Int
sizeOf ([a]
elems[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!Int
0)
  array <- CInt -> CInt -> CUInt -> IO (Ptr (GArray ()))
g_array_new CInt
0 CInt
0 (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
elemsize)
  _ <- g_array_set_size array (fromIntegral $ length elems)
  dataPtr <- peek (castPtr array :: Ptr (Ptr a))
  fill dataPtr elems
  return $ castPtr array
  where
    fill            :: Ptr a -> [a] -> IO ()
    fill :: Ptr a -> [a] -> IO ()
fill Ptr a
_ []       = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    fill Ptr a
ptr (a
x:[a]
xs) =
        do Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
x
           Ptr a -> [a] -> IO ()
fill (Ptr a
ptr Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (a -> Int
forall a. Storable a => a -> Int
sizeOf a
x)) [a]
xs

unpackGArray :: forall a. Storable a => Ptr (GArray a) -> IO [a]
unpackGArray :: forall a. Storable a => Ptr (GArray a) -> IO [a]
unpackGArray Ptr (GArray a)
array = do
  dataPtr <- Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek (Ptr (GArray a) -> Ptr (Ptr a)
forall a b. Ptr a -> Ptr b
castPtr Ptr (GArray a)
array :: Ptr (Ptr a))
  nitems <- peek (array `plusPtr` sizeOf dataPtr)
  go dataPtr nitems
    where go :: Ptr a -> CUInt -> IO [a]
          go :: Ptr a -> CUInt -> IO [a]
go Ptr a
_ CUInt
0 = [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Ptr a
ptr CUInt
n = do
            x <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr
            (x:) <$> go (ptr `plusPtr` sizeOf x) (n-1)

foreign import ccall "g_ptr_array_new" g_ptr_array_new ::
    IO (Ptr (GPtrArray ()))
foreign import ccall "g_ptr_array_set_size" g_ptr_array_set_size ::
    Ptr (GPtrArray ()) -> CUInt -> IO (Ptr (GPtrArray ()))
foreign import ccall "g_ptr_array_unref" unrefPtrArray ::
   Ptr (GPtrArray a) -> IO ()

packGPtrArray :: [Ptr a] -> IO (Ptr (GPtrArray (Ptr a)))
packGPtrArray :: forall a. [Ptr a] -> IO (Ptr (GPtrArray (Ptr a)))
packGPtrArray [Ptr a]
elems = do
  array <- IO (Ptr (GPtrArray ()))
g_ptr_array_new
  _ <- g_ptr_array_set_size array (fromIntegral $ length elems)
  dataPtr <- peek (castPtr array :: Ptr (Ptr (Ptr a)))
  fill dataPtr elems
  return $ castPtr array
  where
    fill            :: Ptr (Ptr a) -> [Ptr a] -> IO ()
    fill :: forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill Ptr (Ptr a)
_ []       = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    fill Ptr (Ptr a)
ptr (Ptr a
x:[Ptr a]
xs) =
        do Ptr (Ptr a) -> Ptr a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr a)
ptr Ptr a
x
           Ptr (Ptr a) -> [Ptr a] -> IO ()
forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill (Ptr (Ptr a)
ptr Ptr (Ptr a) -> Int -> Ptr (Ptr a)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Ptr a -> Int
forall a. Storable a => a -> Int
sizeOf Ptr a
x)) [Ptr a]
xs

unpackGPtrArray :: Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray :: forall a. Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray Ptr (GPtrArray (Ptr a))
array = do
  dataPtr <- Ptr (Ptr (Ptr a)) -> IO (Ptr (Ptr a))
forall a. Storable a => Ptr a -> IO a
peek (Ptr (GPtrArray (Ptr a)) -> Ptr (Ptr (Ptr a))
forall a b. Ptr a -> Ptr b
castPtr Ptr (GPtrArray (Ptr a))
array :: Ptr (Ptr (Ptr a)))
  nitems <- peek (array `plusPtr` sizeOf dataPtr)
  go dataPtr nitems
    where go :: Ptr (Ptr a) -> CUInt -> IO [Ptr a]
          go :: forall a. Ptr (Ptr a) -> CUInt -> IO [Ptr a]
go Ptr (Ptr a)
_ CUInt
0 = [Ptr a] -> IO [Ptr a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Ptr (Ptr a)
ptr CUInt
n = do
            x <- Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
ptr
            (x:) <$> go (ptr `plusPtr` sizeOf x) (n-1)

foreign import ccall "g_byte_array_new" g_byte_array_new ::
    IO (Ptr GByteArray)
foreign import ccall "g_byte_array_append" g_byte_array_append ::
    Ptr GByteArray -> Ptr a -> CUInt -> IO (Ptr GByteArray)
foreign import ccall "g_byte_array_unref" unrefGByteArray ::
   Ptr GByteArray -> IO ()

packGByteArray :: ByteString -> IO (Ptr GByteArray)
packGByteArray :: ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
bs = do
  array <- IO (Ptr GByteArray)
g_byte_array_new
  let (ptr, offset, length) = BI.toForeignPtr bs
  _ <- withForeignPtr ptr $ \Ptr Word8
dataPtr ->
                    Ptr GByteArray -> Ptr Any -> CUInt -> IO (Ptr GByteArray)
forall a. Ptr GByteArray -> Ptr a -> CUInt -> IO (Ptr GByteArray)
g_byte_array_append Ptr GByteArray
array (Ptr Word8
dataPtr Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset)
                                        (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
length)
  return array

unpackGByteArray :: Ptr GByteArray -> IO ByteString
unpackGByteArray :: Ptr GByteArray -> IO ByteString
unpackGByteArray Ptr GByteArray
array = do
  dataPtr <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek (Ptr GByteArray -> Ptr (Ptr CChar)
forall a b. Ptr a -> Ptr b
castPtr Ptr GByteArray
array :: Ptr (Ptr CChar))
  length <- peek (array `plusPtr` (sizeOf dataPtr)) :: IO CUInt
  B.packCStringLen (dataPtr, fromIntegral length)

foreign import ccall "g_hash_table_new_full" g_hash_table_new_full ::
    GHashFunc a -> GEqualFunc a -> GDestroyNotify a -> GDestroyNotify b ->
                 IO (Ptr (GHashTable a b))
foreign import ccall "g_hash_table_insert" g_hash_table_insert ::
    Ptr (GHashTable a b) -> PtrWrapped a -> PtrWrapped b -> IO Int32
{-# LINE 236 "Data/GI/Base/BasicConversions.hsc" #-}

packGHashTable :: GHashFunc a -> GEqualFunc a ->
                  Maybe (GDestroyNotify a) -> Maybe (GDestroyNotify b) ->
                  [(PtrWrapped a, PtrWrapped b)] -> IO (Ptr (GHashTable a b))
packGHashTable :: forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc a
keyHash GEqualFunc a
keyEqual Maybe (GDestroyNotify a)
keyDestroy Maybe (GDestroyNotify b)
elemDestroy [(PtrWrapped a, PtrWrapped b)]
pairs = do
  let keyDPtr :: GDestroyNotify a
keyDPtr = GDestroyNotify a -> Maybe (GDestroyNotify a) -> GDestroyNotify a
forall a. a -> Maybe a -> a
fromMaybe GDestroyNotify a
forall a. FunPtr a
nullFunPtr Maybe (GDestroyNotify a)
keyDestroy
      elemDPtr :: GDestroyNotify b
elemDPtr = GDestroyNotify b -> Maybe (GDestroyNotify b) -> GDestroyNotify b
forall a. a -> Maybe a -> a
fromMaybe GDestroyNotify b
forall a. FunPtr a
nullFunPtr Maybe (GDestroyNotify b)
elemDestroy
  ht <- GHashFunc a
-> GEqualFunc a
-> GDestroyNotify a
-> GDestroyNotify b
-> IO (Ptr (GHashTable a b))
forall a b.
GHashFunc a
-> GEqualFunc a
-> GDestroyNotify a
-> GDestroyNotify b
-> IO (Ptr (GHashTable a b))
g_hash_table_new_full GHashFunc a
keyHash GEqualFunc a
keyEqual GDestroyNotify a
keyDPtr GDestroyNotify b
elemDPtr
  mapM_ (uncurry (g_hash_table_insert ht)) pairs
  return ht

foreign import ccall "g_hash_table_get_keys" g_hash_table_get_keys ::
    Ptr (GHashTable a b) -> IO (Ptr (GList (Ptr a)))
foreign import ccall "g_hash_table_lookup" g_hash_table_lookup ::
    Ptr (GHashTable a b) -> PtrWrapped a -> IO (PtrWrapped b)
unpackGHashTable :: Ptr (GHashTable a b) -> IO [(PtrWrapped a, PtrWrapped b)]
unpackGHashTable :: forall a b.
Ptr (GHashTable a b) -> IO [(PtrWrapped a, PtrWrapped b)]
unpackGHashTable Ptr (GHashTable a b)
ht = do
  keysGList <- Ptr (GHashTable a b) -> IO (Ptr (GList (Ptr a)))
forall a b. Ptr (GHashTable a b) -> IO (Ptr (GList (Ptr a)))
g_hash_table_get_keys Ptr (GHashTable a b)
ht
  keys <- (map (PtrWrapped . castPtr)) <$> unpackGList keysGList
  g_list_free keysGList
  -- At this point we could use g_hash_table_get_values, since the
  -- current implementation in GLib returns elements in the same order
  -- as g_hash_table_get_keys. But to be on the safe side, since the
  -- ordering is not specified in the documentation, we do the
  -- following, which is (quite) slower but manifestly safe.
  elems <- mapM (g_hash_table_lookup ht) keys
  return (zip keys elems)

foreign import ccall "g_hash_table_unref" unrefGHashTable ::
   Ptr (GHashTable a b) -> IO ()

packByteString :: ByteString -> IO (Ptr Word8)
packByteString :: ByteString -> IO (Ptr Word8)
packByteString ByteString
bs = do
  let (ForeignPtr Word8
ptr, Int
offset, Int
length) = ByteString -> (ForeignPtr Word8, Int, Int)
BI.toForeignPtr ByteString
bs
  mem <- Int -> IO (Ptr Word8)
forall a b. Integral a => a -> IO (Ptr b)
allocBytes Int
length
  withForeignPtr ptr $ \Ptr Word8
dataPtr ->
      Ptr Word8 -> Ptr Any -> Int -> IO ()
forall a b. Ptr a -> Ptr b -> Int -> IO ()
memcpy Ptr Word8
mem (Ptr Word8
dataPtr Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
length)
  return mem

packZeroTerminatedByteString :: ByteString -> IO (Ptr Word8)
packZeroTerminatedByteString :: ByteString -> IO (Ptr Word8)
packZeroTerminatedByteString ByteString
bs = do
  let (ForeignPtr Word8
ptr, Int
offset, Int
length) = ByteString -> (ForeignPtr Word8, Int, Int)
BI.toForeignPtr ByteString
bs
  mem <- Int -> IO (Ptr Word8)
forall a b. Integral a => a -> IO (Ptr b)
allocBytes (Int
lengthInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  withForeignPtr ptr $ \Ptr Word8
dataPtr ->
      Ptr Word8 -> Ptr Any -> Int -> IO ()
forall a b. Ptr a -> Ptr b -> Int -> IO ()
memcpy Ptr Word8
mem (Ptr Word8
dataPtr Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
length)
  poke (mem `plusPtr` (offset+length)) (0 :: Word8)
  return mem

unpackByteStringWithLength :: Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength :: forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength a
length Ptr Word8
ptr =
  CStringLen -> IO ByteString
B.packCStringLen (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr, a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
length)

unpackZeroTerminatedByteString :: Ptr Word8 -> IO ByteString
unpackZeroTerminatedByteString :: Ptr Word8 -> IO ByteString
unpackZeroTerminatedByteString Ptr Word8
ptr =
  Ptr CChar -> IO ByteString
B.packCString (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr)

packStorableArray :: Storable a => [a] -> IO (Ptr a)
packStorableArray :: forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray = (a -> a) -> [a] -> IO (Ptr a)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray a -> a
forall a. a -> a
id

packZeroTerminatedStorableArray :: (Num a, Storable a) => [a] -> IO (Ptr a)
packZeroTerminatedStorableArray :: forall a. (Num a, Storable a) => [a] -> IO (Ptr a)
packZeroTerminatedStorableArray = (a -> a) -> [a] -> IO (Ptr a)
forall a b. (Num b, Storable b) => (a -> b) -> [a] -> IO (Ptr b)
packMapZeroTerminatedStorableArray a -> a
forall a. a -> a
id

unpackStorableArrayWithLength :: (Integral a, Storable b) =>
                                 a -> Ptr b -> IO [b]
unpackStorableArrayWithLength :: forall a b. (Integral a, Storable b) => a -> Ptr b -> IO [b]
unpackStorableArrayWithLength = (b -> b) -> a -> Ptr b -> IO [b]
forall a b c.
(Integral a, Storable b) =>
(b -> c) -> a -> Ptr b -> IO [c]
unpackMapStorableArrayWithLength b -> b
forall a. a -> a
id

unpackZeroTerminatedStorableArray :: (Eq a, Num a, Storable a) =>
                                     Ptr a -> IO [a]
unpackZeroTerminatedStorableArray :: forall a. (Eq a, Num a, Storable a) => Ptr a -> IO [a]
unpackZeroTerminatedStorableArray = (a -> a) -> Ptr a -> IO [a]
forall a b.
(Eq a, Num a, Storable a) =>
(a -> b) -> Ptr a -> IO [b]
unpackMapZeroTerminatedStorableArray a -> a
forall a. a -> a
id

packMapStorableArray :: forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray :: forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray a -> b
fn [a]
items = do
  let nitems :: Int
nitems = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
items
  mem <- Int -> IO (Ptr b)
forall a b. Integral a => a -> IO (Ptr b)
allocBytes (Int -> IO (Ptr b)) -> Int -> IO (Ptr b)
forall a b. (a -> b) -> a -> b
$ (b -> Int
forall a. Storable a => a -> Int
sizeOf (b
forall a. HasCallStack => a
undefined::b)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
nitems
  fill mem (map fn items)
  return mem
  where fill            :: Ptr b -> [b] -> IO ()
        fill :: Ptr b -> [b] -> IO ()
fill Ptr b
_ []       = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        fill Ptr b
ptr (b
x:[b]
xs) = do
          Ptr b -> b -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr b
ptr b
x
          Ptr b -> [b] -> IO ()
fill (Ptr b
ptr Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` b -> Int
forall a. Storable a => a -> Int
sizeOf b
x) [b]
xs

packMapZeroTerminatedStorableArray :: forall a b. (Num b, Storable b) =>
                                      (a -> b) -> [a] -> IO (Ptr b)
packMapZeroTerminatedStorableArray :: forall a b. (Num b, Storable b) => (a -> b) -> [a] -> IO (Ptr b)
packMapZeroTerminatedStorableArray a -> b
fn [a]
items = do
  let nitems :: Int
nitems = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
items
  mem <- Int -> IO (Ptr b)
forall a b. Integral a => a -> IO (Ptr b)
allocBytes (Int -> IO (Ptr b)) -> Int -> IO (Ptr b)
forall a b. (a -> b) -> a -> b
$ (b -> Int
forall a. Storable a => a -> Int
sizeOf (b
forall a. HasCallStack => a
undefined::b)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
nitemsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  fill mem (map fn items)
  return mem
  where fill            :: Ptr b -> [b] -> IO ()
        fill :: Ptr b -> [b] -> IO ()
fill Ptr b
ptr []     = Ptr b -> b -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr b
ptr b
0
        fill Ptr b
ptr (b
x:[b]
xs) = do
          Ptr b -> b -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr b
ptr b
x
          Ptr b -> [b] -> IO ()
fill (Ptr b
ptr Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` b -> Int
forall a. Storable a => a -> Int
sizeOf b
x) [b]
xs

unpackMapStorableArrayWithLength :: forall a b c. (Integral a, Storable b) =>
                                    (b -> c) -> a -> Ptr b -> IO [c]
unpackMapStorableArrayWithLength :: forall a b c.
(Integral a, Storable b) =>
(b -> c) -> a -> Ptr b -> IO [c]
unpackMapStorableArrayWithLength b -> c
fn a
n Ptr b
ptr = (b -> c) -> [b] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map b -> c
fn ([b] -> [c]) -> IO [b] -> IO [c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr b -> IO [b]
go (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) Ptr b
ptr
    where go :: Int -> Ptr b -> IO [b]
          go :: Int -> Ptr b -> IO [b]
go Int
0 Ptr b
_ = [b] -> IO [b]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
n Ptr b
ptr = do
            x <- Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek Ptr b
ptr
            (x:) <$> go (n-1) (ptr `plusPtr` sizeOf x)

unpackMapZeroTerminatedStorableArray :: forall a b. (Eq a, Num a, Storable a) =>
                                        (a -> b) -> Ptr a -> IO [b]
unpackMapZeroTerminatedStorableArray :: forall a b.
(Eq a, Num a, Storable a) =>
(a -> b) -> Ptr a -> IO [b]
unpackMapZeroTerminatedStorableArray a -> b
fn Ptr a
ptr = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
fn ([a] -> [b]) -> IO [a] -> IO [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO [a]
go Ptr a
ptr
    where go :: Ptr a -> IO [a]
          go :: Ptr a -> IO [a]
go Ptr a
ptr = do
            x <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr
            if x == 0
            then return []
            else (x:) <$> go (ptr `plusPtr` sizeOf x)

packUTF8CArray :: [Text] -> IO (Ptr CString)
packUTF8CArray :: [Text] -> IO (Ptr (Ptr CChar))
packUTF8CArray [Text]
items = do
  let nitems :: Int
nitems = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
items
  mem <- Int -> IO (Ptr (Ptr CChar))
forall a b. Integral a => a -> IO (Ptr b)
allocBytes (Int -> IO (Ptr (Ptr CChar))) -> Int -> IO (Ptr (Ptr CChar))
forall a b. (a -> b) -> a -> b
$ Int
nitems Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Ptr CChar -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr CChar
forall a. Ptr a
nullPtr :: CString))
  fill mem items
  return mem
    where fill            :: Ptr CString -> [Text] -> IO ()
          fill :: Ptr (Ptr CChar) -> [Text] -> IO ()
fill Ptr (Ptr CChar)
_ []       = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          fill Ptr (Ptr CChar)
ptr (Text
x:[Text]
xs) =
              do cstring <- Text -> IO (Ptr CChar)
textToCString Text
x
                 poke ptr cstring
                 fill (ptr `plusPtr` sizeOf cstring) xs

packZeroTerminatedUTF8CArray :: [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray :: [Text] -> IO (Ptr (Ptr CChar))
packZeroTerminatedUTF8CArray [Text]
items = do
    let nitems :: Int
nitems = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
items
    mem <- Int -> IO (Ptr (Ptr CChar))
forall a b. Integral a => a -> IO (Ptr b)
allocBytes (Int -> IO (Ptr (Ptr CChar))) -> Int -> IO (Ptr (Ptr CChar))
forall a b. (a -> b) -> a -> b
$ (Ptr CChar -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr CChar
forall a. Ptr a
nullPtr :: CString)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
nitemsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    fill mem items
    return mem
    where fill :: Ptr CString -> [Text] -> IO ()
          fill :: Ptr (Ptr CChar) -> [Text] -> IO ()
fill Ptr (Ptr CChar)
ptr [] = Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
ptr Ptr CChar
forall a. Ptr a
nullPtr
          fill Ptr (Ptr CChar)
ptr (Text
x:[Text]
xs) = do cstring <- Text -> IO (Ptr CChar)
textToCString Text
x
                               poke ptr cstring
                               fill (ptr `plusPtr` sizeOf cstring) xs

unpackZeroTerminatedUTF8CArray :: HasCallStack => Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray :: HasCallStack => Ptr (Ptr CChar) -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr (Ptr CChar)
listPtr = Ptr (Ptr CChar) -> IO [Text]
go Ptr (Ptr CChar)
listPtr
    where go :: Ptr CString -> IO [Text]
          go :: Ptr (Ptr CChar) -> IO [Text]
go Ptr (Ptr CChar)
ptr = do
            cstring <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
            if cstring == nullPtr
               then return []
               else (:) <$> cstringToText cstring
                        <*> go (ptr `plusPtr` sizeOf cstring)

unpackUTF8CArrayWithLength :: (HasCallStack, Integral a) =>
                              a -> Ptr CString -> IO [Text]
unpackUTF8CArrayWithLength :: forall a.
(HasCallStack, Integral a) =>
a -> Ptr (Ptr CChar) -> IO [Text]
unpackUTF8CArrayWithLength a
n Ptr (Ptr CChar)
ptr = Int -> Ptr (Ptr CChar) -> IO [Text]
go (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) Ptr (Ptr CChar)
ptr
    where go       :: Int -> Ptr CString -> IO [Text]
          go :: Int -> Ptr (Ptr CChar) -> IO [Text]
go Int
0 Ptr (Ptr CChar)
_   = [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
n Ptr (Ptr CChar)
ptr = do
            cstring <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
            (:) <$> cstringToText cstring
                    <*> go (n-1) (ptr `plusPtr` sizeOf cstring)

packFileNameArray :: [String] -> IO (Ptr CString)
packFileNameArray :: [String] -> IO (Ptr (Ptr CChar))
packFileNameArray [String]
items = do
  let nitems :: Int
nitems = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
items
  mem <- Int -> IO (Ptr (Ptr CChar))
forall a b. Integral a => a -> IO (Ptr b)
allocBytes (Int -> IO (Ptr (Ptr CChar))) -> Int -> IO (Ptr (Ptr CChar))
forall a b. (a -> b) -> a -> b
$ Int
nitems Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Ptr CChar -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr CChar
forall a. Ptr a
nullPtr :: CString))
  fill mem items
  return mem
    where fill            :: Ptr CString -> [String] -> IO ()
          fill :: Ptr (Ptr CChar) -> [String] -> IO ()
fill Ptr (Ptr CChar)
_ []       = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          fill Ptr (Ptr CChar)
ptr (String
x:[String]
xs) =
              do cstring <- String -> IO (Ptr CChar)
stringToCString String
x
                 poke ptr cstring
                 fill (ptr `plusPtr` sizeOf cstring) xs

packZeroTerminatedFileNameArray :: [String] -> IO (Ptr CString)
packZeroTerminatedFileNameArray :: [String] -> IO (Ptr (Ptr CChar))
packZeroTerminatedFileNameArray [String]
items = do
    let nitems :: Int
nitems = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
items
    mem <- Int -> IO (Ptr (Ptr CChar))
forall a b. Integral a => a -> IO (Ptr b)
allocBytes (Int -> IO (Ptr (Ptr CChar))) -> Int -> IO (Ptr (Ptr CChar))
forall a b. (a -> b) -> a -> b
$ (Ptr CChar -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr CChar
forall a. Ptr a
nullPtr :: CString)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
nitemsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    fill mem items
    return mem
    where fill :: Ptr CString -> [String] -> IO ()
          fill :: Ptr (Ptr CChar) -> [String] -> IO ()
fill Ptr (Ptr CChar)
ptr [] = Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
ptr Ptr CChar
forall a. Ptr a
nullPtr
          fill Ptr (Ptr CChar)
ptr (String
x:[String]
xs) = do cstring <- String -> IO (Ptr CChar)
stringToCString String
x
                               poke ptr cstring
                               fill (ptr `plusPtr` sizeOf cstring) xs

unpackZeroTerminatedFileNameArray :: HasCallStack => Ptr CString -> IO [String]
unpackZeroTerminatedFileNameArray :: HasCallStack => Ptr (Ptr CChar) -> IO [String]
unpackZeroTerminatedFileNameArray Ptr (Ptr CChar)
listPtr = Ptr (Ptr CChar) -> IO [String]
go Ptr (Ptr CChar)
listPtr
    where go :: Ptr CString -> IO [String]
          go :: Ptr (Ptr CChar) -> IO [String]
go Ptr (Ptr CChar)
ptr = do
            cstring <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
            if cstring == nullPtr
               then return []
               else (:) <$> cstringToString cstring
                        <*> go (ptr `plusPtr` sizeOf cstring)

unpackFileNameArrayWithLength :: (HasCallStack, Integral a) =>
                                 a -> Ptr CString -> IO [String]
unpackFileNameArrayWithLength :: forall a.
(HasCallStack, Integral a) =>
a -> Ptr (Ptr CChar) -> IO [String]
unpackFileNameArrayWithLength a
n Ptr (Ptr CChar)
ptr = Int -> Ptr (Ptr CChar) -> IO [String]
go (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) Ptr (Ptr CChar)
ptr
    where go       :: Int -> Ptr CString -> IO [String]
          go :: Int -> Ptr (Ptr CChar) -> IO [String]
go Int
0 Ptr (Ptr CChar)
_   = [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
n Ptr (Ptr CChar)
ptr = do
            cstring <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
            (:) <$> cstringToString cstring
                    <*> go (n-1) (ptr `plusPtr` sizeOf cstring)

foreign import ccall "g_strdup" g_strdup :: CString -> IO CString

-- We need to use the GLib allocator for constructing CStrings, since
-- the ownership of the string may be transferred to the GLib side,
-- which will free it with g_free.
stringToCString :: String -> IO CString
stringToCString :: String -> IO (Ptr CChar)
stringToCString String
str = String -> (Ptr CChar -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
str Ptr CChar -> IO (Ptr CChar)
g_strdup

cstringToString :: HasCallStack => CString -> IO String
cstringToString :: HasCallStack => Ptr CChar -> IO String
cstringToString Ptr CChar
cstr = do
  Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL (String -> Text
T.pack String
"cstringToString") Ptr CChar
cstr
  Ptr CChar -> IO String
peekCString Ptr CChar
cstr

foreign import ccall "g_strndup" g_strndup ::
    CString -> Word64 -> IO CString
{-# LINE 455 "Data/GI/Base/BasicConversions.hsc" #-}

-- | Convert `Text` into a `CString`, using the GLib allocator.
textToCString :: Text -> IO CString
textToCString :: Text -> IO (Ptr CChar)
textToCString Text
str = Text -> (CStringLen -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a. Text -> (CStringLen -> IO a) -> IO a
TF.withCStringLen Text
str ((CStringLen -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (CStringLen -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cstr, Int
len) ->
  -- Because withCStringLen returns NULL for a zero-length Text, and
  -- g_strndup returns NULL for NULL, even if n==0.
  if Ptr CChar
cstr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr CChar
forall a. Ptr a
nullPtr
  then Ptr CChar -> Word64 -> IO (Ptr CChar)
g_strndup Ptr CChar
cstr (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
  else Int -> IO (Ptr CChar)
forall a. Int -> IO (Ptr a)
callocBytes Int
1

withTextCString :: Text -> (CString -> IO a) -> IO a
withTextCString :: forall a. Text -> (Ptr CChar -> IO a) -> IO a
withTextCString Text
text Ptr CChar -> IO a
action = IO (Ptr CChar)
-> (Ptr CChar -> IO ()) -> (Ptr CChar -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Text -> IO (Ptr CChar)
textToCString Text
text) Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar -> IO a
action

foreign import ccall "strlen" c_strlen ::
    CString -> IO (CSize)

cstringToText :: HasCallStack => CString -> IO Text
cstringToText :: HasCallStack => Ptr CChar -> IO Text
cstringToText Ptr CChar
cstr = do
  Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL (String -> Text
T.pack String
"cstringToText") Ptr CChar
cstr
  len <- Ptr CChar -> IO CSize
c_strlen Ptr CChar
cstr
  let cstrlen = (Ptr CChar
cstr, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len)
  TF.peekCStringLen cstrlen

byteStringToCString :: ByteString -> IO CString
byteStringToCString :: ByteString -> IO (Ptr CChar)
byteStringToCString ByteString
bs = ByteString -> (Ptr CChar -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
B.useAsCString ByteString
bs Ptr CChar -> IO (Ptr CChar)
g_strdup

cstringToByteString :: HasCallStack => CString -> IO ByteString
cstringToByteString :: HasCallStack => Ptr CChar -> IO ByteString
cstringToByteString Ptr CChar
cstr = do
  Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL (String -> Text
T.pack String
"cstringToByteString") Ptr CChar
cstr
  Ptr CChar -> IO ByteString
B.packCString Ptr CChar
cstr

packPtrArray :: [Ptr a] -> IO (Ptr (Ptr a))
packPtrArray :: forall a. [Ptr a] -> IO (Ptr (Ptr a))
packPtrArray [Ptr a]
items = do
  let nitems :: Int
nitems = [Ptr a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr a]
items
  mem <- Int -> IO (Ptr (Ptr a))
forall a b. Integral a => a -> IO (Ptr b)
allocBytes (Int -> IO (Ptr (Ptr a))) -> Int -> IO (Ptr (Ptr a))
forall a b. (a -> b) -> a -> b
$ (Ptr Any -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr a
forall a. Ptr a
nullPtr :: Ptr a)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
nitems
  fill mem items
  return mem
  where fill :: Ptr (Ptr a) -> [Ptr a] -> IO ()
        fill :: forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill Ptr (Ptr a)
_ [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        fill Ptr (Ptr a)
ptr (Ptr a
x:[Ptr a]
xs) = do Ptr (Ptr a) -> Ptr a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr a)
ptr Ptr a
x
                             Ptr (Ptr a) -> [Ptr a] -> IO ()
forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill (Ptr (Ptr a)
ptr Ptr (Ptr a) -> Int -> Ptr (Ptr a)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Ptr a -> Int
forall a. Storable a => a -> Int
sizeOf Ptr a
x) [Ptr a]
xs

packZeroTerminatedPtrArray :: [Ptr a] -> IO (Ptr (Ptr a))
packZeroTerminatedPtrArray :: forall a. [Ptr a] -> IO (Ptr (Ptr a))
packZeroTerminatedPtrArray [Ptr a]
items = do
  let nitems :: Int
nitems = [Ptr a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr a]
items
  mem <- Int -> IO (Ptr (Ptr a))
forall a b. Integral a => a -> IO (Ptr b)
allocBytes (Int -> IO (Ptr (Ptr a))) -> Int -> IO (Ptr (Ptr a))
forall a b. (a -> b) -> a -> b
$ (Ptr Any -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr a
forall a. Ptr a
nullPtr :: Ptr a)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
nitemsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  fill mem items
  return mem
  where fill            :: Ptr (Ptr a) -> [Ptr a] -> IO ()
        fill :: forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill Ptr (Ptr a)
ptr []     = Ptr (Ptr a) -> Ptr a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr a)
ptr Ptr a
forall a. Ptr a
nullPtr
        fill Ptr (Ptr a)
ptr (Ptr a
x:[Ptr a]
xs) = do Ptr (Ptr a) -> Ptr a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr a)
ptr Ptr a
x
                             Ptr (Ptr a) -> [Ptr a] -> IO ()
forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill (Ptr (Ptr a)
ptr Ptr (Ptr a) -> Int -> Ptr (Ptr a)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Ptr a -> Int
forall a. Storable a => a -> Int
sizeOf Ptr a
x) [Ptr a]
xs

unpackPtrArrayWithLength :: Integral a => a -> Ptr (Ptr b) -> IO [Ptr b]
unpackPtrArrayWithLength :: forall a b. Integral a => a -> Ptr (Ptr b) -> IO [Ptr b]
unpackPtrArrayWithLength a
n Ptr (Ptr b)
ptr = Int -> Ptr (Ptr b) -> IO [Ptr b]
forall a. Int -> Ptr (Ptr a) -> IO [Ptr a]
go (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) Ptr (Ptr b)
ptr
    where go       :: Int -> Ptr (Ptr a) -> IO [Ptr a]
          go :: forall a. Int -> Ptr (Ptr a) -> IO [Ptr a]
go Int
0 Ptr (Ptr a)
_   = [Ptr a] -> IO [Ptr a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
n Ptr (Ptr a)
ptr = (:) (Ptr a -> [Ptr a] -> [Ptr a])
-> IO (Ptr a) -> IO ([Ptr a] -> [Ptr a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
ptr
                     IO ([Ptr a] -> [Ptr a]) -> IO [Ptr a] -> IO [Ptr a]
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Ptr (Ptr a) -> IO [Ptr a]
forall a. Int -> Ptr (Ptr a) -> IO [Ptr a]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Ptr (Ptr a)
ptr Ptr (Ptr a) -> Int -> Ptr (Ptr a)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Ptr Any -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr a
forall a. Ptr a
nullPtr :: Ptr a))

unpackZeroTerminatedPtrArray :: Ptr (Ptr a) -> IO [Ptr a]
unpackZeroTerminatedPtrArray :: forall a. Ptr (Ptr a) -> IO [Ptr a]
unpackZeroTerminatedPtrArray Ptr (Ptr a)
ptr = Ptr (Ptr a) -> IO [Ptr a]
forall a. Ptr (Ptr a) -> IO [Ptr a]
go Ptr (Ptr a)
ptr
    where go :: Ptr (Ptr a) -> IO [Ptr a]
          go :: forall a. Ptr (Ptr a) -> IO [Ptr a]
go Ptr (Ptr a)
ptr = do
            p <- Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
ptr
            if p == nullPtr
            then return []
            else (p:) <$> go (ptr `plusPtr` sizeOf p)

mapZeroTerminatedCArray :: (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray :: forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray Ptr a -> IO b
f Ptr (Ptr a)
dataPtr
    | (Ptr (Ptr a)
dataPtr Ptr (Ptr a) -> Ptr (Ptr a) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (Ptr a)
forall a. Ptr a
nullPtr) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
        do ptr <- Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
dataPtr
           if ptr == nullPtr
           then return ()
           else do
             _ <- f ptr
             mapZeroTerminatedCArray f (dataPtr `plusPtr` sizeOf ptr)

-- | Given a set of pointers to blocks of memory of the specified
-- size, copy the contents of these blocks to a freshly-allocated
-- (with `allocBytes`) continuous area of memory.
packBlockArray :: Int -> [Ptr a] -> IO (Ptr a)
packBlockArray :: forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
size [Ptr a]
items = do
  let nitems :: Int
nitems = [Ptr a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr a]
items
  mem <- Int -> IO (Ptr a)
forall a b. Integral a => a -> IO (Ptr b)
allocBytes (Int -> IO (Ptr a)) -> Int -> IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
nitems
  fill mem items
  return mem
  where fill :: Ptr a -> [Ptr a] -> IO ()
        fill :: forall a. Ptr a -> [Ptr a] -> IO ()
fill Ptr a
_ [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        fill Ptr a
ptr (Ptr a
x:[Ptr a]
xs) = do Ptr a -> Ptr a -> Int -> IO ()
forall a b. Ptr a -> Ptr b -> Int -> IO ()
memcpy Ptr a
ptr Ptr a
x Int
size
                             Ptr a -> [Ptr a] -> IO ()
forall a. Ptr a -> [Ptr a] -> IO ()
fill (Ptr a
ptr Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
size) [Ptr a]
xs

foreign import ccall "g_memdup" g_memdup ::
    Ptr a -> CUInt -> IO (Ptr a)

unpackBlockArrayWithLength :: Integral a => Int -> a -> Ptr b -> IO [Ptr b]
unpackBlockArrayWithLength :: forall a b. Integral a => Int -> a -> Ptr b -> IO [Ptr b]
unpackBlockArrayWithLength Int
size a
n Ptr b
ptr = Int -> Int -> Ptr b -> IO [Ptr b]
forall b. Int -> Int -> Ptr b -> IO [Ptr b]
go Int
size (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) Ptr b
ptr
    where go       :: Int -> Int -> Ptr b -> IO [Ptr b]
          go :: forall b. Int -> Int -> Ptr b -> IO [Ptr b]
go Int
_ Int
0 Ptr b
_   = [Ptr b] -> IO [Ptr b]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
size Int
n Ptr b
ptr = do
            buf <- Ptr b -> CUInt -> IO (Ptr b)
forall a. Ptr a -> CUInt -> IO (Ptr a)
g_memdup Ptr b
ptr (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
            (buf :) <$> go size (n-1) (ptr `plusPtr` size)

unpackBoxedArrayWithLength :: forall a b. (Integral a, GBoxed b) =>
                              Int -> a -> Ptr b -> IO [Ptr b]
unpackBoxedArrayWithLength :: forall a b.
(Integral a, GBoxed b) =>
Int -> a -> Ptr b -> IO [Ptr b]
unpackBoxedArrayWithLength Int
size a
n Ptr b
ptr = Int -> Int -> Ptr b -> IO [Ptr b]
go Int
size (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) Ptr b
ptr
    where go       :: Int -> Int -> Ptr b -> IO [Ptr b]
          go :: Int -> Int -> Ptr b -> IO [Ptr b]
go Int
_ Int
0 Ptr b
_   = [Ptr b] -> IO [Ptr b]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
size Int
n Ptr b
ptr = do
            buf <- Ptr b -> IO (Ptr b)
forall a. GBoxed a => Ptr a -> IO (Ptr a)
copyBoxedPtr Ptr b
ptr
            (buf :) <$> go size (n-1) (ptr `plusPtr` size)

mapCArrayWithLength :: (Storable a, Integral b) =>
                       b -> (a -> IO c) -> Ptr a -> IO ()
mapCArrayWithLength :: forall a b c.
(Storable a, Integral b) =>
b -> (a -> IO c) -> Ptr a -> IO ()
mapCArrayWithLength b
n a -> IO c
f Ptr a
dataPtr
    | (Ptr a
dataPtr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | (b
n b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
0) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
        do ptr <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
dataPtr
           _ <- f ptr
           mapCArrayWithLength (n-1) f (dataPtr `plusPtr` sizeOf ptr)

mapGArray :: forall a b. Storable a => (a -> IO b) -> Ptr (GArray a) -> IO ()
mapGArray :: forall a b. Storable a => (a -> IO b) -> Ptr (GArray a) -> IO ()
mapGArray a -> IO b
f Ptr (GArray a)
array
    | (Ptr (GArray a)
array Ptr (GArray a) -> Ptr (GArray a) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (GArray a)
forall a. Ptr a
nullPtr) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
        do dataPtr <- Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek (Ptr (GArray a) -> Ptr (Ptr a)
forall a b. Ptr a -> Ptr b
castPtr Ptr (GArray a)
array :: Ptr (Ptr a))
           nitems <- peek (array `plusPtr` sizeOf dataPtr)
           go dataPtr nitems
               where go :: Ptr a -> Int -> IO ()
                     go :: Ptr a -> Int -> IO ()
go Ptr a
_ Int
0 = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                     go Ptr a
ptr Int
n = do
                       x <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr
                       _ <- f x
                       go (ptr `plusPtr` sizeOf x) (n-1)

mapPtrArray :: (Ptr a -> IO b) -> Ptr (GPtrArray (Ptr a)) -> IO ()
mapPtrArray :: forall a b. (Ptr a -> IO b) -> Ptr (GPtrArray (Ptr a)) -> IO ()
mapPtrArray Ptr a -> IO b
f Ptr (GPtrArray (Ptr a))
array = (Ptr a -> IO b) -> Ptr (GArray (Ptr a)) -> IO ()
forall a b. Storable a => (a -> IO b) -> Ptr (GArray a) -> IO ()
mapGArray Ptr a -> IO b
f (Ptr (GPtrArray (Ptr a)) -> Ptr (GArray (Ptr a))
forall a b. Ptr a -> Ptr b
castPtr Ptr (GPtrArray (Ptr a))
array)

mapGList :: (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
mapGList :: forall a b. (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
mapGList Ptr a -> IO b
f Ptr (GList (Ptr a))
glist
    | (Ptr (GList (Ptr a))
glist Ptr (GList (Ptr a)) -> Ptr (GList (Ptr a)) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (GList (Ptr a))
forall a. Ptr a
nullPtr) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
        do ptr <- Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek (Ptr (GList (Ptr a)) -> Ptr (Ptr a)
forall a b. Ptr a -> Ptr b
castPtr Ptr (GList (Ptr a))
glist)
           next <- peek (glist `plusPtr` sizeOf ptr)
           _ <- f ptr
           mapGList f next

mapGSList :: (Ptr a -> IO b) -> Ptr (GSList (Ptr a)) -> IO ()
mapGSList :: forall a b. (Ptr a -> IO b) -> Ptr (GSList (Ptr a)) -> IO ()
mapGSList Ptr a -> IO b
f Ptr (GSList (Ptr a))
gslist = (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
mapGList Ptr a -> IO b
f (Ptr (GSList (Ptr a)) -> Ptr (GList (Ptr a))
forall a b. Ptr a -> Ptr b
castPtr Ptr (GSList (Ptr a))
gslist)