{-# 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall {a}. Enum a => [a] -> Int
go [a]
flags)
    where go :: [a] -> Int
go (a
f:[a]
fs) = forall a. Enum a => a -> Int
fromEnum a
f 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 = (forall a. Storable a => a -> Int
sizeOf a
w)forall a. Num a => a -> a -> a
*Int
8
      go :: Int -> [b]
go Int
k
          | Int
k forall a. Eq a => a -> a -> Bool
== Int
nbits = []
          | Bool
otherwise = if a
mask forall a. Bits a => a -> a -> a
.&. a
w forall a. Eq a => a -> a -> Bool
/= a
0
                        then forall a. Enum a => Int -> a
toEnum (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
mask) forall a. a -> [a] -> [a]
: Int -> [b]
go (Int
kforall a. Num a => a -> a -> a
+Int
1)
                        else Int -> [b]
go (Int
kforall a. Num a => a -> a -> a
+Int
1)
          where mask :: a
mask = forall a. Bits a => a -> Int -> a
shift a
1 Int
k

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

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

-- | Given a GSList construct the corresponding Haskell list.
unpackGList   :: Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList :: forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr a))
gsl
    | Ptr (GList (Ptr a))
gsl forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr = forall (m :: * -> *) a. Monad m => a -> m a
return []
    | Bool
otherwise =
        do Ptr a
x <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr (GList (Ptr a))
gsl)
           Ptr (GList (Ptr a))
next <- forall a. Storable a => Ptr a -> IO a
peek (Ptr (GList (Ptr a))
gsl forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf Ptr a
x)
           [Ptr a]
xs <- forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr a))
next
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr a
x 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 :: forall a. [Ptr a] -> IO (Ptr (GSList (Ptr a)))
packGSList [Ptr a]
l = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall a.
Ptr (GSList (Ptr a)) -> Ptr a -> IO (Ptr (GSList (Ptr a)))
g_slist_prepend forall a. Ptr a
nullPtr forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Ptr a]
l

-- | Given a GSList construct the corresponding Haskell list.
unpackGSList   :: Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList :: forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr a))
gsl = forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList (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 = forall a. Storable a => a -> Int
sizeOf ([a]
elemsforall a. [a] -> Int -> a
!!Int
0)
  Ptr (GArray ())
array <- CInt -> CInt -> CUInt -> IO (Ptr (GArray ()))
g_array_new CInt
0 CInt
0 (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
elems)
  Ptr a
dataPtr <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr (GArray ())
array :: Ptr (Ptr a))
  Ptr a -> [a] -> IO ()
fill Ptr a
dataPtr [a]
elems
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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
_ []       = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    fill Ptr a
ptr (a
x:[a]
xs) =
        do forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
x
           Ptr a -> [a] -> IO ()
fill (Ptr a
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (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
  Ptr a
dataPtr <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr (GArray a)
array :: Ptr (Ptr a))
  CUInt
nitems <- forall a. Storable a => Ptr a -> IO a
peek (Ptr (GArray a)
array forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf Ptr a
dataPtr)
  Ptr a -> CUInt -> IO [a]
go Ptr a
dataPtr CUInt
nitems
    where go :: Ptr a -> CUInt -> IO [a]
          go :: Ptr a -> CUInt -> IO [a]
go Ptr a
_ CUInt
0 = forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Ptr a
ptr CUInt
n = do
            a
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr
            (a
xforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> CUInt -> IO [a]
go (Ptr a
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf a
x) (CUInt
nforall a. Num a => a -> a -> a
-CUInt
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
  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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr a]
elems)
  Ptr (Ptr a)
dataPtr <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr (GPtrArray ())
array :: Ptr (Ptr (Ptr a)))
  forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill Ptr (Ptr a)
dataPtr [Ptr a]
elems
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr (GPtrArray ())
array
  where
    fill            :: Ptr (Ptr a) -> [Ptr a] -> IO ()
    fill :: forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill Ptr (Ptr a)
_ []       = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    fill Ptr (Ptr a)
ptr (Ptr a
x:[Ptr a]
xs) =
        do forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr a)
ptr Ptr a
x
           forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill (Ptr (Ptr a)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (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
  Ptr (Ptr a)
dataPtr <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr (GPtrArray (Ptr a))
array :: Ptr (Ptr (Ptr a)))
  CUInt
nitems <- forall a. Storable a => Ptr a -> IO a
peek (Ptr (GPtrArray (Ptr a))
array forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf Ptr (Ptr a)
dataPtr)
  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 :: forall a. Ptr (Ptr a) -> CUInt -> IO [Ptr a]
go Ptr (Ptr a)
_ CUInt
0 = forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Ptr (Ptr a)
ptr CUInt
n = do
            Ptr a
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
ptr
            (Ptr a
xforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Ptr (Ptr a) -> CUInt -> IO [Ptr a]
go (Ptr (Ptr a)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf Ptr a
x) (CUInt
nforall 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
_ <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
ptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dataPtr ->
                    forall a. Ptr GByteArray -> Ptr a -> CUInt -> IO (Ptr GByteArray)
g_byte_array_append Ptr GByteArray
array (Ptr Word8
dataPtr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset)
                                        (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
length)
  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 <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr GByteArray
array :: Ptr (Ptr CChar))
  CUInt
length <- forall a. Storable a => Ptr a -> IO a
peek (Ptr GByteArray
array forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (forall a. Storable a => a -> Int
sizeOf Ptr CChar
dataPtr)) :: IO CUInt
  CStringLen -> IO ByteString
B.packCStringLen (Ptr CChar
dataPtr, 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 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 = forall a. a -> Maybe a -> a
fromMaybe forall a. FunPtr a
nullFunPtr Maybe (GDestroyNotify a)
keyDestroy
      elemDPtr :: GDestroyNotify b
elemDPtr = forall a. a -> Maybe a -> a
fromMaybe forall a. FunPtr a
nullFunPtr Maybe (GDestroyNotify b)
elemDestroy
  Ptr (GHashTable a b)
ht <- 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
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (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
  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 :: forall a b.
Ptr (GHashTable a b) -> IO [(PtrWrapped a, PtrWrapped b)]
unpackGHashTable Ptr (GHashTable a b)
ht = do
  Ptr (GList (Ptr a))
keysGList <- 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 <- (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Ptr a -> PtrWrapped a
PtrWrapped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr a))
keysGList
  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 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b.
Ptr (GHashTable a b) -> PtrWrapped a -> IO (PtrWrapped b)
g_hash_table_lookup Ptr (GHashTable a b)
ht) [PtrWrapped a]
keys
  forall (m :: * -> *) a. Monad m => a -> m a
return (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 <- forall a b. Integral a => a -> IO (Ptr b)
allocBytes Int
length
  forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
ptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dataPtr ->
      forall a b. Ptr a -> Ptr b -> Int -> IO ()
memcpy Ptr Word8
mem (Ptr Word8
dataPtr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
length)
  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 <- forall a b. Integral a => a -> IO (Ptr b)
allocBytes (Int
lengthforall a. Num a => a -> a -> a
+Int
1)
  forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
ptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dataPtr ->
      forall a b. Ptr a -> Ptr b -> Int -> IO ()
memcpy Ptr Word8
mem (Ptr Word8
dataPtr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
length)
  forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
mem forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offsetforall a. Num a => a -> a -> a
+Int
length)) (Word8
0 :: Word8)
  forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
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 (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr, 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 (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 = forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray 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 = forall a b. (Num b, Storable b) => (a -> b) -> [a] -> IO (Ptr b)
packMapZeroTerminatedStorableArray 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 = forall a b c.
(Integral a, Storable b) =>
(b -> c) -> a -> Ptr b -> IO [c]
unpackMapStorableArrayWithLength 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 = forall a b.
(Eq a, Num a, Storable a) =>
(a -> b) -> Ptr a -> IO [b]
unpackMapZeroTerminatedStorableArray 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
items
  Ptr b
mem <- forall a b. Integral a => a -> IO (Ptr b)
allocBytes forall a b. (a -> b) -> a -> b
$ (forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined::b)) forall a. Num a => a -> a -> a
* Int
nitems
  Ptr b -> [b] -> IO ()
fill Ptr b
mem (forall a b. (a -> b) -> [a] -> [b]
map a -> b
fn [a]
items)
  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
_ []       = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        fill Ptr b
ptr (b
x:[b]
xs) = do
          forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr b
ptr b
x
          Ptr b -> [b] -> IO ()
fill (Ptr b
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
items
  Ptr b
mem <- forall a b. Integral a => a -> IO (Ptr b)
allocBytes forall a b. (a -> b) -> a -> b
$ (forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined::b)) forall a. Num a => a -> a -> a
* (Int
nitemsforall a. Num a => a -> a -> a
+Int
1)
  Ptr b -> [b] -> IO ()
fill Ptr b
mem (forall a b. (a -> b) -> [a] -> [b]
map a -> b
fn [a]
items)
  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 []     = forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr b
ptr b
0
        fill Ptr b
ptr (b
x:[b]
xs) = do
          forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr b
ptr b
x
          Ptr b -> [b] -> IO ()
fill (Ptr b
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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 = forall a b. (a -> b) -> [a] -> [b]
map b -> c
fn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr b -> IO [b]
go (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
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
n Ptr b
ptr = do
            b
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr b
ptr
            (b
xforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr b -> IO [b]
go (Int
nforall a. Num a => a -> a -> a
-Int
1) (Ptr b
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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 :: forall a b.
(Eq a, Num a, Storable a) =>
(a -> b) -> Ptr a -> IO [b]
unpackMapZeroTerminatedStorableArray a -> b
fn Ptr a
ptr = forall a b. (a -> b) -> [a] -> [b]
map a -> b
fn 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 <- forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr
            if a
x forall a. Eq a => a -> a -> Bool
== a
0
            then forall (m :: * -> *) a. Monad m => a -> m a
return []
            else (a
xforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO [a]
go (Ptr a
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
items
  Ptr (Ptr CChar)
mem <- forall a b. Integral a => a -> IO (Ptr b)
allocBytes forall a b. (a -> b) -> a -> b
$ Int
nitems forall a. Num a => a -> a -> a
* (forall a. Storable a => a -> Int
sizeOf (forall a. Ptr a
nullPtr :: CString))
  Ptr (Ptr CChar) -> [Text] -> IO ()
fill Ptr (Ptr CChar)
mem [Text]
items
  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)
_ []       = 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
                 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 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
items
    Ptr (Ptr CChar)
mem <- forall a b. Integral a => a -> IO (Ptr b)
allocBytes forall a b. (a -> b) -> a -> b
$ (forall a. Storable a => a -> Int
sizeOf (forall a. Ptr a
nullPtr :: CString)) forall a. Num a => a -> a -> a
* (Int
nitemsforall a. Num a => a -> a -> a
+Int
1)
    Ptr (Ptr CChar) -> [Text] -> IO ()
fill Ptr (Ptr CChar)
mem [Text]
items
    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 [] = forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
ptr 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
                               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 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf Ptr CChar
cstring) [Text]
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
            Ptr CChar
cstring <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
            if Ptr CChar
cstring forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
               then forall (m :: * -> *) a. Monad m => a -> m a
return []
               else (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Ptr CChar -> IO Text
cstringToText Ptr CChar
cstring
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr (Ptr CChar) -> IO [Text]
go (Ptr (Ptr CChar)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf Ptr CChar
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 (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)
_   = forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
n Ptr (Ptr CChar)
ptr = do
            Ptr CChar
cstring <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
            (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Ptr CChar -> IO Text
cstringToText Ptr CChar
cstring
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Ptr (Ptr CChar) -> IO [Text]
go (Int
nforall a. Num a => a -> a -> a
-Int
1) (Ptr (Ptr CChar)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
items
  Ptr (Ptr CChar)
mem <- forall a b. Integral a => a -> IO (Ptr b)
allocBytes forall a b. (a -> b) -> a -> b
$ Int
nitems forall a. Num a => a -> a -> a
* (forall a. Storable a => a -> Int
sizeOf (forall a. Ptr a
nullPtr :: CString))
  Ptr (Ptr CChar) -> [String] -> IO ()
fill Ptr (Ptr CChar)
mem [String]
items
  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)
_ []       = 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
                 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 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
items
    Ptr (Ptr CChar)
mem <- forall a b. Integral a => a -> IO (Ptr b)
allocBytes forall a b. (a -> b) -> a -> b
$ (forall a. Storable a => a -> Int
sizeOf (forall a. Ptr a
nullPtr :: CString)) forall a. Num a => a -> a -> a
* (Int
nitemsforall a. Num a => a -> a -> a
+Int
1)
    Ptr (Ptr CChar) -> [String] -> IO ()
fill Ptr (Ptr CChar)
mem [String]
items
    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 [] = forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
ptr 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
                               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 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf Ptr CChar
cstring) [String]
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
            Ptr CChar
cstring <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
            if Ptr CChar
cstring forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
               then forall (m :: * -> *) a. Monad m => a -> m a
return []
               else (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Ptr CChar -> IO String
cstringToString Ptr CChar
cstring
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr (Ptr CChar) -> IO [String]
go (Ptr (Ptr CChar)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf Ptr CChar
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 (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)
_   = forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
n Ptr (Ptr CChar)
ptr = do
            Ptr CChar
cstring <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
            (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Ptr CChar -> IO String
cstringToString Ptr CChar
cstring
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Ptr (Ptr CChar) -> IO [String]
go (Int
nforall a. Num a => a -> a -> a
-Int
1) (Ptr (Ptr CChar)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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 = 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
  forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL (String -> Text
T.pack String
"cstringToString") Ptr CChar
cstr
  Ptr CChar -> IO String
peekCString Ptr CChar
cstr

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

-- | Convert `Text` into a `CString`, using the GLib allocator.
textToCString :: Text -> IO CString
textToCString :: Text -> IO (Ptr CChar)
textToCString Text
str = forall a. Text -> (CStringLen -> IO a) -> IO a
TF.withCStringLen Text
str 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 forall a. Eq a => a -> a -> Bool
/= forall a. Ptr a
nullPtr
  then Ptr CChar -> Word64 -> IO (Ptr CChar)
g_strndup Ptr CChar
cstr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
  else 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 = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Text -> IO (Ptr CChar)
textToCString Text
text) 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
  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, 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 = 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
  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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr a]
items
  Ptr (Ptr a)
mem <- forall a b. Integral a => a -> IO (Ptr b)
allocBytes forall a b. (a -> b) -> a -> b
$ (forall a. Storable a => a -> Int
sizeOf (forall a. Ptr a
nullPtr :: Ptr a)) forall a. Num a => a -> a -> a
* Int
nitems
  forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill Ptr (Ptr a)
mem [Ptr a]
items
  forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr a)
mem
  where fill :: Ptr (Ptr a) -> [Ptr a] -> IO ()
        fill :: forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill Ptr (Ptr a)
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        fill Ptr (Ptr a)
ptr (Ptr a
x:[Ptr a]
xs) = do forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr a)
ptr Ptr a
x
                             forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill (Ptr (Ptr a)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr a]
items
  Ptr (Ptr a)
mem <- forall a b. Integral a => a -> IO (Ptr b)
allocBytes forall a b. (a -> b) -> a -> b
$ (forall a. Storable a => a -> Int
sizeOf (forall a. Ptr a
nullPtr :: Ptr a)) forall a. Num a => a -> a -> a
* (Int
nitemsforall a. Num a => a -> a -> a
+Int
1)
  forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill Ptr (Ptr a)
mem [Ptr a]
items
  forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr a)
mem
  where fill            :: Ptr (Ptr a) -> [Ptr a] -> IO ()
        fill :: forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill Ptr (Ptr a)
ptr []     = forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr a)
ptr forall a. Ptr a
nullPtr
        fill Ptr (Ptr a)
ptr (Ptr a
x:[Ptr a]
xs) = do forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr a)
ptr Ptr a
x
                             forall a. Ptr (Ptr a) -> [Ptr a] -> IO ()
fill (Ptr (Ptr a)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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 = forall a. Int -> Ptr (Ptr a) -> IO [Ptr a]
go (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)
_   = forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
n Ptr (Ptr a)
ptr = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
ptr
                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Int -> Ptr (Ptr a) -> IO [Ptr a]
go (Int
nforall a. Num a => a -> a -> a
-Int
1) (Ptr (Ptr a)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf (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 = 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
            Ptr a
p <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
ptr
            if Ptr a
p forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
            then forall (m :: * -> *) a. Monad m => a -> m a
return []
            else (Ptr a
pforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Ptr (Ptr a) -> IO [Ptr a]
go (Ptr (Ptr a)
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf Ptr a
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 forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
        do Ptr a
ptr <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
dataPtr
           if Ptr a
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
           then forall (m :: * -> *) a. Monad m => a -> m a
return ()
           else do
             b
_ <- Ptr a -> IO b
f Ptr a
ptr
             forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray Ptr a -> IO b
f (Ptr (Ptr a)
dataPtr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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 :: forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
size [Ptr a]
items = do
  let nitems :: Int
nitems = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr a]
items
  Ptr a
mem <- forall a b. Integral a => a -> IO (Ptr b)
allocBytes forall a b. (a -> b) -> a -> b
$ Int
size forall a. Num a => a -> a -> a
* Int
nitems
  forall a. Ptr a -> [Ptr a] -> IO ()
fill Ptr a
mem [Ptr a]
items
  forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
mem
  where fill :: Ptr a -> [Ptr a] -> IO ()
        fill :: forall a. Ptr a -> [Ptr a] -> IO ()
fill Ptr a
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        fill Ptr a
ptr (Ptr a
x:[Ptr a]
xs) = do forall a b. Ptr a -> Ptr b -> Int -> IO ()
memcpy Ptr a
ptr Ptr a
x Int
size
                             forall a. Ptr a -> [Ptr a] -> IO ()
fill (Ptr a
ptr 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 = forall b. Int -> Int -> Ptr b -> IO [Ptr b]
go Int
size (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
_   = forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
size Int
n Ptr b
ptr = do
            Ptr b
buf <- forall a. Ptr a -> CUInt -> IO (Ptr a)
g_memdup Ptr b
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
            (Ptr b
buf forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b. Int -> Int -> Ptr b -> IO [Ptr b]
go Int
size (Int
nforall a. Num a => a -> a -> a
-Int
1) (Ptr b
ptr 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 :: 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 (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
_   = forall (m :: * -> *) a. Monad m => a -> m a
return []
          go Int
size Int
n Ptr b
ptr = do
            Ptr b
buf <- forall a. GBoxed a => Ptr a -> IO (Ptr a)
copyBoxedPtr Ptr b
ptr
            (Ptr b
buf forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Ptr b -> IO [Ptr b]
go Int
size (Int
nforall a. Num a => a -> a -> a
-Int
1) (Ptr b
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
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 forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | (b
n forall a. Ord a => a -> a -> Bool
<= b
0) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
        do a
ptr <- forall a. Storable a => Ptr a -> IO a
peek Ptr a
dataPtr
           c
_ <- a -> IO c
f a
ptr
           forall a b c.
(Storable a, Integral b) =>
b -> (a -> IO c) -> Ptr a -> IO ()
mapCArrayWithLength (b
nforall a. Num a => a -> a -> a
-b
1) a -> IO c
f (Ptr a
dataPtr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf a
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 forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
        do Ptr a
dataPtr <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr (GArray a)
array :: Ptr (Ptr a))
           Int
nitems <- forall a. Storable a => Ptr a -> IO a
peek (Ptr (GArray a)
array forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
                     go Ptr a
ptr Int
n = do
                       a
x <- 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 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf a
x) (Int
nforall a. Num a => a -> a -> a
-Int
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 = forall a b. Storable a => (a -> IO b) -> Ptr (GArray a) -> IO ()
mapGArray Ptr a -> IO b
f (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 forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
        do Ptr a
ptr <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr (GList (Ptr a))
glist)
           Ptr (GList (Ptr a))
next <- forall a. Storable a => Ptr a -> IO a
peek (Ptr (GList (Ptr a))
glist forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf Ptr a
ptr)
           b
_ <- Ptr a -> IO b
f Ptr a
ptr
           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 :: forall a b. (Ptr a -> IO b) -> Ptr (GSList (Ptr a)) -> IO ()
mapGSList Ptr a -> IO b
f Ptr (GSList (Ptr a))
gslist = forall a b. (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
mapGList Ptr a -> IO b
f (forall a b. Ptr a -> Ptr b
castPtr Ptr (GSList (Ptr a))
gslist)