{-# LINE 1 "Data/GI/Base/Utils.hsc" #-}
{-# LANGUAGE ScopedTypeVariables, TupleSections, OverloadedStrings,
    FlexibleContexts, ConstraintKinds, TypeApplications #-}
{- | Assorted utility functions for bindings. -}
module Data.GI.Base.Utils
    ( whenJust
    , maybeM
    , maybeFromPtr
    , mapFirst
    , mapFirstA
    , mapSecond
    , mapSecondA
    , convertIfNonNull
    , convertFunPtrIfNonNull
    , callocBytes
    , callocBoxedBytes
    , callocMem
    , allocBytes
    , allocMem
    , freeMem
    , ptr_to_g_free
    , memcpy
    , safeFreeFunPtr
    , safeFreeFunPtrPtr
    , maybeReleaseFunPtr
    , checkUnexpectedReturnNULL
    , checkUnexpectedNothing
    , dbgLog
    ) where



import Control.Exception (throwIO)
import Control.Monad (void)

import qualified Data.Text as T
import qualified Data.Text.Foreign as TF

{-# LINE 40 "Data/GI/Base/Utils.hsc" #-}
import Data.Word


{-# LINE 45 "Data/GI/Base/Utils.hsc" #-}
import Foreign.C.Types (CSize(..), CChar)
import Foreign.Ptr (Ptr, nullPtr, FunPtr, nullFunPtr, freeHaskellFunPtr)
import Foreign.Storable (Storable(..))

import Data.GI.Base.BasicTypes (GType(..), CGType, GBoxed,
                                TypedObject(glibType),
                                UnexpectedNullPointerReturn(..))
import Data.GI.Base.CallStack (HasCallStack, callStack, prettyCallStack)

-- | When the given value is of "Just a" form, execute the given action,
-- otherwise do nothing.
whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust :: Maybe a -> (a -> m ()) -> m ()
whenJust (Just a
v) a -> m ()
f = a -> m ()
f a
v
whenJust Maybe a
Nothing a -> m ()
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Like `Control.Monad.maybe`, but for actions on a monad, and with
-- slightly different argument order.
maybeM :: Monad m => b -> Maybe a -> (a -> m b) -> m b
maybeM :: b -> Maybe a -> (a -> m b) -> m b
maybeM b
d Maybe a
Nothing a -> m b
_ = b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
d
maybeM b
_ (Just a
v) a -> m b
action = a -> m b
action a
v

-- | Check if the pointer is `nullPtr`, and wrap it on a `Maybe`
-- accordingly.
maybeFromPtr :: Ptr a -> Maybe (Ptr a)
maybeFromPtr :: Ptr a -> Maybe (Ptr a)
maybeFromPtr Ptr a
ptr = if Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr
                   then Maybe (Ptr a)
forall a. Maybe a
Nothing
                   else Ptr a -> Maybe (Ptr a)
forall a. a -> Maybe a
Just Ptr a
ptr

-- | Given a function and a list of two-tuples, apply the function to
-- every first element of the tuples.
mapFirst :: (a -> c) -> [(a,b)] -> [(c,b)]
mapFirst :: (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst a -> c
_ [] = []
mapFirst a -> c
f ((a
x,b
y) : [(a, b)]
rest) = (a -> c
f a
x, b
y) (c, b) -> [(c, b)] -> [(c, b)]
forall a. a -> [a] -> [a]
: (a -> c) -> [(a, b)] -> [(c, b)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst a -> c
f [(a, b)]
rest

-- | Same for the second element.
mapSecond :: (b -> c) -> [(a,b)] -> [(a,c)]
mapSecond :: (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond b -> c
_ [] = []
mapSecond b -> c
f ((a
x,b
y) : [(a, b)]
rest) = (a
x, b -> c
f b
y) (a, c) -> [(a, c)] -> [(a, c)]
forall a. a -> [a] -> [a]
: (b -> c) -> [(a, b)] -> [(a, c)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond b -> c
f [(a, b)]
rest

-- | Applicative version of `mapFirst`.
mapFirstA :: Applicative f => (a -> f c) -> [(a,b)] -> f [(c,b)]
mapFirstA :: (a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA a -> f c
_ [] = [(c, b)] -> f [(c, b)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
mapFirstA a -> f c
f ((a
x,b
y) : [(a, b)]
rest) = (:) ((c, b) -> [(c, b)] -> [(c, b)])
-> f (c, b) -> f ([(c, b)] -> [(c, b)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,b
y) (c -> (c, b)) -> f c -> f (c, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
x) f ([(c, b)] -> [(c, b)]) -> f [(c, b)] -> f [(c, b)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> [(a, b)] -> f [(c, b)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA a -> f c
f [(a, b)]
rest

-- | Applicative version of `mapSecond`.
mapSecondA :: Applicative f => (b -> f c) -> [(a,b)] -> f [(a,c)]
mapSecondA :: (b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA b -> f c
_ [] = [(a, c)] -> f [(a, c)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
mapSecondA b -> f c
f ((a
x,b
y) : [(a, b)]
rest) = (:) ((a, c) -> [(a, c)] -> [(a, c)])
-> f (a, c) -> f ([(a, c)] -> [(a, c)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a
x,) (c -> (a, c)) -> f c -> f (a, c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f c
f b
y) f ([(a, c)] -> [(a, c)]) -> f [(a, c)] -> f [(a, c)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (b -> f c) -> [(a, b)] -> f [(a, c)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA b -> f c
f [(a, b)]
rest

-- | Apply the given conversion action to the given pointer if it is
-- non-NULL, otherwise return `Nothing`.
convertIfNonNull :: Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull :: Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr a
ptr Ptr a -> IO b
convert = if Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr
                               then Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
                               else b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> IO b -> IO (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO b
convert Ptr a
ptr

-- | Apply the given conversion action to the given function pointer
-- if it is non-NULL, otherwise return `Nothing`.
convertFunPtrIfNonNull :: FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
convertFunPtrIfNonNull :: FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
convertFunPtrIfNonNull FunPtr a
ptr FunPtr a -> IO b
convert = if FunPtr a
ptr FunPtr a -> FunPtr a -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr a
forall a. FunPtr a
nullFunPtr
                                     then Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
                                     else b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> IO b -> IO (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FunPtr a -> IO b
convert FunPtr a
ptr

foreign import ccall "g_malloc0" g_malloc0 ::
    Word64 -> IO (Ptr a)
{-# LINE 110 "Data/GI/Base/Utils.hsc" #-}

-- | Make a zero-filled allocation using the GLib allocator.
{-# INLINE callocBytes #-}
callocBytes :: Int -> IO (Ptr a)
callocBytes :: Int -> IO (Ptr a)
callocBytes Int
n =  Word64 -> IO (Ptr a)
forall a. Word64 -> IO (Ptr a)
g_malloc0 (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)

-- | Make a zero-filled allocation of enough size to hold the given
-- `Storable` type, using the GLib allocator.
{-# INLINE callocMem #-}
callocMem :: forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr a)
callocMem = Word64 -> IO (Ptr a)
forall a. Word64 -> IO (Ptr a)
g_malloc0 (Word64 -> IO (Ptr a)) -> Word64 -> IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> (a -> Int) -> a -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Storable a => a -> Int
sizeOf) (a
forall a. HasCallStack => a
undefined :: a)

foreign import ccall "g_boxed_copy" g_boxed_copy ::
    CGType -> Ptr a -> IO (Ptr a)

-- | Make a zero filled allocation of n bytes for a boxed object. The
-- difference with a normal callocBytes is that the returned memory is
-- allocated using whatever memory allocator g_boxed_copy uses, which
-- in particular may well be different from a plain g_malloc. In
-- particular g_slice_alloc is often used for allocating boxed
-- objects, which are then freed using g_slice_free.
callocBoxedBytes :: forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes :: Int -> IO (Ptr a)
callocBoxedBytes Int
n = do
  Ptr a
ptr <- Int -> IO (Ptr a)
forall a. Int -> IO (Ptr a)
callocBytes Int
n
  GType Word64
cgtype <- TypedObject a => IO GType
forall a. TypedObject a => IO GType
glibType @a
  Ptr a
result <- Word64 -> Ptr a -> IO (Ptr a)
forall a. Word64 -> Ptr a -> IO (Ptr a)
g_boxed_copy Word64
cgtype Ptr a
ptr
  Ptr a -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr a
ptr
  Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
result

foreign import ccall "g_malloc" g_malloc ::
    Word64 -> IO (Ptr a)
{-# LINE 141 "Data/GI/Base/Utils.hsc" #-}

-- | Allocate the given number of bytes using the GLib allocator.
{-# INLINE allocBytes #-}
allocBytes :: Integral a => a -> IO (Ptr b)
allocBytes :: a -> IO (Ptr b)
allocBytes a
n = Word64 -> IO (Ptr b)
forall a. Word64 -> IO (Ptr a)
g_malloc (a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)

-- | Allocate space for the given `Storable` using the GLib allocator.
{-# INLINE allocMem #-}
allocMem :: forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr a)
allocMem = Word64 -> IO (Ptr a)
forall a. Word64 -> IO (Ptr a)
g_malloc (Word64 -> IO (Ptr a)) -> Word64 -> IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> (a -> Int) -> a -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Storable a => a -> Int
sizeOf) (a
forall a. HasCallStack => a
undefined :: a)

-- | A wrapper for `g_free`.
foreign import ccall "g_free" freeMem :: Ptr a -> IO ()

-- | Pointer to `g_free`.
foreign import ccall "&g_free" ptr_to_g_free :: FunPtr (Ptr a -> IO ())

foreign import ccall unsafe "string.h memcpy" _memcpy :: Ptr a -> Ptr b -> CSize -> IO (Ptr ())

-- | Copy memory into a destination (in the first argument) from a
-- source (in the second argument).
{-# INLINE memcpy #-}
memcpy :: Ptr a -> Ptr b -> Int -> IO ()
memcpy :: Ptr a -> Ptr b -> Int -> IO ()
memcpy Ptr a
dest Ptr b
src Int
n = IO (Ptr ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Ptr ()) -> IO ()) -> IO (Ptr ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr a -> Ptr b -> CSize -> IO (Ptr ())
forall a b. Ptr a -> Ptr b -> CSize -> IO (Ptr ())
_memcpy Ptr a
dest Ptr b
src (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)

-- | Same as freeHaskellFunPtr, but it does nothing when given a
-- nullPtr.
foreign import ccall "safeFreeFunPtr" safeFreeFunPtr ::
    Ptr a -> IO ()

-- | A pointer to `safeFreeFunPtr`.
foreign import ccall "& safeFreeFunPtr" safeFreeFunPtrPtr ::
    FunPtr (Ptr a -> IO ())

-- | If given a pointer to the memory location, free the `FunPtr` at
-- that location, and then the pointer itself. Useful for freeing the
-- memory associated to callbacks which are called just once, with no
-- destroy notification.
maybeReleaseFunPtr :: Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr :: Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr a))
Nothing = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
maybeReleaseFunPtr (Just Ptr (FunPtr a)
f) = do
  Ptr (FunPtr a) -> IO (FunPtr a)
forall a. Storable a => Ptr a -> IO a
peek Ptr (FunPtr a)
f IO (FunPtr a) -> (FunPtr a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr a -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr
  Ptr (FunPtr a) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (FunPtr a)
f

-- | Check that the given pointer is not NULL. If it is, raise a
-- `UnexpectedNullPointerReturn` exception.
checkUnexpectedReturnNULL :: HasCallStack => T.Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL :: Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
fnName Ptr a
ptr
    | Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr =
        UnexpectedNullPointerReturn -> IO ()
forall e a. Exception e => e -> IO a
throwIO (UnexpectedNullPointerReturn :: Text -> UnexpectedNullPointerReturn
UnexpectedNullPointerReturn {
                   nullPtrErrorMsg :: Text
nullPtrErrorMsg = Text
"Received unexpected nullPtr in \""
                                     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fnName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\".\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                     Text
"This might be a bug in the introspection data, or perhaps a use-after-free bug.\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                     Text
"If in doubt, please report it at\n\thttps://github.com/haskell-gi/haskell-gi/issues\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                     String -> Text
T.pack (CallStack -> String
prettyCallStack CallStack
HasCallStack => CallStack
callStack)
                 })
    | Bool
otherwise = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | An annotated version of `fromJust`, which raises a
-- `UnexpectedNullPointerReturn` in case it encounters a `Nothing`.
checkUnexpectedNothing :: HasCallStack => T.Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing :: Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
fnName IO (Maybe a)
action = do
  Maybe a
result <- IO (Maybe a)
action
  case Maybe a
result of
    Just a
r -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
    Maybe a
Nothing -> UnexpectedNullPointerReturn -> IO a
forall e a. Exception e => e -> IO a
throwIO (UnexpectedNullPointerReturn :: Text -> UnexpectedNullPointerReturn
UnexpectedNullPointerReturn {
                 nullPtrErrorMsg :: Text
nullPtrErrorMsg = Text
"Received unexpected Nothing in \""
                                     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fnName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\".\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                     Text
"This might be a bug in the introspection data, or perhaps a use-after-free bug.\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                     Text
"If in doubt, please report it at\n\thttps://github.com/haskell-gi/haskell-gi/issues\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                     String -> Text
T.pack (CallStack -> String
prettyCallStack CallStack
HasCallStack => CallStack
callStack)
                 })

foreign import ccall unsafe "dbg_log_with_len" dbg_log_with_len ::
        Ptr CChar -> Int -> IO ()

-- | Print a string to the debug log in an atomic way (so the output
-- of different threads does not get intermingled).
dbgLog :: T.Text -> IO ()
dbgLog :: Text -> IO ()
dbgLog Text
msg = Text -> (CStringLen -> IO ()) -> IO ()
forall a. Text -> (CStringLen -> IO a) -> IO a
TF.withCStringLen Text
msg ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
len) -> Ptr CChar -> Int -> IO ()
dbg_log_with_len Ptr CChar
ptr Int
len