{-# 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.GHashTable (GEqualFunc, GHashFunc)
import Data.GI.Base.ManagedPtr (copyBoxedPtr)
import Data.GI.Base.Utils (allocBytes, callocBytes, memcpy, freeMem,
                           checkUnexpectedReturnNULL)



gflagsToWord :: (Num b, IsGFlag a) => [a] -> b
gflagsToWord :: [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 :: 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 :: [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 :: 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 (m :: * -> *) a. Monad m => a -> m a
return []
    | Bool
otherwise =
        do Ptr a
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)
           Ptr (GList (Ptr a))
next <- Ptr (Ptr (GList (Ptr a))) -> IO (Ptr (GList (Ptr a)))
forall a. Storable a => Ptr a -> IO a
peek (Ptr (GList (Ptr a))
gsl Ptr (GList (Ptr a)) -> Int -> Ptr (Ptr (GList (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 <- Ptr (GList (Ptr a)) -> IO [Ptr a]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr a))
next
           [Ptr a] -> IO [Ptr a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ptr a] -> IO [Ptr a]) -> [Ptr a] -> IO [Ptr a]
forall a b. (a -> b) -> a -> b
$ Ptr a
x Ptr a -> [Ptr a] -> [Ptr a]
forall a. a -> [a] -> [a]
: [Ptr a]
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 :: [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 :: 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 :: [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. [a] -> Int -> a
!!Int
0)
  Ptr (GArray ())
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)
  Ptr (GArray ())
_ <- Ptr (GArray ()) -> CUInt -> IO (Ptr (GArray ()))
g_array_set_size Ptr (GArray ())
array (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
elems)
  Ptr a
dataPtr <- Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek (Ptr (GArray ()) -> Ptr (Ptr a)
forall a b. Ptr a -> Ptr b
castPtr Ptr (GArray ())
array :: Ptr (Ptr a))
  Ptr a -> [a] -> IO ()
fill Ptr a
dataPtr [a]
elems
  Ptr (GArray a) -> IO (Ptr (GArray a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr (GArray a) -> IO (Ptr (GArray a)))
-> Ptr (GArray a) -> IO (Ptr (GArray a))
forall a b. (a -> b) -> a -> b
$ Ptr (GArray ()) -> Ptr (GArray a)
forall a b. Ptr a -> Ptr b
castPtr Ptr (GArray ())
array
  where
    fill            :: Ptr a -> [a] -> IO ()
    fill :: Ptr a -> [a] -> IO ()
fill Ptr a
_ []       = () -> IO ()
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 :: Ptr (GArray a) -> IO [a]
unpackGArray Ptr (GArray a)
array = do
  Ptr a
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))
  Int
nitems <- Ptr Int -> IO Int
forall a. Storable a => Ptr a -> IO a
peek (Ptr (GArray a)
array Ptr (GArray a) -> Int -> Ptr Int
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Ptr a -> Int
forall a. Storable a => a -> Int
sizeOf Ptr a
dataPtr)
  Ptr a -> Int -> IO [a]
go Ptr a
dataPtr Int
nitems
    where go :: Ptr a -> Int -> IO [a]
          go :: Ptr a -> Int -> IO [a]
go Ptr a
_ Int
0 = [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Ptr a
ptr Int
n = do
            a
x <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr
            (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> IO [a] -> IO [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> Int -> IO [a]
go (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) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
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 :: [Ptr a] -> IO (Ptr (GPtrArray (Ptr a)))
packGPtrArray [Ptr a]
elems = do
  Ptr (GPtrArray ())
array <- IO (Ptr (GPtrArray ()))
g_ptr_array_new
  Ptr (GPtrArray ())
_ <- Ptr (GPtrArray ()) -> CUInt -> IO (Ptr (GPtrArray ()))
g_ptr_array_set_size Ptr (GPtrArray ())
array (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ [Ptr a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr a]
elems)
  Ptr (Ptr a)
dataPtr <- Ptr (Ptr (Ptr a)) -> IO (Ptr (Ptr a))
forall a. Storable a => Ptr a -> IO a
peek (Ptr (GPtrArray ()) -> Ptr (Ptr (Ptr a))
forall a b. Ptr a -> Ptr b
castPtr Ptr (GPtrArray ())
array :: Ptr (Ptr (Ptr a)))
  Ptr (Ptr a) -> [Ptr a] -> IO ()
forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill Ptr (Ptr a)
dataPtr [Ptr a]
elems
  Ptr (GPtrArray (Ptr a)) -> IO (Ptr (GPtrArray (Ptr a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr (GPtrArray (Ptr a)) -> IO (Ptr (GPtrArray (Ptr a))))
-> Ptr (GPtrArray (Ptr a)) -> IO (Ptr (GPtrArray (Ptr a)))
forall a b. (a -> b) -> a -> b
$ Ptr (GPtrArray ()) -> Ptr (GPtrArray (Ptr a))
forall a b. Ptr a -> Ptr b
castPtr Ptr (GPtrArray ())
array
  where
    fill            :: Ptr (Ptr a) -> [Ptr a] -> IO ()
    fill :: Ptr (Ptr a) -> [Ptr a] -> IO ()
fill Ptr (Ptr a)
_ []       = () -> IO ()
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 :: Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray Ptr (GPtrArray (Ptr a))
array = do
  Ptr (Ptr a)
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)))
  CUInt
nitems <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr (GPtrArray (Ptr a))
array Ptr (GPtrArray (Ptr a)) -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Ptr (Ptr a) -> Int
forall a. Storable a => a -> Int
sizeOf Ptr (Ptr a)
dataPtr)
  Ptr (Ptr a) -> CUInt -> IO [Ptr a]
forall a. Ptr (Ptr a) -> CUInt -> IO [Ptr a]
go Ptr (Ptr a)
dataPtr CUInt
nitems
    where go :: Ptr (Ptr a) -> CUInt -> IO [Ptr a]
          go :: Ptr (Ptr a) -> CUInt -> IO [Ptr a]
go Ptr (Ptr a)
_ CUInt
0 = [Ptr a] -> IO [Ptr a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Ptr (Ptr a)
ptr CUInt
n = do
            Ptr a
x <- Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
ptr
            (Ptr a
xPtr a -> [Ptr a] -> [Ptr a]
forall a. a -> [a] -> [a]
:) ([Ptr a] -> [Ptr a]) -> IO [Ptr a] -> IO [Ptr a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (Ptr a) -> CUInt -> IO [Ptr a]
forall a. Ptr (Ptr a) -> CUInt -> IO [Ptr a]
go (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) (CUInt
nCUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
-CUInt
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
  Ptr GByteArray
array <- IO (Ptr GByteArray)
g_byte_array_new
  let (ForeignPtr Word8
ptr, Int
offset, Int
length) = ByteString -> (ForeignPtr Word8, Int, Int)
BI.toForeignPtr ByteString
bs
  Ptr GByteArray
_ <- ForeignPtr Word8
-> (Ptr Word8 -> IO (Ptr GByteArray)) -> IO (Ptr GByteArray)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
ptr ((Ptr Word8 -> IO (Ptr GByteArray)) -> IO (Ptr GByteArray))
-> (Ptr Word8 -> IO (Ptr GByteArray)) -> IO (Ptr GByteArray)
forall a b. (a -> b) -> a -> b
$ \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)
  Ptr GByteArray -> IO (Ptr GByteArray)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GByteArray
array

unpackGByteArray :: Ptr GByteArray -> IO ByteString
unpackGByteArray :: Ptr GByteArray -> IO ByteString
unpackGByteArray Ptr GByteArray
array = do
  Ptr CChar
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))
  CUInt
length <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr GByteArray
array Ptr GByteArray -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Ptr CChar -> Int
forall a. Storable a => a -> Int
sizeOf Ptr CChar
dataPtr)) :: IO CUInt
  CStringLen -> IO ByteString
B.packCStringLen (Ptr CChar
dataPtr, CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
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 237 "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 :: 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
  Ptr (GHashTable a b)
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
  ((PtrWrapped a, PtrWrapped b) -> IO Int32)
-> [(PtrWrapped a, PtrWrapped b)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((PtrWrapped a -> PtrWrapped b -> IO Int32)
-> (PtrWrapped a, PtrWrapped b) -> IO Int32
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Ptr (GHashTable a b) -> PtrWrapped a -> PtrWrapped b -> IO Int32
forall a b.
Ptr (GHashTable a b) -> PtrWrapped a -> PtrWrapped b -> IO Int32
g_hash_table_insert Ptr (GHashTable a b)
ht)) [(PtrWrapped a, PtrWrapped b)]
pairs
  Ptr (GHashTable a b) -> IO (Ptr (GHashTable a b))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GHashTable a b)
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 :: Ptr (GHashTable a b) -> IO [(PtrWrapped a, PtrWrapped b)]
unpackGHashTable Ptr (GHashTable a b)
ht = do
  Ptr (GList (Ptr a))
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
  [PtrWrapped a]
keys <- ((Ptr a -> PtrWrapped a) -> [Ptr a] -> [PtrWrapped a]
forall a b. (a -> b) -> [a] -> [b]
map (Ptr a -> PtrWrapped a
forall a. Ptr a -> PtrWrapped a
PtrWrapped (Ptr a -> PtrWrapped a)
-> (Ptr a -> Ptr a) -> Ptr a -> PtrWrapped a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr)) ([Ptr a] -> [PtrWrapped a]) -> IO [Ptr a] -> IO [PtrWrapped a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (GList (Ptr a)) -> IO [Ptr a]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr a))
keysGList
  Ptr (GList (Ptr a)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr a))
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.
  [PtrWrapped b]
elems <- (PtrWrapped a -> IO (PtrWrapped b))
-> [PtrWrapped a] -> IO [PtrWrapped b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ptr (GHashTable a b) -> PtrWrapped a -> IO (PtrWrapped b)
forall a b.
Ptr (GHashTable a b) -> PtrWrapped a -> IO (PtrWrapped b)
g_hash_table_lookup Ptr (GHashTable a b)
ht) [PtrWrapped a]
keys
  [(PtrWrapped a, PtrWrapped b)] -> IO [(PtrWrapped a, PtrWrapped b)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PtrWrapped a] -> [PtrWrapped b] -> [(PtrWrapped a, PtrWrapped b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PtrWrapped a]
keys [PtrWrapped b]
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
  Ptr Word8
mem <- Int -> IO (Ptr Word8)
forall a b. Integral a => a -> IO (Ptr b)
allocBytes Int
length
  ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
ptr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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)
  Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
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
  Ptr Word8
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)
  ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
ptr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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)
  Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
mem Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
length)) (Word8
0 :: Word8)
  Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
mem

unpackByteStringWithLength :: Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength :: 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 :: [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 :: [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 :: 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 :: 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 :: (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray a -> b
fn [a]
items = do
  let nitems :: Int
nitems = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
items
  Ptr b
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
  Ptr b -> [b] -> IO ()
fill Ptr b
mem ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
fn [a]
items)
  Ptr b -> IO (Ptr b)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr b
mem
  where fill            :: Ptr b -> [b] -> IO ()
        fill :: Ptr b -> [b] -> IO ()
fill Ptr b
_ []       = () -> IO ()
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 :: (a -> b) -> [a] -> IO (Ptr b)
packMapZeroTerminatedStorableArray a -> b
fn [a]
items = do
  let nitems :: Int
nitems = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
items
  Ptr b
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)
  Ptr b -> [b] -> IO ()
fill Ptr b
mem ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
fn [a]
items)
  Ptr b -> IO (Ptr b)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr b
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 :: (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 (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
n Ptr b
ptr = do
            b
x <- Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek Ptr b
ptr
            (b
xb -> [b] -> [b]
forall a. a -> [a] -> [a]
:) ([b] -> [b]) -> IO [b] -> IO [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr b -> IO [b]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (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)

unpackMapZeroTerminatedStorableArray :: forall a b. (Eq a, Num a, Storable a) =>
                                        (a -> b) -> Ptr a -> IO [b]
unpackMapZeroTerminatedStorableArray :: (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
            a
x <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr
            if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
            then [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
            else (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> IO [a] -> IO [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO [a]
go (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)

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

packZeroTerminatedUTF8CArray :: [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray :: [Text] -> IO (Ptr (Ptr CChar))
packZeroTerminatedUTF8CArray [Text]
items = do
    let nitems :: Int
nitems = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
items
    Ptr (Ptr CChar)
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)
    Ptr (Ptr CChar) -> [Text] -> IO ()
fill Ptr (Ptr CChar)
mem [Text]
items
    Ptr (Ptr CChar) -> IO (Ptr (Ptr CChar))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr CChar)
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 Ptr CChar
cstring <- Text -> IO (Ptr CChar)
textToCString Text
x
                               Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
ptr Ptr CChar
cstring
                               Ptr (Ptr CChar) -> [Text] -> IO ()
fill (Ptr (Ptr CChar)
ptr Ptr (Ptr CChar) -> Int -> Ptr (Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Ptr CChar -> Int
forall a. Storable a => a -> Int
sizeOf Ptr CChar
cstring) [Text]
xs

unpackZeroTerminatedUTF8CArray :: HasCallStack => Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray :: 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
            Ptr CChar
cstring <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
            if Ptr CChar
cstring Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
               then [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
               else (:) (Text -> [Text] -> [Text]) -> IO Text -> IO ([Text] -> [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
cstring
                        IO ([Text] -> [Text]) -> IO [Text] -> IO [Text]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr (Ptr CChar) -> IO [Text]
go (Ptr (Ptr CChar)
ptr Ptr (Ptr CChar) -> Int -> Ptr (Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Ptr CChar -> Int
forall a. Storable a => a -> Int
sizeOf Ptr CChar
cstring)

unpackUTF8CArrayWithLength :: (HasCallStack, Integral a) =>
                              a -> Ptr CString -> IO [Text]
unpackUTF8CArrayWithLength :: 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 (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
n Ptr (Ptr CChar)
ptr = do
            Ptr CChar
cstring <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
            (:) (Text -> [Text] -> [Text]) -> IO Text -> IO ([Text] -> [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
cstring
                    IO ([Text] -> [Text]) -> IO [Text] -> IO [Text]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Ptr (Ptr CChar) -> IO [Text]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Ptr (Ptr CChar)
ptr Ptr (Ptr CChar) -> Int -> Ptr (Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Ptr CChar -> Int
forall a. Storable a => a -> Int
sizeOf Ptr CChar
cstring)

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

packZeroTerminatedFileNameArray :: [String] -> IO (Ptr CString)
packZeroTerminatedFileNameArray :: [String] -> IO (Ptr (Ptr CChar))
packZeroTerminatedFileNameArray [String]
items = do
    let nitems :: Int
nitems = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
items
    Ptr (Ptr CChar)
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)
    Ptr (Ptr CChar) -> [String] -> IO ()
fill Ptr (Ptr CChar)
mem [String]
items
    Ptr (Ptr CChar) -> IO (Ptr (Ptr CChar))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr CChar)
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 Ptr CChar
cstring <- String -> IO (Ptr CChar)
stringToCString String
x
                               Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
ptr Ptr CChar
cstring
                               Ptr (Ptr CChar) -> [String] -> IO ()
fill (Ptr (Ptr CChar)
ptr Ptr (Ptr CChar) -> Int -> Ptr (Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Ptr CChar -> Int
forall a. Storable a => a -> Int
sizeOf Ptr CChar
cstring) [String]
xs

unpackZeroTerminatedFileNameArray :: HasCallStack => Ptr CString -> IO [String]
unpackZeroTerminatedFileNameArray :: 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
            Ptr CChar
cstring <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
            if Ptr CChar
cstring Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
               then [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
               else (:) (String -> [String] -> [String])
-> IO String -> IO ([String] -> [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Ptr CChar -> IO String
Ptr CChar -> IO String
cstringToString Ptr CChar
cstring
                        IO ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr (Ptr CChar) -> IO [String]
go (Ptr (Ptr CChar)
ptr Ptr (Ptr CChar) -> Int -> Ptr (Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Ptr CChar -> Int
forall a. Storable a => a -> Int
sizeOf Ptr CChar
cstring)

unpackFileNameArrayWithLength :: (HasCallStack, Integral a) =>
                                 a -> Ptr CString -> IO [String]
unpackFileNameArrayWithLength :: 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 (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
n Ptr (Ptr CChar)
ptr = do
            Ptr CChar
cstring <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
            (:) (String -> [String] -> [String])
-> IO String -> IO ([String] -> [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Ptr CChar -> IO String
Ptr CChar -> IO String
cstringToString Ptr CChar
cstring
                    IO ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Ptr (Ptr CChar) -> IO [String]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Ptr (Ptr CChar)
ptr Ptr (Ptr CChar) -> Int -> Ptr (Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Ptr CChar -> Int
forall a. Storable a => a -> Int
sizeOf Ptr CChar
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 :: 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 456 "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 :: 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 :: 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
  CSize
len <- Ptr CChar -> IO CSize
c_strlen Ptr CChar
cstr
  let cstrlen :: CStringLen
cstrlen = (Ptr CChar
cstr, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len)
  CStringLen -> IO Text
TF.peekCStringLen CStringLen
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 :: 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 :: [Ptr a] -> IO (Ptr (Ptr a))
packPtrArray [Ptr a]
items = do
  let nitems :: Int
nitems = [Ptr a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr a]
items
  Ptr (Ptr a)
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 (forall a. Ptr a
nullPtr :: Ptr a)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
nitems
  Ptr (Ptr a) -> [Ptr a] -> IO ()
forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill Ptr (Ptr a)
mem [Ptr a]
items
  Ptr (Ptr a) -> IO (Ptr (Ptr a))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr a)
mem
  where fill :: Ptr (Ptr a) -> [Ptr a] -> IO ()
        fill :: Ptr (Ptr a) -> [Ptr a] -> IO ()
fill Ptr (Ptr a)
_ [] = () -> IO ()
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 :: [Ptr a] -> IO (Ptr (Ptr a))
packZeroTerminatedPtrArray [Ptr a]
items = do
  let nitems :: Int
nitems = [Ptr a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr a]
items
  Ptr (Ptr a)
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 (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)
  Ptr (Ptr a) -> [Ptr a] -> IO ()
forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill Ptr (Ptr a)
mem [Ptr a]
items
  Ptr (Ptr a) -> IO (Ptr (Ptr a))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr a)
mem
  where fill            :: Ptr (Ptr a) -> [Ptr a] -> IO ()
        fill :: 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 :: 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 :: Int -> Ptr (Ptr a) -> IO [Ptr a]
go Int
0 Ptr (Ptr a)
_   = [Ptr a] -> IO [Ptr 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 (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 (forall a. Ptr a
nullPtr :: Ptr a))

unpackZeroTerminatedPtrArray :: Ptr (Ptr a) -> IO [Ptr a]
unpackZeroTerminatedPtrArray :: 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 :: Ptr (Ptr a) -> IO [Ptr a]
go Ptr (Ptr a)
ptr = do
            Ptr a
p <- Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
ptr
            if Ptr a
p Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr
            then [Ptr a] -> IO [Ptr a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
            else (Ptr a
pPtr a -> [Ptr a] -> [Ptr a]
forall a. a -> [a] -> [a]
:) ([Ptr a] -> [Ptr a]) -> IO [Ptr a] -> IO [Ptr a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (Ptr a) -> IO [Ptr a]
forall a. Ptr (Ptr a) -> IO [Ptr a]
go (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
p)

mapZeroTerminatedCArray :: (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray :: (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 (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
        do Ptr a
ptr <- Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
dataPtr
           if Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr
           then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           else do
             b
_ <- Ptr a -> IO b
f Ptr a
ptr
             (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray Ptr a -> IO b
f (Ptr (Ptr a)
dataPtr 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
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 :: Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
size [Ptr a]
items = do
  let nitems :: Int
nitems = [Ptr a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr a]
items
  Ptr a
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
  Ptr a -> [Ptr a] -> IO ()
forall a. Ptr a -> [Ptr a] -> IO ()
fill Ptr a
mem [Ptr a]
items
  Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
mem
  where fill :: Ptr a -> [Ptr a] -> IO ()
        fill :: Ptr a -> [Ptr a] -> IO ()
fill Ptr a
_ [] = () -> IO ()
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 :: 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 :: Int -> Int -> Ptr b -> IO [Ptr b]
go Int
_ Int
0 Ptr b
_   = [Ptr b] -> IO [Ptr b]
forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
size Int
n Ptr b
ptr = do
            Ptr b
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)
            (Ptr b
buf Ptr b -> [Ptr b] -> [Ptr b]
forall a. a -> [a] -> [a]
:) ([Ptr b] -> [Ptr b]) -> IO [Ptr b] -> IO [Ptr b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Ptr b -> IO [Ptr b]
forall b. Int -> Int -> Ptr b -> IO [Ptr b]
go Int
size (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Ptr b
ptr Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
size)

unpackBoxedArrayWithLength :: forall a b. (Integral a, GBoxed b) =>
                              Int -> a -> Ptr b -> IO [Ptr b]
unpackBoxedArrayWithLength :: 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 (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
size Int
n Ptr b
ptr = do
            Ptr b
buf <- Ptr b -> IO (Ptr b)
forall a. GBoxed a => Ptr a -> IO (Ptr a)
copyBoxedPtr Ptr b
ptr
            (Ptr b
buf Ptr b -> [Ptr b] -> [Ptr b]
forall a. a -> [a] -> [a]
:) ([Ptr b] -> [Ptr b]) -> IO [Ptr b] -> IO [Ptr b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Ptr b -> IO [Ptr b]
go Int
size (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Ptr b
ptr Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
size)

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

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

mapPtrArray :: (Ptr a -> IO b) -> Ptr (GPtrArray (Ptr a)) -> IO ()
mapPtrArray :: (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 :: (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 (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
        do Ptr a
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)
           Ptr (GList (Ptr a))
next <- Ptr (Ptr (GList (Ptr a))) -> IO (Ptr (GList (Ptr a)))
forall a. Storable a => Ptr a -> IO a
peek (Ptr (GList (Ptr a))
glist Ptr (GList (Ptr a)) -> Int -> Ptr (Ptr (GList (Ptr a)))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Ptr a -> Int
forall a. Storable a => a -> Int
sizeOf Ptr a
ptr)
           b
_ <- Ptr a -> IO b
f Ptr a
ptr
           (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 (GList (Ptr a))
next

mapGSList :: (Ptr a -> IO b) -> Ptr (GSList (Ptr a)) -> IO ()
mapGSList :: (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)