{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.WebKit2.Structs.ApplicationInfo
    ( 

-- * Exported types
    ApplicationInfo(..)                     ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveApplicationInfoMethod            ,
#endif


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    ApplicationInfoGetNameMethodInfo        ,
#endif
    applicationInfoGetName                  ,


-- ** getVersion #method:getVersion#

#if defined(ENABLE_OVERLOADING)
    ApplicationInfoGetVersionMethodInfo     ,
#endif
    applicationInfoGetVersion               ,


-- ** new #method:new#

    applicationInfoNew                      ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    ApplicationInfoRefMethodInfo            ,
#endif
    applicationInfoRef                      ,


-- ** setName #method:setName#

#if defined(ENABLE_OVERLOADING)
    ApplicationInfoSetNameMethodInfo        ,
#endif
    applicationInfoSetName                  ,


-- ** setVersion #method:setVersion#

#if defined(ENABLE_OVERLOADING)
    ApplicationInfoSetVersionMethodInfo     ,
#endif
    applicationInfoSetVersion               ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    ApplicationInfoUnrefMethodInfo          ,
#endif
    applicationInfoUnref                    ,




    ) 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


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

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

foreign import ccall "webkit_application_info_get_type" c_webkit_application_info_get_type :: 
    IO GType

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

instance B.Types.TypedObject ApplicationInfo where
    glibType :: IO GType
glibType = IO GType
c_webkit_application_info_get_type

instance B.Types.GBoxed ApplicationInfo

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


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

-- method ApplicationInfo::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2" , name = "ApplicationInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_application_info_new" webkit_application_info_new :: 
    IO (Ptr ApplicationInfo)

-- | Creates a new t'GI.WebKit2.Structs.ApplicationInfo.ApplicationInfo'
-- 
-- /Since: 2.18/
applicationInfoNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ApplicationInfo
    -- ^ __Returns:__ the newly created t'GI.WebKit2.Structs.ApplicationInfo.ApplicationInfo'.
applicationInfoNew :: m ApplicationInfo
applicationInfoNew  = IO ApplicationInfo -> m ApplicationInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ApplicationInfo -> m ApplicationInfo)
-> IO ApplicationInfo -> m ApplicationInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr ApplicationInfo
result <- IO (Ptr ApplicationInfo)
webkit_application_info_new
    Text -> Ptr ApplicationInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"applicationInfoNew" Ptr ApplicationInfo
result
    ApplicationInfo
result' <- ((ManagedPtr ApplicationInfo -> ApplicationInfo)
-> Ptr ApplicationInfo -> IO ApplicationInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ApplicationInfo -> ApplicationInfo
ApplicationInfo) Ptr ApplicationInfo
result
    ApplicationInfo -> IO ApplicationInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ApplicationInfo
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ApplicationInfo::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "ApplicationInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitApplicationInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_application_info_get_name" webkit_application_info_get_name :: 
    Ptr ApplicationInfo ->                  -- info : TInterface (Name {namespace = "WebKit2", name = "ApplicationInfo"})
    IO CString

-- | Get the name of the application. If 'GI.WebKit2.Structs.ApplicationInfo.applicationInfoSetName' hasn\'t been
-- called with a valid name, this returns 'GI.GLib.Functions.getPrgname'.
-- 
-- /Since: 2.18/
applicationInfoGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ApplicationInfo
    -- ^ /@info@/: a t'GI.WebKit2.Structs.ApplicationInfo.ApplicationInfo'
    -> m T.Text
    -- ^ __Returns:__ the application name
applicationInfoGetName :: ApplicationInfo -> m Text
applicationInfoGetName ApplicationInfo
info = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr ApplicationInfo
info' <- ApplicationInfo -> IO (Ptr ApplicationInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ApplicationInfo
info
    CString
result <- Ptr ApplicationInfo -> IO CString
webkit_application_info_get_name Ptr ApplicationInfo
info'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"applicationInfoGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    ApplicationInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ApplicationInfo
info
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ApplicationInfoGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo ApplicationInfoGetNameMethodInfo ApplicationInfo signature where
    overloadedMethod = applicationInfoGetName

#endif

-- method ApplicationInfo::get_version
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "ApplicationInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitApplicationInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "major"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the major version number"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "minor"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the minor version number"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "micro"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the micro version number"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_application_info_get_version" webkit_application_info_get_version :: 
    Ptr ApplicationInfo ->                  -- info : TInterface (Name {namespace = "WebKit2", name = "ApplicationInfo"})
    Ptr Word64 ->                           -- major : TBasicType TUInt64
    Ptr Word64 ->                           -- minor : TBasicType TUInt64
    Ptr Word64 ->                           -- micro : TBasicType TUInt64
    IO ()

-- | Get the application version previously set with 'GI.WebKit2.Structs.ApplicationInfo.applicationInfoSetVersion'.
-- 
-- /Since: 2.18/
applicationInfoGetVersion ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ApplicationInfo
    -- ^ /@info@/: a t'GI.WebKit2.Structs.ApplicationInfo.ApplicationInfo'
    -> m ((Word64, Word64, Word64))
applicationInfoGetVersion :: ApplicationInfo -> m (Word64, Word64, Word64)
applicationInfoGetVersion ApplicationInfo
info = IO (Word64, Word64, Word64) -> m (Word64, Word64, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word64, Word64, Word64) -> m (Word64, Word64, Word64))
-> IO (Word64, Word64, Word64) -> m (Word64, Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ApplicationInfo
info' <- ApplicationInfo -> IO (Ptr ApplicationInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ApplicationInfo
info
    Ptr Word64
major <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
minor <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
micro <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr ApplicationInfo
-> Ptr Word64 -> Ptr Word64 -> Ptr Word64 -> IO ()
webkit_application_info_get_version Ptr ApplicationInfo
info' Ptr Word64
major Ptr Word64
minor Ptr Word64
micro
    Word64
major' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
major
    Word64
minor' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
minor
    Word64
micro' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
micro
    ApplicationInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ApplicationInfo
info
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
major
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
minor
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
micro
    (Word64, Word64, Word64) -> IO (Word64, Word64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
major', Word64
minor', Word64
micro')

#if defined(ENABLE_OVERLOADING)
data ApplicationInfoGetVersionMethodInfo
instance (signature ~ (m ((Word64, Word64, Word64))), MonadIO m) => O.MethodInfo ApplicationInfoGetVersionMethodInfo ApplicationInfo signature where
    overloadedMethod = applicationInfoGetVersion

#endif

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

foreign import ccall "webkit_application_info_ref" webkit_application_info_ref :: 
    Ptr ApplicationInfo ->                  -- info : TInterface (Name {namespace = "WebKit2", name = "ApplicationInfo"})
    IO (Ptr ApplicationInfo)

-- | Atomically increments the reference count of /@info@/ by one. This
-- function is MT-safe and may be called from any thread.
-- 
-- /Since: 2.18/
applicationInfoRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ApplicationInfo
    -- ^ /@info@/: a t'GI.WebKit2.Structs.ApplicationInfo.ApplicationInfo'
    -> m ApplicationInfo
    -- ^ __Returns:__ The passed in t'GI.WebKit2.Structs.ApplicationInfo.ApplicationInfo'
applicationInfoRef :: ApplicationInfo -> m ApplicationInfo
applicationInfoRef ApplicationInfo
info = IO ApplicationInfo -> m ApplicationInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ApplicationInfo -> m ApplicationInfo)
-> IO ApplicationInfo -> m ApplicationInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr ApplicationInfo
info' <- ApplicationInfo -> IO (Ptr ApplicationInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ApplicationInfo
info
    Ptr ApplicationInfo
result <- Ptr ApplicationInfo -> IO (Ptr ApplicationInfo)
webkit_application_info_ref Ptr ApplicationInfo
info'
    Text -> Ptr ApplicationInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"applicationInfoRef" Ptr ApplicationInfo
result
    ApplicationInfo
result' <- ((ManagedPtr ApplicationInfo -> ApplicationInfo)
-> Ptr ApplicationInfo -> IO ApplicationInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ApplicationInfo -> ApplicationInfo
ApplicationInfo) Ptr ApplicationInfo
result
    ApplicationInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ApplicationInfo
info
    ApplicationInfo -> IO ApplicationInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ApplicationInfo
result'

#if defined(ENABLE_OVERLOADING)
data ApplicationInfoRefMethodInfo
instance (signature ~ (m ApplicationInfo), MonadIO m) => O.MethodInfo ApplicationInfoRefMethodInfo ApplicationInfo signature where
    overloadedMethod = applicationInfoRef

#endif

-- method ApplicationInfo::set_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "ApplicationInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitApplicationInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the application name"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_application_info_set_name" webkit_application_info_set_name :: 
    Ptr ApplicationInfo ->                  -- info : TInterface (Name {namespace = "WebKit2", name = "ApplicationInfo"})
    CString ->                              -- name : TBasicType TUTF8
    IO ()

-- | Set the name of the application. If not provided, or 'P.Nothing' is passed,
-- 'GI.GLib.Functions.getPrgname' will be used.
-- 
-- /Since: 2.18/
applicationInfoSetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ApplicationInfo
    -- ^ /@info@/: a t'GI.WebKit2.Structs.ApplicationInfo.ApplicationInfo'
    -> T.Text
    -- ^ /@name@/: the application name
    -> m ()
applicationInfoSetName :: ApplicationInfo -> Text -> m ()
applicationInfoSetName ApplicationInfo
info Text
name = 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 ApplicationInfo
info' <- ApplicationInfo -> IO (Ptr ApplicationInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ApplicationInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr ApplicationInfo -> CString -> IO ()
webkit_application_info_set_name Ptr ApplicationInfo
info' CString
name'
    ApplicationInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ApplicationInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ApplicationInfoSetNameMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.MethodInfo ApplicationInfoSetNameMethodInfo ApplicationInfo signature where
    overloadedMethod = applicationInfoSetName

#endif

-- method ApplicationInfo::set_version
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "ApplicationInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitApplicationInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "major"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the major version number"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "minor"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the minor version number"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "micro"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the micro version number"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_application_info_set_version" webkit_application_info_set_version :: 
    Ptr ApplicationInfo ->                  -- info : TInterface (Name {namespace = "WebKit2", name = "ApplicationInfo"})
    Word64 ->                               -- major : TBasicType TUInt64
    Word64 ->                               -- minor : TBasicType TUInt64
    Word64 ->                               -- micro : TBasicType TUInt64
    IO ()

-- | Set the application version. If the application doesn\'t use the format
-- major.minor.micro you can pass 0 as the micro to use major.minor, or pass
-- 0 as both micro and minor to use only major number. Any other format must
-- be converted to major.minor.micro so that it can be used in version comparisons.
-- 
-- /Since: 2.18/
applicationInfoSetVersion ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ApplicationInfo
    -- ^ /@info@/: a t'GI.WebKit2.Structs.ApplicationInfo.ApplicationInfo'
    -> Word64
    -- ^ /@major@/: the major version number
    -> Word64
    -- ^ /@minor@/: the minor version number
    -> Word64
    -- ^ /@micro@/: the micro version number
    -> m ()
applicationInfoSetVersion :: ApplicationInfo -> Word64 -> Word64 -> Word64 -> m ()
applicationInfoSetVersion ApplicationInfo
info Word64
major Word64
minor Word64
micro = 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 ApplicationInfo
info' <- ApplicationInfo -> IO (Ptr ApplicationInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ApplicationInfo
info
    Ptr ApplicationInfo -> Word64 -> Word64 -> Word64 -> IO ()
webkit_application_info_set_version Ptr ApplicationInfo
info' Word64
major Word64
minor Word64
micro
    ApplicationInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ApplicationInfo
info
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ApplicationInfoSetVersionMethodInfo
instance (signature ~ (Word64 -> Word64 -> Word64 -> m ()), MonadIO m) => O.MethodInfo ApplicationInfoSetVersionMethodInfo ApplicationInfo signature where
    overloadedMethod = applicationInfoSetVersion

#endif

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

foreign import ccall "webkit_application_info_unref" webkit_application_info_unref :: 
    Ptr ApplicationInfo ->                  -- info : TInterface (Name {namespace = "WebKit2", name = "ApplicationInfo"})
    IO ()

-- | Atomically decrements the reference count of /@info@/ by one. If the
-- reference count drops to 0, all memory allocated by the t'GI.WebKit2.Structs.ApplicationInfo.ApplicationInfo' is
-- released. This function is MT-safe and may be called from any
-- thread.
-- 
-- /Since: 2.18/
applicationInfoUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ApplicationInfo
    -- ^ /@info@/: a t'GI.WebKit2.Structs.ApplicationInfo.ApplicationInfo'
    -> m ()
applicationInfoUnref :: ApplicationInfo -> m ()
applicationInfoUnref ApplicationInfo
info = 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 ApplicationInfo
info' <- ApplicationInfo -> IO (Ptr ApplicationInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ApplicationInfo
info
    Ptr ApplicationInfo -> IO ()
webkit_application_info_unref Ptr ApplicationInfo
info'
    ApplicationInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ApplicationInfo
info
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ApplicationInfoUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo ApplicationInfoUnrefMethodInfo ApplicationInfo signature where
    overloadedMethod = applicationInfoUnref

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveApplicationInfoMethod (t :: Symbol) (o :: *) :: * where
    ResolveApplicationInfoMethod "ref" o = ApplicationInfoRefMethodInfo
    ResolveApplicationInfoMethod "unref" o = ApplicationInfoUnrefMethodInfo
    ResolveApplicationInfoMethod "getName" o = ApplicationInfoGetNameMethodInfo
    ResolveApplicationInfoMethod "getVersion" o = ApplicationInfoGetVersionMethodInfo
    ResolveApplicationInfoMethod "setName" o = ApplicationInfoSetNameMethodInfo
    ResolveApplicationInfoMethod "setVersion" o = ApplicationInfoSetVersionMethodInfo
    ResolveApplicationInfoMethod l o = O.MethodResolutionFailed l o

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

#endif