{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The @GMainLoop@ struct is an opaque data type
-- representing the main event loop of a GLib or GTK+ application.

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

module GI.GLib.Structs.MainLoop
    ( 

-- * Exported types
    MainLoop(..)                            ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveMainLoopMethod                   ,
#endif


-- ** getContext #method:getContext#

#if defined(ENABLE_OVERLOADING)
    MainLoopGetContextMethodInfo            ,
#endif
    mainLoopGetContext                      ,


-- ** isRunning #method:isRunning#

#if defined(ENABLE_OVERLOADING)
    MainLoopIsRunningMethodInfo             ,
#endif
    mainLoopIsRunning                       ,


-- ** new #method:new#

    mainLoopNew                             ,


-- ** quit #method:quit#

#if defined(ENABLE_OVERLOADING)
    MainLoopQuitMethodInfo                  ,
#endif
    mainLoopQuit                            ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    MainLoopRefMethodInfo                   ,
#endif
    mainLoopRef                             ,


-- ** run #method:run#

#if defined(ENABLE_OVERLOADING)
    MainLoopRunMethodInfo                   ,
#endif
    mainLoopRun                             ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    MainLoopUnrefMethodInfo                 ,
#endif
    mainLoopUnref                           ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
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.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 {-# SOURCE #-} qualified GI.GLib.Structs.MainContext as GLib.MainContext

-- | Memory-managed wrapper type.
newtype MainLoop = MainLoop (SP.ManagedPtr MainLoop)
    deriving (MainLoop -> MainLoop -> Bool
(MainLoop -> MainLoop -> Bool)
-> (MainLoop -> MainLoop -> Bool) -> Eq MainLoop
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MainLoop -> MainLoop -> Bool
$c/= :: MainLoop -> MainLoop -> Bool
== :: MainLoop -> MainLoop -> Bool
$c== :: MainLoop -> MainLoop -> Bool
Eq)

instance SP.ManagedPtrNewtype MainLoop where
    toManagedPtr :: MainLoop -> ManagedPtr MainLoop
toManagedPtr (MainLoop ManagedPtr MainLoop
p) = ManagedPtr MainLoop
p

foreign import ccall "g_main_loop_get_type" c_g_main_loop_get_type :: 
    IO GType

type instance O.ParentTypes MainLoop = '[]
instance O.HasParentTypes MainLoop

instance B.Types.TypedObject MainLoop where
    glibType :: IO GType
glibType = IO GType
c_g_main_loop_get_type

instance B.Types.GBoxed MainLoop

-- | Convert 'MainLoop' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue MainLoop where
    toGValue :: MainLoop -> IO GValue
toGValue MainLoop
o = do
        GType
gtype <- IO GType
c_g_main_loop_get_type
        MainLoop -> (Ptr MainLoop -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr MainLoop
o (GType
-> (GValue -> Ptr MainLoop -> IO ()) -> Ptr MainLoop -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr MainLoop -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO MainLoop
fromGValue GValue
gv = do
        Ptr MainLoop
ptr <- GValue -> IO (Ptr MainLoop)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr MainLoop)
        (ManagedPtr MainLoop -> MainLoop) -> Ptr MainLoop -> IO MainLoop
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr MainLoop -> MainLoop
MainLoop Ptr MainLoop
ptr
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MainLoop
type instance O.AttributeList MainLoop = MainLoopAttributeList
type MainLoopAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method MainLoop::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "MainContext" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GMainContext  (if %NULL, the default context will be used)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "is_running"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "set to %TRUE to indicate that the loop is running. This\nis not very important since calling g_main_loop_run() will set this to\n%TRUE anyway."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "MainLoop" })
-- throws : False
-- Skip return : False

foreign import ccall "g_main_loop_new" g_main_loop_new :: 
    Ptr GLib.MainContext.MainContext ->     -- context : TInterface (Name {namespace = "GLib", name = "MainContext"})
    CInt ->                                 -- is_running : TBasicType TBoolean
    IO (Ptr MainLoop)

-- | Creates a new t'GI.GLib.Structs.MainLoop.MainLoop' structure.
mainLoopNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (GLib.MainContext.MainContext)
    -- ^ /@context@/: a t'GI.GLib.Structs.MainContext.MainContext'  (if 'P.Nothing', the default context will be used).
    -> Bool
    -- ^ /@isRunning@/: set to 'P.True' to indicate that the loop is running. This
    -- is not very important since calling 'GI.GLib.Structs.MainLoop.mainLoopRun' will set this to
    -- 'P.True' anyway.
    -> m MainLoop
    -- ^ __Returns:__ a new t'GI.GLib.Structs.MainLoop.MainLoop'.
mainLoopNew :: Maybe MainContext -> Bool -> m MainLoop
mainLoopNew Maybe MainContext
context Bool
isRunning = IO MainLoop -> m MainLoop
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MainLoop -> m MainLoop) -> IO MainLoop -> m MainLoop
forall a b. (a -> b) -> a -> b
$ do
    Ptr MainContext
maybeContext <- case Maybe MainContext
context of
        Maybe MainContext
Nothing -> Ptr MainContext -> IO (Ptr MainContext)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MainContext
forall a. Ptr a
nullPtr
        Just MainContext
jContext -> do
            Ptr MainContext
jContext' <- MainContext -> IO (Ptr MainContext)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MainContext
jContext
            Ptr MainContext -> IO (Ptr MainContext)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MainContext
jContext'
    let isRunning' :: CInt
isRunning' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
isRunning
    Ptr MainLoop
result <- Ptr MainContext -> CInt -> IO (Ptr MainLoop)
g_main_loop_new Ptr MainContext
maybeContext CInt
isRunning'
    Text -> Ptr MainLoop -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"mainLoopNew" Ptr MainLoop
result
    MainLoop
result' <- ((ManagedPtr MainLoop -> MainLoop) -> Ptr MainLoop -> IO MainLoop
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr MainLoop -> MainLoop
MainLoop) Ptr MainLoop
result
    Maybe MainContext -> (MainContext -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe MainContext
context MainContext -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    MainLoop -> IO MainLoop
forall (m :: * -> *) a. Monad m => a -> m a
return MainLoop
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method MainLoop::get_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "loop"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "MainLoop" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMainLoop." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GLib" , name = "MainContext" })
-- throws : False
-- Skip return : False

foreign import ccall "g_main_loop_get_context" g_main_loop_get_context :: 
    Ptr MainLoop ->                         -- loop : TInterface (Name {namespace = "GLib", name = "MainLoop"})
    IO (Ptr GLib.MainContext.MainContext)

-- | Returns the t'GI.GLib.Structs.MainContext.MainContext' of /@loop@/.
mainLoopGetContext ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MainLoop
    -- ^ /@loop@/: a t'GI.GLib.Structs.MainLoop.MainLoop'.
    -> m GLib.MainContext.MainContext
    -- ^ __Returns:__ the t'GI.GLib.Structs.MainContext.MainContext' of /@loop@/
mainLoopGetContext :: MainLoop -> m MainContext
mainLoopGetContext MainLoop
loop = IO MainContext -> m MainContext
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MainContext -> m MainContext)
-> IO MainContext -> m MainContext
forall a b. (a -> b) -> a -> b
$ do
    Ptr MainLoop
loop' <- MainLoop -> IO (Ptr MainLoop)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MainLoop
loop
    Ptr MainContext
result <- Ptr MainLoop -> IO (Ptr MainContext)
g_main_loop_get_context Ptr MainLoop
loop'
    Text -> Ptr MainContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"mainLoopGetContext" Ptr MainContext
result
    MainContext
result' <- ((ManagedPtr MainContext -> MainContext)
-> Ptr MainContext -> IO MainContext
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr MainContext -> MainContext
GLib.MainContext.MainContext) Ptr MainContext
result
    MainLoop -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MainLoop
loop
    MainContext -> IO MainContext
forall (m :: * -> *) a. Monad m => a -> m a
return MainContext
result'

#if defined(ENABLE_OVERLOADING)
data MainLoopGetContextMethodInfo
instance (signature ~ (m GLib.MainContext.MainContext), MonadIO m) => O.MethodInfo MainLoopGetContextMethodInfo MainLoop signature where
    overloadedMethod = mainLoopGetContext

#endif

-- method MainLoop::is_running
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "loop"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "MainLoop" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMainLoop." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_main_loop_is_running" g_main_loop_is_running :: 
    Ptr MainLoop ->                         -- loop : TInterface (Name {namespace = "GLib", name = "MainLoop"})
    IO CInt

-- | Checks to see if the main loop is currently being run via 'GI.GLib.Structs.MainLoop.mainLoopRun'.
mainLoopIsRunning ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MainLoop
    -- ^ /@loop@/: a t'GI.GLib.Structs.MainLoop.MainLoop'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the mainloop is currently being run.
mainLoopIsRunning :: MainLoop -> m Bool
mainLoopIsRunning MainLoop
loop = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MainLoop
loop' <- MainLoop -> IO (Ptr MainLoop)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MainLoop
loop
    CInt
result <- Ptr MainLoop -> IO CInt
g_main_loop_is_running Ptr MainLoop
loop'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    MainLoop -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MainLoop
loop
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MainLoopIsRunningMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo MainLoopIsRunningMethodInfo MainLoop signature where
    overloadedMethod = mainLoopIsRunning

#endif

-- method MainLoop::quit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "loop"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "MainLoop" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMainLoop" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_main_loop_quit" g_main_loop_quit :: 
    Ptr MainLoop ->                         -- loop : TInterface (Name {namespace = "GLib", name = "MainLoop"})
    IO ()

-- | Stops a t'GI.GLib.Structs.MainLoop.MainLoop' from running. Any calls to 'GI.GLib.Structs.MainLoop.mainLoopRun'
-- for the loop will return.
-- 
-- Note that sources that have already been dispatched when
-- 'GI.GLib.Structs.MainLoop.mainLoopQuit' is called will still be executed.
mainLoopQuit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MainLoop
    -- ^ /@loop@/: a t'GI.GLib.Structs.MainLoop.MainLoop'
    -> m ()
mainLoopQuit :: MainLoop -> m ()
mainLoopQuit MainLoop
loop = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MainLoop
loop' <- MainLoop -> IO (Ptr MainLoop)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MainLoop
loop
    Ptr MainLoop -> IO ()
g_main_loop_quit Ptr MainLoop
loop'
    MainLoop -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MainLoop
loop
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MainLoopQuitMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo MainLoopQuitMethodInfo MainLoop signature where
    overloadedMethod = mainLoopQuit

#endif

-- method MainLoop::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "loop"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "MainLoop" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMainLoop" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "MainLoop" })
-- throws : False
-- Skip return : False

foreign import ccall "g_main_loop_ref" g_main_loop_ref :: 
    Ptr MainLoop ->                         -- loop : TInterface (Name {namespace = "GLib", name = "MainLoop"})
    IO (Ptr MainLoop)

-- | Increases the reference count on a t'GI.GLib.Structs.MainLoop.MainLoop' object by one.
mainLoopRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MainLoop
    -- ^ /@loop@/: a t'GI.GLib.Structs.MainLoop.MainLoop'
    -> m MainLoop
    -- ^ __Returns:__ /@loop@/
mainLoopRef :: MainLoop -> m MainLoop
mainLoopRef MainLoop
loop = IO MainLoop -> m MainLoop
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MainLoop -> m MainLoop) -> IO MainLoop -> m MainLoop
forall a b. (a -> b) -> a -> b
$ do
    Ptr MainLoop
loop' <- MainLoop -> IO (Ptr MainLoop)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MainLoop
loop
    Ptr MainLoop
result <- Ptr MainLoop -> IO (Ptr MainLoop)
g_main_loop_ref Ptr MainLoop
loop'
    Text -> Ptr MainLoop -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"mainLoopRef" Ptr MainLoop
result
    MainLoop
result' <- ((ManagedPtr MainLoop -> MainLoop) -> Ptr MainLoop -> IO MainLoop
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr MainLoop -> MainLoop
MainLoop) Ptr MainLoop
result
    MainLoop -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MainLoop
loop
    MainLoop -> IO MainLoop
forall (m :: * -> *) a. Monad m => a -> m a
return MainLoop
result'

#if defined(ENABLE_OVERLOADING)
data MainLoopRefMethodInfo
instance (signature ~ (m MainLoop), MonadIO m) => O.MethodInfo MainLoopRefMethodInfo MainLoop signature where
    overloadedMethod = mainLoopRef

#endif

-- method MainLoop::run
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "loop"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "MainLoop" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMainLoop" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_main_loop_run" g_main_loop_run :: 
    Ptr MainLoop ->                         -- loop : TInterface (Name {namespace = "GLib", name = "MainLoop"})
    IO ()

-- | Runs a main loop until 'GI.GLib.Structs.MainLoop.mainLoopQuit' is called on the loop.
-- If this is called for the thread of the loop\'s t'GI.GLib.Structs.MainContext.MainContext',
-- it will process events from the loop, otherwise it will
-- simply wait.
mainLoopRun ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MainLoop
    -- ^ /@loop@/: a t'GI.GLib.Structs.MainLoop.MainLoop'
    -> m ()
mainLoopRun :: MainLoop -> m ()
mainLoopRun MainLoop
loop = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MainLoop
loop' <- MainLoop -> IO (Ptr MainLoop)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MainLoop
loop
    Ptr MainLoop -> IO ()
g_main_loop_run Ptr MainLoop
loop'
    MainLoop -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MainLoop
loop
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MainLoopRunMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo MainLoopRunMethodInfo MainLoop signature where
    overloadedMethod = mainLoopRun

#endif

-- method MainLoop::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "loop"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "MainLoop" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMainLoop" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_main_loop_unref" g_main_loop_unref :: 
    Ptr MainLoop ->                         -- loop : TInterface (Name {namespace = "GLib", name = "MainLoop"})
    IO ()

-- | Decreases the reference count on a t'GI.GLib.Structs.MainLoop.MainLoop' object by one. If
-- the result is zero, free the loop and free all associated memory.
mainLoopUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MainLoop
    -- ^ /@loop@/: a t'GI.GLib.Structs.MainLoop.MainLoop'
    -> m ()
mainLoopUnref :: MainLoop -> m ()
mainLoopUnref MainLoop
loop = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MainLoop
loop' <- MainLoop -> IO (Ptr MainLoop)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MainLoop
loop
    Ptr MainLoop -> IO ()
g_main_loop_unref Ptr MainLoop
loop'
    MainLoop -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MainLoop
loop
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MainLoopUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo MainLoopUnrefMethodInfo MainLoop signature where
    overloadedMethod = mainLoopUnref

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMainLoopMethod (t :: Symbol) (o :: *) :: * where
    ResolveMainLoopMethod "isRunning" o = MainLoopIsRunningMethodInfo
    ResolveMainLoopMethod "quit" o = MainLoopQuitMethodInfo
    ResolveMainLoopMethod "ref" o = MainLoopRefMethodInfo
    ResolveMainLoopMethod "run" o = MainLoopRunMethodInfo
    ResolveMainLoopMethod "unref" o = MainLoopUnrefMethodInfo
    ResolveMainLoopMethod "getContext" o = MainLoopGetContextMethodInfo
    ResolveMainLoopMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveMainLoopMethod t MainLoop, O.MethodInfo info MainLoop p) => OL.IsLabel t (MainLoop -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif