{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- 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.Dazzle.Structs.Counter
    ( 

-- * Exported types
    Counter(..)                             ,
    newZeroCounter                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [get]("GI.Dazzle.Structs.Counter#g:method:get"), [reset]("GI.Dazzle.Structs.Counter#g:method:reset").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveCounterMethod                    ,
#endif

-- ** get #method:get#

#if defined(ENABLE_OVERLOADING)
    CounterGetMethodInfo                    ,
#endif
    counterGet                              ,


-- ** reset #method:reset#

#if defined(ENABLE_OVERLOADING)
    CounterResetMethodInfo                  ,
#endif
    counterReset                            ,




 -- * Properties


-- ** category #attr:category#
-- | /No description available in the introspection data./

    clearCounterCategory                    ,
#if defined(ENABLE_OVERLOADING)
    counter_category                        ,
#endif
    getCounterCategory                      ,
    setCounterCategory                      ,


-- ** description #attr:description#
-- | /No description available in the introspection data./

    clearCounterDescription                 ,
#if defined(ENABLE_OVERLOADING)
    counter_description                     ,
#endif
    getCounterDescription                   ,
    setCounterDescription                   ,


-- ** name #attr:name#
-- | /No description available in the introspection data./

    clearCounterName                        ,
#if defined(ENABLE_OVERLOADING)
    counter_name                            ,
#endif
    getCounterName                          ,
    setCounterName                          ,


-- ** values #attr:values#
-- | /No description available in the introspection data./

    clearCounterValues                      ,
#if defined(ENABLE_OVERLOADING)
    counter_values                          ,
#endif
    getCounterValues                        ,
    setCounterValues                        ,




    ) 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.Kind as DK
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 qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import {-# SOURCE #-} qualified GI.Dazzle.Structs.CounterValue as Dazzle.CounterValue

#else
import {-# SOURCE #-} qualified GI.Dazzle.Structs.CounterValue as Dazzle.CounterValue

#endif

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

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

instance BoxedPtr Counter where
    boxedPtrCopy :: Counter -> IO Counter
boxedPtrCopy = \Counter
p -> Counter -> (Ptr Counter -> IO Counter) -> IO Counter
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Counter
p (Int -> Ptr Counter -> IO (Ptr Counter)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
32 (Ptr Counter -> IO (Ptr Counter))
-> (Ptr Counter -> IO Counter) -> Ptr Counter -> IO Counter
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr Counter -> Counter) -> Ptr Counter -> IO Counter
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr Counter -> Counter
Counter)
    boxedPtrFree :: Counter -> IO ()
boxedPtrFree = \Counter
x -> Counter -> (Ptr Counter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr Counter
x Ptr Counter -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr Counter where
    boxedPtrCalloc :: IO (Ptr Counter)
boxedPtrCalloc = Int -> IO (Ptr Counter)
forall a. Int -> IO (Ptr a)
callocBytes Int
32


-- | Construct a `Counter` struct initialized to zero.
newZeroCounter :: MonadIO m => m Counter
newZeroCounter :: forall (m :: * -> *). MonadIO m => m Counter
newZeroCounter = IO Counter -> m Counter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Counter -> m Counter) -> IO Counter -> m Counter
forall a b. (a -> b) -> a -> b
$ IO (Ptr Counter)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr Counter) -> (Ptr Counter -> IO Counter) -> IO Counter
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Counter -> Counter) -> Ptr Counter -> IO Counter
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Counter -> Counter
Counter

instance tag ~ 'AttrSet => Constructible Counter tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr Counter -> Counter)
-> [AttrOp Counter tag] -> m Counter
new ManagedPtr Counter -> Counter
_ [AttrOp Counter tag]
attrs = do
        Counter
o <- m Counter
forall (m :: * -> *). MonadIO m => m Counter
newZeroCounter
        Counter -> [AttrOp Counter 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set Counter
o [AttrOp Counter tag]
[AttrOp Counter 'AttrSet]
attrs
        Counter -> m Counter
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Counter
o


-- | Get the value of the “@values@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' counter #values
-- @
getCounterValues :: MonadIO m => Counter -> m (Maybe Dazzle.CounterValue.CounterValue)
getCounterValues :: forall (m :: * -> *).
MonadIO m =>
Counter -> m (Maybe CounterValue)
getCounterValues Counter
s = IO (Maybe CounterValue) -> m (Maybe CounterValue)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CounterValue) -> m (Maybe CounterValue))
-> IO (Maybe CounterValue) -> m (Maybe CounterValue)
forall a b. (a -> b) -> a -> b
$ Counter
-> (Ptr Counter -> IO (Maybe CounterValue))
-> IO (Maybe CounterValue)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Counter
s ((Ptr Counter -> IO (Maybe CounterValue))
 -> IO (Maybe CounterValue))
-> (Ptr Counter -> IO (Maybe CounterValue))
-> IO (Maybe CounterValue)
forall a b. (a -> b) -> a -> b
$ \Ptr Counter
ptr -> do
    Ptr CounterValue
val <- Ptr (Ptr CounterValue) -> IO (Ptr CounterValue)
forall a. Storable a => Ptr a -> IO a
peek (Ptr Counter
ptr Ptr Counter -> Int -> Ptr (Ptr CounterValue)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO (Ptr Dazzle.CounterValue.CounterValue)
    Maybe CounterValue
result <- Ptr CounterValue
-> (Ptr CounterValue -> IO CounterValue) -> IO (Maybe CounterValue)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr CounterValue
val ((Ptr CounterValue -> IO CounterValue) -> IO (Maybe CounterValue))
-> (Ptr CounterValue -> IO CounterValue) -> IO (Maybe CounterValue)
forall a b. (a -> b) -> a -> b
$ \Ptr CounterValue
val' -> do
        CounterValue
val'' <- ((ManagedPtr CounterValue -> CounterValue)
-> Ptr CounterValue -> IO CounterValue
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr CounterValue -> CounterValue
Dazzle.CounterValue.CounterValue) Ptr CounterValue
val'
        CounterValue -> IO CounterValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CounterValue
val''
    Maybe CounterValue -> IO (Maybe CounterValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CounterValue
result

-- | Set the value of the “@values@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' counter [ #values 'Data.GI.Base.Attributes.:=' value ]
-- @
setCounterValues :: MonadIO m => Counter -> Ptr Dazzle.CounterValue.CounterValue -> m ()
setCounterValues :: forall (m :: * -> *).
MonadIO m =>
Counter -> Ptr CounterValue -> m ()
setCounterValues Counter
s Ptr CounterValue
val = 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
$ Counter -> (Ptr Counter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Counter
s ((Ptr Counter -> IO ()) -> IO ())
-> (Ptr Counter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Counter
ptr -> do
    Ptr (Ptr CounterValue) -> Ptr CounterValue -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Counter
ptr Ptr Counter -> Int -> Ptr (Ptr CounterValue)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr CounterValue
val :: Ptr Dazzle.CounterValue.CounterValue)

-- | Set the value of the “@values@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #values
-- @
clearCounterValues :: MonadIO m => Counter -> m ()
clearCounterValues :: forall (m :: * -> *). MonadIO m => Counter -> m ()
clearCounterValues Counter
s = 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
$ Counter -> (Ptr Counter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Counter
s ((Ptr Counter -> IO ()) -> IO ())
-> (Ptr Counter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Counter
ptr -> do
    Ptr (Ptr CounterValue) -> Ptr CounterValue -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Counter
ptr Ptr Counter -> Int -> Ptr (Ptr CounterValue)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr CounterValue
forall a. Ptr a
FP.nullPtr :: Ptr Dazzle.CounterValue.CounterValue)

#if defined(ENABLE_OVERLOADING)
data CounterValuesFieldInfo
instance AttrInfo CounterValuesFieldInfo where
    type AttrBaseTypeConstraint CounterValuesFieldInfo = (~) Counter
    type AttrAllowedOps CounterValuesFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CounterValuesFieldInfo = (~) (Ptr Dazzle.CounterValue.CounterValue)
    type AttrTransferTypeConstraint CounterValuesFieldInfo = (~)(Ptr Dazzle.CounterValue.CounterValue)
    type AttrTransferType CounterValuesFieldInfo = (Ptr Dazzle.CounterValue.CounterValue)
    type AttrGetType CounterValuesFieldInfo = Maybe Dazzle.CounterValue.CounterValue
    type AttrLabel CounterValuesFieldInfo = "values"
    type AttrOrigin CounterValuesFieldInfo = Counter
    attrGet = getCounterValues
    attrSet = setCounterValues
    attrConstruct = undefined
    attrClear = clearCounterValues
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Counter.values"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Counter.html#g:attr:values"
        })

counter_values :: AttrLabelProxy "values"
counter_values = AttrLabelProxy

#endif


-- | Get the value of the “@category@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' counter #category
-- @
getCounterCategory :: MonadIO m => Counter -> m (Maybe T.Text)
getCounterCategory :: forall (m :: * -> *). MonadIO m => Counter -> m (Maybe Text)
getCounterCategory Counter
s = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Counter -> (Ptr Counter -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Counter
s ((Ptr Counter -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr Counter -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Counter
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr Counter
ptr Ptr Counter -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@category@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' counter [ #category 'Data.GI.Base.Attributes.:=' value ]
-- @
setCounterCategory :: MonadIO m => Counter -> CString -> m ()
setCounterCategory :: forall (m :: * -> *). MonadIO m => Counter -> CString -> m ()
setCounterCategory Counter
s CString
val = 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
$ Counter -> (Ptr Counter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Counter
s ((Ptr Counter -> IO ()) -> IO ())
-> (Ptr Counter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Counter
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Counter
ptr Ptr Counter -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
val :: CString)

-- | Set the value of the “@category@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #category
-- @
clearCounterCategory :: MonadIO m => Counter -> m ()
clearCounterCategory :: forall (m :: * -> *). MonadIO m => Counter -> m ()
clearCounterCategory Counter
s = 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
$ Counter -> (Ptr Counter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Counter
s ((Ptr Counter -> IO ()) -> IO ())
-> (Ptr Counter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Counter
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Counter
ptr Ptr Counter -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data CounterCategoryFieldInfo
instance AttrInfo CounterCategoryFieldInfo where
    type AttrBaseTypeConstraint CounterCategoryFieldInfo = (~) Counter
    type AttrAllowedOps CounterCategoryFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CounterCategoryFieldInfo = (~) CString
    type AttrTransferTypeConstraint CounterCategoryFieldInfo = (~)CString
    type AttrTransferType CounterCategoryFieldInfo = CString
    type AttrGetType CounterCategoryFieldInfo = Maybe T.Text
    type AttrLabel CounterCategoryFieldInfo = "category"
    type AttrOrigin CounterCategoryFieldInfo = Counter
    attrGet = getCounterCategory
    attrSet = setCounterCategory
    attrConstruct = undefined
    attrClear = clearCounterCategory
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Counter.category"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Counter.html#g:attr:category"
        })

counter_category :: AttrLabelProxy "category"
counter_category = AttrLabelProxy

#endif


-- | Get the value of the “@name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' counter #name
-- @
getCounterName :: MonadIO m => Counter -> m (Maybe T.Text)
getCounterName :: forall (m :: * -> *). MonadIO m => Counter -> m (Maybe Text)
getCounterName Counter
s = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Counter -> (Ptr Counter -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Counter
s ((Ptr Counter -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr Counter -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Counter
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr Counter
ptr Ptr Counter -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' counter [ #name 'Data.GI.Base.Attributes.:=' value ]
-- @
setCounterName :: MonadIO m => Counter -> CString -> m ()
setCounterName :: forall (m :: * -> *). MonadIO m => Counter -> CString -> m ()
setCounterName Counter
s CString
val = 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
$ Counter -> (Ptr Counter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Counter
s ((Ptr Counter -> IO ()) -> IO ())
-> (Ptr Counter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Counter
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Counter
ptr Ptr Counter -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
val :: CString)

-- | Set the value of the “@name@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #name
-- @
clearCounterName :: MonadIO m => Counter -> m ()
clearCounterName :: forall (m :: * -> *). MonadIO m => Counter -> m ()
clearCounterName Counter
s = 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
$ Counter -> (Ptr Counter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Counter
s ((Ptr Counter -> IO ()) -> IO ())
-> (Ptr Counter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Counter
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Counter
ptr Ptr Counter -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data CounterNameFieldInfo
instance AttrInfo CounterNameFieldInfo where
    type AttrBaseTypeConstraint CounterNameFieldInfo = (~) Counter
    type AttrAllowedOps CounterNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CounterNameFieldInfo = (~) CString
    type AttrTransferTypeConstraint CounterNameFieldInfo = (~)CString
    type AttrTransferType CounterNameFieldInfo = CString
    type AttrGetType CounterNameFieldInfo = Maybe T.Text
    type AttrLabel CounterNameFieldInfo = "name"
    type AttrOrigin CounterNameFieldInfo = Counter
    attrGet = getCounterName
    attrSet = setCounterName
    attrConstruct = undefined
    attrClear = clearCounterName
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Counter.name"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Counter.html#g:attr:name"
        })

counter_name :: AttrLabelProxy "name"
counter_name = AttrLabelProxy

#endif


-- | Get the value of the “@description@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' counter #description
-- @
getCounterDescription :: MonadIO m => Counter -> m (Maybe T.Text)
getCounterDescription :: forall (m :: * -> *). MonadIO m => Counter -> m (Maybe Text)
getCounterDescription Counter
s = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Counter -> (Ptr Counter -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Counter
s ((Ptr Counter -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr Counter -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Counter
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr Counter
ptr Ptr Counter -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@description@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' counter [ #description 'Data.GI.Base.Attributes.:=' value ]
-- @
setCounterDescription :: MonadIO m => Counter -> CString -> m ()
setCounterDescription :: forall (m :: * -> *). MonadIO m => Counter -> CString -> m ()
setCounterDescription Counter
s CString
val = 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
$ Counter -> (Ptr Counter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Counter
s ((Ptr Counter -> IO ()) -> IO ())
-> (Ptr Counter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Counter
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Counter
ptr Ptr Counter -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CString
val :: CString)

-- | Set the value of the “@description@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #description
-- @
clearCounterDescription :: MonadIO m => Counter -> m ()
clearCounterDescription :: forall (m :: * -> *). MonadIO m => Counter -> m ()
clearCounterDescription Counter
s = 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
$ Counter -> (Ptr Counter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Counter
s ((Ptr Counter -> IO ()) -> IO ())
-> (Ptr Counter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Counter
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Counter
ptr Ptr Counter -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data CounterDescriptionFieldInfo
instance AttrInfo CounterDescriptionFieldInfo where
    type AttrBaseTypeConstraint CounterDescriptionFieldInfo = (~) Counter
    type AttrAllowedOps CounterDescriptionFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CounterDescriptionFieldInfo = (~) CString
    type AttrTransferTypeConstraint CounterDescriptionFieldInfo = (~)CString
    type AttrTransferType CounterDescriptionFieldInfo = CString
    type AttrGetType CounterDescriptionFieldInfo = Maybe T.Text
    type AttrLabel CounterDescriptionFieldInfo = "description"
    type AttrOrigin CounterDescriptionFieldInfo = Counter
    attrGet = getCounterDescription
    attrSet = setCounterDescription
    attrConstruct = undefined
    attrClear = clearCounterDescription
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Counter.description"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Counter.html#g:attr:description"
        })

counter_description :: AttrLabelProxy "description"
counter_description = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Counter
type instance O.AttributeList Counter = CounterAttributeList
type CounterAttributeList = ('[ '("values", CounterValuesFieldInfo), '("category", CounterCategoryFieldInfo), '("name", CounterNameFieldInfo), '("description", CounterDescriptionFieldInfo)] :: [(Symbol, DK.Type)])
#endif

-- method Counter::get
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "counter"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Counter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt64)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_counter_get" dzl_counter_get :: 
    Ptr Counter ->                          -- counter : TInterface (Name {namespace = "Dazzle", name = "Counter"})
    IO Int64

-- | /No description available in the introspection data./
counterGet ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Counter
    -> m Int64
counterGet :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Counter -> m Int64
counterGet Counter
counter = IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Counter
counter' <- Counter -> IO (Ptr Counter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Counter
counter
    Int64
result <- Ptr Counter -> IO Int64
dzl_counter_get Ptr Counter
counter'
    Counter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Counter
counter
    Int64 -> IO Int64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data CounterGetMethodInfo
instance (signature ~ (m Int64), MonadIO m) => O.OverloadedMethod CounterGetMethodInfo Counter signature where
    overloadedMethod = counterGet

instance O.OverloadedMethodInfo CounterGetMethodInfo Counter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Counter.counterGet",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Counter.html#v:counterGet"
        })


#endif

-- method Counter::reset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "counter"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Counter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_counter_reset" dzl_counter_reset :: 
    Ptr Counter ->                          -- counter : TInterface (Name {namespace = "Dazzle", name = "Counter"})
    IO ()

-- | /No description available in the introspection data./
counterReset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Counter
    -> m ()
counterReset :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Counter -> m ()
counterReset Counter
counter = 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 Counter
counter' <- Counter -> IO (Ptr Counter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Counter
counter
    Ptr Counter -> IO ()
dzl_counter_reset Ptr Counter
counter'
    Counter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Counter
counter
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CounterResetMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod CounterResetMethodInfo Counter signature where
    overloadedMethod = counterReset

instance O.OverloadedMethodInfo CounterResetMethodInfo Counter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Counter.counterReset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Counter.html#v:counterReset"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveCounterMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveCounterMethod "get" o = CounterGetMethodInfo
    ResolveCounterMethod "reset" o = CounterResetMethodInfo
    ResolveCounterMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveCounterMethod t Counter, O.OverloadedMethod info Counter p, R.HasField t Counter p) => R.HasField t Counter p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveCounterMethod t Counter, O.OverloadedMethodInfo info Counter) => OL.IsLabel t (O.MethodProxy info Counter) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif