{-# 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)))
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
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
foreign import ccall "g_slist_prepend" g_slist_prepend ::
Ptr (GSList (Ptr a)) -> Ptr a -> IO (Ptr (GSList (Ptr a)))
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
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
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
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" #-}
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) ->
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)
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)