Once.hs


{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc)

A 'GI.GLib.Structs.Once.Once' struct controls a one-time initialization function. Any
one-time initialization function must have its own unique 'GI.GLib.Structs.Once.Once'
struct.

/Since: 2.4/
-}

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

module GI.GLib.Structs.Once
    ( 

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


 -- * Methods
-- ** 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 ENABLE_OVERLOADING
    once_retval                             ,
#endif
    setOnceRetval                           ,


-- ** status #attr:status#
{- | the status of the 'GI.GLib.Structs.Once.Once'
-}
    getOnceStatus                           ,
#if 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.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.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 (ManagedPtr Once)
instance WrappedPtr Once where
    wrappedPtrCalloc = callocBytes 16
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 16 >=> wrapPtr Once)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `Once` struct initialized to zero.
newZeroOnce :: MonadIO m => m Once
newZeroOnce = liftIO $ wrappedPtrCalloc >>= wrapPtr Once

instance tag ~ 'AttrSet => Constructible Once tag where
    new _ attrs = do
        o <- newZeroOnce
        GI.Attributes.set o attrs
        return o


-- | A convenience alias for `Nothing` :: `Maybe` `Once`.
noOnce :: Maybe Once
noOnce = Nothing

{- |
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 s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CUInt
    let val' = (toEnum . fromIntegral) val
    return 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 s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 0) (val' :: CUInt)

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

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 s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO (Ptr ())
    return 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 s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (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 s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (FP.nullPtr :: Ptr ())

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

once_retval :: AttrLabelProxy "retval"
once_retval = AttrLabelProxy

#endif



#if 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:__ 'True' if the initialization section should be entered,
    'False' and blocks otherwise -}
onceInitEnter location = liftIO $ do
    result <- g_once_init_enter location
    let result' = (/= 0) result
    return result'

#if 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 location result_ = liftIO $ do
    g_once_init_leave location result_
    return ()

#if ENABLE_OVERLOADING
#endif

#if 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 (O.MethodProxy :: O.MethodProxy info)
#else
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif

#endif