-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Json.Callbacks
    ( 

 -- * Signals


-- ** ArrayForeach #signal:ArrayForeach#

    ArrayForeach                            ,
    ArrayForeach_WithClosures               ,
    C_ArrayForeach                          ,
    drop_closures_ArrayForeach              ,
    dynamic_ArrayForeach                    ,
    genClosure_ArrayForeach                 ,
    mk_ArrayForeach                         ,
    noArrayForeach                          ,
    noArrayForeach_WithClosures             ,
    wrap_ArrayForeach                       ,


-- ** BoxedDeserializeFunc #signal:BoxedDeserializeFunc#

    BoxedDeserializeFunc                    ,
    C_BoxedDeserializeFunc                  ,
    dynamic_BoxedDeserializeFunc            ,
    genClosure_BoxedDeserializeFunc         ,
    mk_BoxedDeserializeFunc                 ,
    noBoxedDeserializeFunc                  ,
    wrap_BoxedDeserializeFunc               ,


-- ** BoxedSerializeFunc #signal:BoxedSerializeFunc#

    BoxedSerializeFunc                      ,
    C_BoxedSerializeFunc                    ,
    dynamic_BoxedSerializeFunc              ,
    genClosure_BoxedSerializeFunc           ,
    mk_BoxedSerializeFunc                   ,
    noBoxedSerializeFunc                    ,
    wrap_BoxedSerializeFunc                 ,


-- ** ObjectForeach #signal:ObjectForeach#

    C_ObjectForeach                         ,
    ObjectForeach                           ,
    ObjectForeach_WithClosures              ,
    drop_closures_ObjectForeach             ,
    dynamic_ObjectForeach                   ,
    genClosure_ObjectForeach                ,
    mk_ObjectForeach                        ,
    noObjectForeach                         ,
    noObjectForeach_WithClosures            ,
    wrap_ObjectForeach                      ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.Json.Structs.Array as Json.Array
import {-# SOURCE #-} qualified GI.Json.Structs.Node as Json.Node
import {-# SOURCE #-} qualified GI.Json.Structs.Object as Json.Object

-- callback ObjectForeach
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "object"
          , argType =
              TInterface Name { namespace = "Json" , name = "Object" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the iterated JSON object"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "member_name"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the name of the member"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "member_node"
          , argType = TInterface Name { namespace = "Json" , name = "Node" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the value of the member"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "data passed to the function"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 3
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "The function to be passed to [method@Json.Object.foreach_member].\n\nYou should not add or remove members to and from @object within\nthis function.\n\nIt is safe to change the value of @member_node."
        , sinceVersion = Just "0.8"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ObjectForeach =
    Ptr Json.Object.Object ->
    CString ->
    Ptr Json.Node.Node ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the iterated JSON object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ObjectForeach :: FunPtr C_ObjectForeach -> C_ObjectForeach

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ObjectForeach ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_ObjectForeach
    -> Json.Object.Object
    -- ^ /@object@/: the iterated JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> Json.Node.Node
    -- ^ /@memberNode@/: the value of the member
    -> Ptr ()
    -- ^ /@userData@/: data passed to the function
    -> m ()
dynamic_ObjectForeach :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_ObjectForeach -> Object -> Text -> Node -> Ptr () -> m ()
dynamic_ObjectForeach FunPtr C_ObjectForeach
__funPtr Object
object Text
memberName Node
memberNode Ptr ()
userData = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    Ptr Node
memberNode' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
memberNode
    (FunPtr C_ObjectForeach -> C_ObjectForeach
__dynamic_C_ObjectForeach FunPtr C_ObjectForeach
__funPtr) Ptr Object
object' CString
memberName' Ptr Node
memberNode' Ptr ()
userData
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
memberNode
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Generate a function pointer callable from C code, from a `C_ObjectForeach`.
foreign import ccall "wrapper"
    mk_ObjectForeach :: C_ObjectForeach -> IO (FunPtr C_ObjectForeach)

-- | The function to be passed to 'GI.Json.Structs.Object.objectForeachMember'.
-- 
-- You should not add or remove members to and from /@object@/ within
-- this function.
-- 
-- It is safe to change the value of /@memberNode@/.
-- 
-- /Since: 0.8/
type ObjectForeach =
    Json.Object.Object
    -- ^ /@object@/: the iterated JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> Json.Node.Node
    -- ^ /@memberNode@/: the value of the member
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ObjectForeach`@.
noObjectForeach :: Maybe ObjectForeach
noObjectForeach :: Maybe ObjectForeach
noObjectForeach = Maybe ObjectForeach
forall a. Maybe a
Nothing

-- | The function to be passed to 'GI.Json.Structs.Object.objectForeachMember'.
-- 
-- You should not add or remove members to and from /@object@/ within
-- this function.
-- 
-- It is safe to change the value of /@memberNode@/.
-- 
-- /Since: 0.8/
type ObjectForeach_WithClosures =
    Json.Object.Object
    -- ^ /@object@/: the iterated JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> Json.Node.Node
    -- ^ /@memberNode@/: the value of the member
    -> Ptr ()
    -- ^ /@userData@/: data passed to the function
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ObjectForeach_WithClosures`@.
noObjectForeach_WithClosures :: Maybe ObjectForeach_WithClosures
noObjectForeach_WithClosures :: Maybe ObjectForeach_WithClosures
noObjectForeach_WithClosures = Maybe ObjectForeach_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_ObjectForeach :: ObjectForeach -> ObjectForeach_WithClosures
drop_closures_ObjectForeach :: ObjectForeach -> ObjectForeach_WithClosures
drop_closures_ObjectForeach ObjectForeach
_f Object
object Text
memberName Node
memberNode Ptr ()
_ = ObjectForeach
_f Object
object Text
memberName Node
memberNode

-- | Wrap the callback into a `GClosure`.
genClosure_ObjectForeach :: MonadIO m => ObjectForeach -> m (GClosure C_ObjectForeach)
genClosure_ObjectForeach :: forall (m :: * -> *).
MonadIO m =>
ObjectForeach -> m (GClosure C_ObjectForeach)
genClosure_ObjectForeach ObjectForeach
cb = IO (GClosure C_ObjectForeach) -> m (GClosure C_ObjectForeach)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ObjectForeach) -> m (GClosure C_ObjectForeach))
-> IO (GClosure C_ObjectForeach) -> m (GClosure C_ObjectForeach)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: ObjectForeach_WithClosures
cb' = ObjectForeach -> ObjectForeach_WithClosures
drop_closures_ObjectForeach ObjectForeach
cb
    let cb'' :: C_ObjectForeach
cb'' = Maybe (Ptr (FunPtr C_ObjectForeach))
-> ObjectForeach_WithClosures -> C_ObjectForeach
wrap_ObjectForeach Maybe (Ptr (FunPtr C_ObjectForeach))
forall a. Maybe a
Nothing ObjectForeach_WithClosures
cb'
    C_ObjectForeach -> IO (FunPtr C_ObjectForeach)
mk_ObjectForeach C_ObjectForeach
cb'' IO (FunPtr C_ObjectForeach)
-> (FunPtr C_ObjectForeach -> IO (GClosure C_ObjectForeach))
-> IO (GClosure C_ObjectForeach)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ObjectForeach -> IO (GClosure C_ObjectForeach)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ObjectForeach` into a `C_ObjectForeach`.
wrap_ObjectForeach :: 
    Maybe (Ptr (FunPtr C_ObjectForeach)) ->
    ObjectForeach_WithClosures ->
    C_ObjectForeach
wrap_ObjectForeach :: Maybe (Ptr (FunPtr C_ObjectForeach))
-> ObjectForeach_WithClosures -> C_ObjectForeach
wrap_ObjectForeach Maybe (Ptr (FunPtr C_ObjectForeach))
gi'funptrptr ObjectForeach_WithClosures
gi'cb Ptr Object
object CString
memberName Ptr Node
memberNode Ptr ()
userData = do
    Ptr Object -> (Object -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr Object
object ((Object -> IO ()) -> IO ()) -> (Object -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Object
object' -> do
        Text
memberName' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
memberName
        Ptr Node -> (Node -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr Node
memberNode ((Node -> IO ()) -> IO ()) -> (Node -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Node
memberNode' -> do
            ObjectForeach_WithClosures
gi'cb  Object
object' Text
memberName' Node
memberNode' Ptr ()
userData
            Maybe (Ptr (FunPtr C_ObjectForeach)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ObjectForeach))
gi'funptrptr


-- callback BoxedSerializeFunc
{- Callable
  { returnType =
      Just (TInterface Name { namespace = "Json" , name = "Node" })
  , returnMayBeNull = False
  , returnTransfer = TransferEverything
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just "the newly created JSON node tree representing the boxed data"
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "boxed"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "a boxed data structure"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Serializes the passed `GBoxed` and stores it inside a `JsonNode`, for instance:\n\n```c\nstatic JsonNode *\nmy_point_serialize (gconstpointer boxed)\n{\n  const MyPoint *point = boxed;\n\n  g_autoptr(JsonBuilder) builder = json_builder_new ();\n\n  json_builder_begin_object (builder);\n  json_builder_set_member_name (builder, \"x\");\n  json_builder_add_double_value (builder, point->x);\n  json_builder_set_member_name (builder, \"y\");\n  json_builder_add_double_value (builder, point->y);\n  json_builder_end_object (builder);\n\n  return json_builder_get_root (builder);\n}\n```"
        , sinceVersion = Just "0.10"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_BoxedSerializeFunc =
    Ptr () ->
    IO (Ptr Json.Node.Node)

-- Args: [ Arg
--           { argCName = "boxed"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a boxed data structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Json" , name = "Node" })
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_BoxedSerializeFunc :: FunPtr C_BoxedSerializeFunc -> C_BoxedSerializeFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_BoxedSerializeFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_BoxedSerializeFunc
    -> Ptr ()
    -- ^ /@boxed@/: a boxed data structure
    -> m Json.Node.Node
    -- ^ __Returns:__ the newly created JSON node tree representing the boxed data
dynamic_BoxedSerializeFunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_BoxedSerializeFunc -> Ptr () -> m Node
dynamic_BoxedSerializeFunc FunPtr C_BoxedSerializeFunc
__funPtr Ptr ()
boxed = IO Node -> m Node
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Node -> m Node) -> IO Node -> m Node
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
result <- (FunPtr C_BoxedSerializeFunc -> C_BoxedSerializeFunc
__dynamic_C_BoxedSerializeFunc FunPtr C_BoxedSerializeFunc
__funPtr) Ptr ()
boxed
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"boxedSerializeFunc" Ptr Node
result
    Node
result' <- ((ManagedPtr Node -> Node) -> Ptr Node -> IO Node
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Node -> Node
Json.Node.Node) Ptr Node
result
    Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

-- | Generate a function pointer callable from C code, from a `C_BoxedSerializeFunc`.
foreign import ccall "wrapper"
    mk_BoxedSerializeFunc :: C_BoxedSerializeFunc -> IO (FunPtr C_BoxedSerializeFunc)

-- | Serializes the passed @GBoxed@ and stores it inside a @JsonNode@, for instance:
-- 
-- 
-- === /c code/
-- >static JsonNode *
-- >my_point_serialize (gconstpointer boxed)
-- >{
-- >  const MyPoint *point = boxed;
-- >
-- >  g_autoptr(JsonBuilder) builder = json_builder_new ();
-- >
-- >  json_builder_begin_object (builder);
-- >  json_builder_set_member_name (builder, "x");
-- >  json_builder_add_double_value (builder, point->x);
-- >  json_builder_set_member_name (builder, "y");
-- >  json_builder_add_double_value (builder, point->y);
-- >  json_builder_end_object (builder);
-- >
-- >  return json_builder_get_root (builder);
-- >}
-- 
-- 
-- /Since: 0.10/
type BoxedSerializeFunc =
    Ptr ()
    -- ^ /@boxed@/: a boxed data structure
    -> IO Json.Node.Node
    -- ^ __Returns:__ the newly created JSON node tree representing the boxed data

-- | A convenience synonym for @`Nothing` :: `Maybe` `BoxedSerializeFunc`@.
noBoxedSerializeFunc :: Maybe BoxedSerializeFunc
noBoxedSerializeFunc :: Maybe BoxedSerializeFunc
noBoxedSerializeFunc = Maybe BoxedSerializeFunc
forall a. Maybe a
Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_BoxedSerializeFunc :: MonadIO m => BoxedSerializeFunc -> m (GClosure C_BoxedSerializeFunc)
genClosure_BoxedSerializeFunc :: forall (m :: * -> *).
MonadIO m =>
BoxedSerializeFunc -> m (GClosure C_BoxedSerializeFunc)
genClosure_BoxedSerializeFunc BoxedSerializeFunc
cb = IO (GClosure C_BoxedSerializeFunc)
-> m (GClosure C_BoxedSerializeFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_BoxedSerializeFunc)
 -> m (GClosure C_BoxedSerializeFunc))
-> IO (GClosure C_BoxedSerializeFunc)
-> m (GClosure C_BoxedSerializeFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BoxedSerializeFunc
cb' = Maybe (Ptr (FunPtr C_BoxedSerializeFunc))
-> BoxedSerializeFunc -> C_BoxedSerializeFunc
wrap_BoxedSerializeFunc Maybe (Ptr (FunPtr C_BoxedSerializeFunc))
forall a. Maybe a
Nothing BoxedSerializeFunc
cb
    C_BoxedSerializeFunc -> IO (FunPtr C_BoxedSerializeFunc)
mk_BoxedSerializeFunc C_BoxedSerializeFunc
cb' IO (FunPtr C_BoxedSerializeFunc)
-> (FunPtr C_BoxedSerializeFunc
    -> IO (GClosure C_BoxedSerializeFunc))
-> IO (GClosure C_BoxedSerializeFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_BoxedSerializeFunc -> IO (GClosure C_BoxedSerializeFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `BoxedSerializeFunc` into a `C_BoxedSerializeFunc`.
wrap_BoxedSerializeFunc :: 
    Maybe (Ptr (FunPtr C_BoxedSerializeFunc)) ->
    BoxedSerializeFunc ->
    C_BoxedSerializeFunc
wrap_BoxedSerializeFunc :: Maybe (Ptr (FunPtr C_BoxedSerializeFunc))
-> BoxedSerializeFunc -> C_BoxedSerializeFunc
wrap_BoxedSerializeFunc Maybe (Ptr (FunPtr C_BoxedSerializeFunc))
gi'funptrptr BoxedSerializeFunc
gi'cb Ptr ()
boxed = do
    Node
result <- BoxedSerializeFunc
gi'cb  Ptr ()
boxed
    Maybe (Ptr (FunPtr C_BoxedSerializeFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_BoxedSerializeFunc))
gi'funptrptr
    Ptr Node
result' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Node
result
    Ptr Node -> IO (Ptr Node)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Node
result'


-- callback BoxedDeserializeFunc
{- Callable
  { returnType = Just (TBasicType TPtr)
  , returnMayBeNull = True
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText = Just "the newly created boxed structure"
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "node"
          , argType = TInterface Name { namespace = "Json" , name = "Node" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a node tree representing a boxed data"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Deserializes the contents of the passed `JsonNode` into a `GBoxed`, for instance:\n\n```c\nstatic gpointer\nmy_point_deserialize (JsonNode *node)\n{\n  double x = 0.0, y = 0.0;\n\n  if (JSON_NODE_HOLDS_ARRAY (node))\n    {\n      JsonArray *array = json_node_get_array (node);\n\n      if (json_array_get_length (array) == 2)\n        {\n          x = json_array_get_double_element (array, 0);\n          y = json_array_get_double_element (array, 1);\n        }\n    }\n  else if (JSON_NODE_HOLDS_OBJECT (node))\n    {\n      JsonObject *obj = json_node_get_object (node);\n\n      x = json_object_get_double_member_with_default (obj, \"x\", 0.0);\n      y = json_object_get_double_member_with_default (obj, \"y\", 0.0);\n    }\n\n  // my_point_new() is defined elsewhere\n  return my_point_new (x, y);\n}\n```"
        , sinceVersion = Just "0.10"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_BoxedDeserializeFunc =
    Ptr Json.Node.Node ->
    IO (Ptr ())

-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node tree representing a boxed data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_BoxedDeserializeFunc :: FunPtr C_BoxedDeserializeFunc -> C_BoxedDeserializeFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_BoxedDeserializeFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_BoxedDeserializeFunc
    -> Json.Node.Node
    -- ^ /@node@/: a node tree representing a boxed data
    -> m (Ptr ())
    -- ^ __Returns:__ the newly created boxed structure
dynamic_BoxedDeserializeFunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_BoxedDeserializeFunc -> Node -> m (Ptr ())
dynamic_BoxedDeserializeFunc FunPtr C_BoxedDeserializeFunc
__funPtr Node
node = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr ()
result <- (FunPtr C_BoxedDeserializeFunc -> C_BoxedDeserializeFunc
__dynamic_C_BoxedDeserializeFunc FunPtr C_BoxedDeserializeFunc
__funPtr) Ptr Node
node'
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

-- | Generate a function pointer callable from C code, from a `C_BoxedDeserializeFunc`.
foreign import ccall "wrapper"
    mk_BoxedDeserializeFunc :: C_BoxedDeserializeFunc -> IO (FunPtr C_BoxedDeserializeFunc)

-- | Deserializes the contents of the passed @JsonNode@ into a @GBoxed@, for instance:
-- 
-- 
-- === /c code/
-- >static gpointer
-- >my_point_deserialize (JsonNode *node)
-- >{
-- >  double x = 0.0, y = 0.0;
-- >
-- >  if (JSON_NODE_HOLDS_ARRAY (node))
-- >    {
-- >      JsonArray *array = json_node_get_array (node);
-- >
-- >      if (json_array_get_length (array) == 2)
-- >        {
-- >          x = json_array_get_double_element (array, 0);
-- >          y = json_array_get_double_element (array, 1);
-- >        }
-- >    }
-- >  else if (JSON_NODE_HOLDS_OBJECT (node))
-- >    {
-- >      JsonObject *obj = json_node_get_object (node);
-- >
-- >      x = json_object_get_double_member_with_default (obj, "x", 0.0);
-- >      y = json_object_get_double_member_with_default (obj, "y", 0.0);
-- >    }
-- >
-- >  // my_point_new() is defined elsewhere
-- >  return my_point_new (x, y);
-- >}
-- 
-- 
-- /Since: 0.10/
type BoxedDeserializeFunc =
    Json.Node.Node
    -- ^ /@node@/: a node tree representing a boxed data
    -> IO (Ptr ())
    -- ^ __Returns:__ the newly created boxed structure

-- | A convenience synonym for @`Nothing` :: `Maybe` `BoxedDeserializeFunc`@.
noBoxedDeserializeFunc :: Maybe BoxedDeserializeFunc
noBoxedDeserializeFunc :: Maybe BoxedDeserializeFunc
noBoxedDeserializeFunc = Maybe BoxedDeserializeFunc
forall a. Maybe a
Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_BoxedDeserializeFunc :: MonadIO m => BoxedDeserializeFunc -> m (GClosure C_BoxedDeserializeFunc)
genClosure_BoxedDeserializeFunc :: forall (m :: * -> *).
MonadIO m =>
BoxedDeserializeFunc -> m (GClosure C_BoxedDeserializeFunc)
genClosure_BoxedDeserializeFunc BoxedDeserializeFunc
cb = IO (GClosure C_BoxedDeserializeFunc)
-> m (GClosure C_BoxedDeserializeFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_BoxedDeserializeFunc)
 -> m (GClosure C_BoxedDeserializeFunc))
-> IO (GClosure C_BoxedDeserializeFunc)
-> m (GClosure C_BoxedDeserializeFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BoxedDeserializeFunc
cb' = Maybe (Ptr (FunPtr C_BoxedDeserializeFunc))
-> BoxedDeserializeFunc -> C_BoxedDeserializeFunc
wrap_BoxedDeserializeFunc Maybe (Ptr (FunPtr C_BoxedDeserializeFunc))
forall a. Maybe a
Nothing BoxedDeserializeFunc
cb
    C_BoxedDeserializeFunc -> IO (FunPtr C_BoxedDeserializeFunc)
mk_BoxedDeserializeFunc C_BoxedDeserializeFunc
cb' IO (FunPtr C_BoxedDeserializeFunc)
-> (FunPtr C_BoxedDeserializeFunc
    -> IO (GClosure C_BoxedDeserializeFunc))
-> IO (GClosure C_BoxedDeserializeFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_BoxedDeserializeFunc
-> IO (GClosure C_BoxedDeserializeFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `BoxedDeserializeFunc` into a `C_BoxedDeserializeFunc`.
wrap_BoxedDeserializeFunc :: 
    Maybe (Ptr (FunPtr C_BoxedDeserializeFunc)) ->
    BoxedDeserializeFunc ->
    C_BoxedDeserializeFunc
wrap_BoxedDeserializeFunc :: Maybe (Ptr (FunPtr C_BoxedDeserializeFunc))
-> BoxedDeserializeFunc -> C_BoxedDeserializeFunc
wrap_BoxedDeserializeFunc Maybe (Ptr (FunPtr C_BoxedDeserializeFunc))
gi'funptrptr BoxedDeserializeFunc
gi'cb Ptr Node
node = do
    Ptr Node -> BoxedDeserializeFunc -> IO (Ptr ())
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr Node
node (BoxedDeserializeFunc -> IO (Ptr ()))
-> BoxedDeserializeFunc -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Node
node' -> do
        Ptr ()
result <- BoxedDeserializeFunc
gi'cb  Node
node'
        Maybe (Ptr (FunPtr C_BoxedDeserializeFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_BoxedDeserializeFunc))
gi'funptrptr
        Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result


-- callback ArrayForeach
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "array"
          , argType = TInterface Name { namespace = "Json" , name = "Array" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the iterated JSON array"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "index_"
          , argType = TBasicType TUInt
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the index of the element"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "element_node"
          , argType = TInterface Name { namespace = "Json" , name = "Node" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the value of the element at the given @index_"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "data passed to the function"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 3
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "The function to be passed to [method@Json.Array.foreach_element].\n\nYou should not add or remove elements to and from @array within\nthis function.\n\nIt is safe to change the value of @element_node."
        , sinceVersion = Just "0.8"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ArrayForeach =
    Ptr Json.Array.Array ->
    Word32 ->
    Ptr Json.Node.Node ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "array"
--           , argType = TInterface Name { namespace = "Json" , name = "Array" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the iterated JSON array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the element"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "element_node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the element at the given @index_"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ArrayForeach :: FunPtr C_ArrayForeach -> C_ArrayForeach

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ArrayForeach ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_ArrayForeach
    -> Json.Array.Array
    -- ^ /@array@/: the iterated JSON array
    -> Word32
    -- ^ /@index_@/: the index of the element
    -> Json.Node.Node
    -- ^ /@elementNode@/: the value of the element at the given /@index_@/
    -> Ptr ()
    -- ^ /@userData@/: data passed to the function
    -> m ()
dynamic_ArrayForeach :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_ArrayForeach -> Array -> Word32 -> Node -> Ptr () -> m ()
dynamic_ArrayForeach FunPtr C_ArrayForeach
__funPtr Array
array Word32
index_ Node
elementNode Ptr ()
userData = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Ptr Node
elementNode' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
elementNode
    (FunPtr C_ArrayForeach -> C_ArrayForeach
__dynamic_C_ArrayForeach FunPtr C_ArrayForeach
__funPtr) Ptr Array
array' Word32
index_ Ptr Node
elementNode' Ptr ()
userData
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
elementNode
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Generate a function pointer callable from C code, from a `C_ArrayForeach`.
foreign import ccall "wrapper"
    mk_ArrayForeach :: C_ArrayForeach -> IO (FunPtr C_ArrayForeach)

-- | The function to be passed to 'GI.Json.Structs.Array.arrayForeachElement'.
-- 
-- You should not add or remove elements to and from /@array@/ within
-- this function.
-- 
-- It is safe to change the value of /@elementNode@/.
-- 
-- /Since: 0.8/
type ArrayForeach =
    Json.Array.Array
    -- ^ /@array@/: the iterated JSON array
    -> Word32
    -- ^ /@index_@/: the index of the element
    -> Json.Node.Node
    -- ^ /@elementNode@/: the value of the element at the given /@index_@/
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ArrayForeach`@.
noArrayForeach :: Maybe ArrayForeach
noArrayForeach :: Maybe ArrayForeach
noArrayForeach = Maybe ArrayForeach
forall a. Maybe a
Nothing

-- | The function to be passed to 'GI.Json.Structs.Array.arrayForeachElement'.
-- 
-- You should not add or remove elements to and from /@array@/ within
-- this function.
-- 
-- It is safe to change the value of /@elementNode@/.
-- 
-- /Since: 0.8/
type ArrayForeach_WithClosures =
    Json.Array.Array
    -- ^ /@array@/: the iterated JSON array
    -> Word32
    -- ^ /@index_@/: the index of the element
    -> Json.Node.Node
    -- ^ /@elementNode@/: the value of the element at the given /@index_@/
    -> Ptr ()
    -- ^ /@userData@/: data passed to the function
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ArrayForeach_WithClosures`@.
noArrayForeach_WithClosures :: Maybe ArrayForeach_WithClosures
noArrayForeach_WithClosures :: Maybe ArrayForeach_WithClosures
noArrayForeach_WithClosures = Maybe ArrayForeach_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_ArrayForeach :: ArrayForeach -> ArrayForeach_WithClosures
drop_closures_ArrayForeach :: ArrayForeach -> ArrayForeach_WithClosures
drop_closures_ArrayForeach ArrayForeach
_f Array
array Word32
index_ Node
elementNode Ptr ()
_ = ArrayForeach
_f Array
array Word32
index_ Node
elementNode

-- | Wrap the callback into a `GClosure`.
genClosure_ArrayForeach :: MonadIO m => ArrayForeach -> m (GClosure C_ArrayForeach)
genClosure_ArrayForeach :: forall (m :: * -> *).
MonadIO m =>
ArrayForeach -> m (GClosure C_ArrayForeach)
genClosure_ArrayForeach ArrayForeach
cb = IO (GClosure C_ArrayForeach) -> m (GClosure C_ArrayForeach)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ArrayForeach) -> m (GClosure C_ArrayForeach))
-> IO (GClosure C_ArrayForeach) -> m (GClosure C_ArrayForeach)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: ArrayForeach_WithClosures
cb' = ArrayForeach -> ArrayForeach_WithClosures
drop_closures_ArrayForeach ArrayForeach
cb
    let cb'' :: C_ArrayForeach
cb'' = Maybe (Ptr (FunPtr C_ArrayForeach))
-> ArrayForeach_WithClosures -> C_ArrayForeach
wrap_ArrayForeach Maybe (Ptr (FunPtr C_ArrayForeach))
forall a. Maybe a
Nothing ArrayForeach_WithClosures
cb'
    C_ArrayForeach -> IO (FunPtr C_ArrayForeach)
mk_ArrayForeach C_ArrayForeach
cb'' IO (FunPtr C_ArrayForeach)
-> (FunPtr C_ArrayForeach -> IO (GClosure C_ArrayForeach))
-> IO (GClosure C_ArrayForeach)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ArrayForeach -> IO (GClosure C_ArrayForeach)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ArrayForeach` into a `C_ArrayForeach`.
wrap_ArrayForeach :: 
    Maybe (Ptr (FunPtr C_ArrayForeach)) ->
    ArrayForeach_WithClosures ->
    C_ArrayForeach
wrap_ArrayForeach :: Maybe (Ptr (FunPtr C_ArrayForeach))
-> ArrayForeach_WithClosures -> C_ArrayForeach
wrap_ArrayForeach Maybe (Ptr (FunPtr C_ArrayForeach))
gi'funptrptr ArrayForeach_WithClosures
gi'cb Ptr Array
array Word32
index_ Ptr Node
elementNode Ptr ()
userData = do
    Ptr Array -> (Array -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr Array
array ((Array -> IO ()) -> IO ()) -> (Array -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Array
array' -> do
        Ptr Node -> (Node -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr Node
elementNode ((Node -> IO ()) -> IO ()) -> (Node -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Node
elementNode' -> do
            ArrayForeach_WithClosures
gi'cb  Array
array' Word32
index_ Node
elementNode' Ptr ()
userData
            Maybe (Ptr (FunPtr C_ArrayForeach)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ArrayForeach))
gi'funptrptr