{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.GLib.Structs.Once.Once' struct controls a one-time initialization function. Any
-- one-time initialization function must have its own unique t'GI.GLib.Structs.Once.Once'
-- struct.
-- 
-- /Since: 2.4/

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

module GI.GLib.Structs.Once
    ( 

-- * Exported types
    Once(..)                                ,
    newZeroOnce                             ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveOnceMethod                       ,
#endif


-- ** initEnter #method:initEnter#

    onceInitEnter                           ,


-- ** initLeave #method:initLeave#

    onceInitLeave                           ,




 -- * Properties
-- ** retval #attr:retval#
-- | the value returned by the call to the function, if /@status@/
--          is 'GI.GLib.Enums.OnceStatusReady'

    clearOnceRetval                         ,
    getOnceRetval                           ,
#if defined(ENABLE_OVERLOADING)
    once_retval                             ,
#endif
    setOnceRetval                           ,


-- ** status #attr:status#
-- | the status of the t'GI.GLib.Structs.Once.Once'

    getOnceStatus                           ,
#if defined(ENABLE_OVERLOADING)
    once_status                             ,
#endif
    setOnceStatus                           ,




    ) 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.Enums as GLib.Enums

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

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

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


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

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


-- | Get the value of the “@status@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' once #status
-- @
getOnceStatus :: MonadIO m => Once -> m GLib.Enums.OnceStatus
getOnceStatus :: Once -> m OnceStatus
getOnceStatus Once
s = IO OnceStatus -> m OnceStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO OnceStatus -> m OnceStatus) -> IO OnceStatus -> m OnceStatus
forall a b. (a -> b) -> a -> b
$ Once -> (Ptr Once -> IO OnceStatus) -> IO OnceStatus
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Once
s ((Ptr Once -> IO OnceStatus) -> IO OnceStatus)
-> (Ptr Once -> IO OnceStatus) -> IO OnceStatus
forall a b. (a -> b) -> a -> b
$ \Ptr Once
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr Once
ptr Ptr Once -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CUInt
    let val' :: OnceStatus
val' = (Int -> OnceStatus
forall a. Enum a => Int -> a
toEnum (Int -> OnceStatus) -> (CUInt -> Int) -> CUInt -> OnceStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    OnceStatus -> IO OnceStatus
forall (m :: * -> *) a. Monad m => a -> m a
return OnceStatus
val'

-- | Set the value of the “@status@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' once [ #status 'Data.GI.Base.Attributes.:=' value ]
-- @
setOnceStatus :: MonadIO m => Once -> GLib.Enums.OnceStatus -> m ()
setOnceStatus :: Once -> OnceStatus -> m ()
setOnceStatus Once
s OnceStatus
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Once -> (Ptr Once -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Once
s ((Ptr Once -> IO ()) -> IO ()) -> (Ptr Once -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Once
ptr -> do
    let val' :: CUInt
val' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (OnceStatus -> Int) -> OnceStatus -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnceStatus -> Int
forall a. Enum a => a -> Int
fromEnum) OnceStatus
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Once
ptr Ptr Once -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data OnceStatusFieldInfo
instance AttrInfo OnceStatusFieldInfo where
    type AttrBaseTypeConstraint OnceStatusFieldInfo = (~) Once
    type AttrAllowedOps OnceStatusFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint OnceStatusFieldInfo = (~) GLib.Enums.OnceStatus
    type AttrTransferTypeConstraint OnceStatusFieldInfo = (~)GLib.Enums.OnceStatus
    type AttrTransferType OnceStatusFieldInfo = GLib.Enums.OnceStatus
    type AttrGetType OnceStatusFieldInfo = GLib.Enums.OnceStatus
    type AttrLabel OnceStatusFieldInfo = "status"
    type AttrOrigin OnceStatusFieldInfo = Once
    attrGet = getOnceStatus
    attrSet = setOnceStatus
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

once_status :: AttrLabelProxy "status"
once_status = AttrLabelProxy

#endif


-- | Get the value of the “@retval@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' once #retval
-- @
getOnceRetval :: MonadIO m => Once -> m (Ptr ())
getOnceRetval :: Once -> m (Ptr ())
getOnceRetval Once
s = IO (Ptr ()) -> m (Ptr ())
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
$ Once -> (Ptr Once -> IO (Ptr ())) -> IO (Ptr ())
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Once
s ((Ptr Once -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr Once -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr Once
ptr -> do
    Ptr ()
val <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek (Ptr Once
ptr Ptr Once -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO (Ptr ())
    Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
val

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

-- | Set the value of the “@retval@” 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' #retval
-- @
clearOnceRetval :: MonadIO m => Once -> m ()
clearOnceRetval :: Once -> m ()
clearOnceRetval Once
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Once -> (Ptr Once -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Once
s ((Ptr Once -> IO ()) -> IO ()) -> (Ptr Once -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Once
ptr -> do
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Once
ptr Ptr Once -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Ptr ()
forall a. Ptr a
FP.nullPtr :: Ptr ())

#if defined(ENABLE_OVERLOADING)
data OnceRetvalFieldInfo
instance AttrInfo OnceRetvalFieldInfo where
    type AttrBaseTypeConstraint OnceRetvalFieldInfo = (~) Once
    type AttrAllowedOps OnceRetvalFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint OnceRetvalFieldInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint OnceRetvalFieldInfo = (~)(Ptr ())
    type AttrTransferType OnceRetvalFieldInfo = (Ptr ())
    type AttrGetType OnceRetvalFieldInfo = Ptr ()
    type AttrLabel OnceRetvalFieldInfo = "retval"
    type AttrOrigin OnceRetvalFieldInfo = Once
    attrGet = getOnceRetval
    attrSet = setOnceRetval
    attrConstruct = undefined
    attrClear = clearOnceRetval
    attrTransfer _ v = do
        return v

once_retval :: AttrLabelProxy "retval"
once_retval = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Once
type instance O.AttributeList Once = OnceAttributeList
type OnceAttributeList = ('[ '("status", OnceStatusFieldInfo), '("retval", OnceRetvalFieldInfo)] :: [(Symbol, *)])
#endif

-- method Once::init_enter
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "location"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "location of a static initializable variable\n   containing 0"
--                 , 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_once_init_enter" g_once_init_enter :: 
    Ptr () ->                               -- location : TBasicType TPtr
    IO CInt

-- | Function to be called when starting a critical initialization
-- section. The argument /@location@/ must point to a static
-- 0-initialized variable that will be set to a value other than 0 at
-- the end of the initialization section. In combination with
-- 'GI.GLib.Functions.onceInitLeave' and the unique address /@valueLocation@/, it can
-- be ensured that an initialization section will be executed only once
-- during a program\'s life time, and that concurrent threads are
-- blocked until initialization completed. To be used in constructs
-- like this:
-- 
-- 
-- === /C code/
-- >
-- >  static gsize initialization_value = 0;
-- >
-- >  if (g_once_init_enter (&initialization_value))
-- >    {
-- >      gsize setup_value = 42; // initialization code here
-- >
-- >      g_once_init_leave (&initialization_value, setup_value);
-- >    }
-- >
-- >  // use initialization_value here
-- 
-- 
-- /Since: 2.14/
onceInitEnter ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@location@/: location of a static initializable variable
    --    containing 0
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the initialization section should be entered,
    --     'P.False' and blocks otherwise
onceInitEnter :: Ptr () -> m Bool
onceInitEnter Ptr ()
location = 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
    CInt
result <- Ptr () -> IO CInt
g_once_init_enter Ptr ()
location
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Once::init_leave
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "location"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "location of a static initializable variable\n   containing 0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new non-0 value for *@value_location"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_once_init_leave" g_once_init_leave :: 
    Ptr () ->                               -- location : TBasicType TPtr
    Word64 ->                               -- result : TBasicType TUInt64
    IO ()

-- | Counterpart to 'GI.GLib.Functions.onceInitEnter'. Expects a location of a static
-- 0-initialized initialization variable, and an initialization value
-- other than 0. Sets the variable to the initialization value, and
-- releases concurrent threads blocking in 'GI.GLib.Functions.onceInitEnter' on this
-- initialization variable.
-- 
-- /Since: 2.14/
onceInitLeave ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@location@/: location of a static initializable variable
    --    containing 0
    -> Word64
    -- ^ /@result@/: new non-0 value for */@valueLocation@/
    -> m ()
onceInitLeave :: Ptr () -> Word64 -> m ()
onceInitLeave Ptr ()
location Word64
result_ = 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 () -> Word64 -> IO ()
g_once_init_leave Ptr ()
location Word64
result_
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveOnceMethod (t :: Symbol) (o :: *) :: * where
    ResolveOnceMethod l o = O.MethodResolutionFailed l o

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

#endif