{-# LANGUAGE PatternSynonyms, ScopedTypeVariables, ViewPatterns #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria

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

module GI.GObject.Constants
    ( 
    pattern VALUE_NOCOPY_CONTENTS           ,
    pattern VALUE_INTERNED_STRING           ,
    pattern TYPE_RESERVED_USER_FIRST        ,
    pattern TYPE_RESERVED_GLIB_LAST         ,
    pattern TYPE_RESERVED_GLIB_FIRST        ,
    pattern TYPE_RESERVED_BSE_LAST          ,
    pattern TYPE_RESERVED_BSE_FIRST         ,
    pattern TYPE_FUNDAMENTAL_SHIFT          ,
    pattern TYPE_FUNDAMENTAL_MAX            ,
    pattern TYPE_FLAG_RESERVED_ID_BIT       ,
    pattern SIGNAL_MATCH_MASK               ,
    pattern SIGNAL_FLAGS_MASK               ,
    pattern PARAM_USER_SHIFT                ,
    pattern PARAM_STATIC_STRINGS            ,
    pattern PARAM_MASK                      ,

    ) 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


-- | If passed to @/G_VALUE_COLLECT()/@, allocated data won\'t be copied
-- but used verbatim. This does not affect ref-counted types like
-- objects. This does not affect usage of 'GI.GObject.Structs.Value.valueCopy', the data will
-- be copied if it is not ref-counted.
pattern $mVALUE_NOCOPY_CONTENTS :: forall {r}. Int32 -> ((# #) -> r) -> ((# #) -> r) -> r
$bVALUE_NOCOPY_CONTENTS :: Int32
VALUE_NOCOPY_CONTENTS = 134217728 :: Int32

-- | For string values, indicates that the string contained is canonical and will
-- exist for the duration of the process. See 'GI.GObject.Structs.Value.valueSetInternedString'.
-- 
-- /Since: 2.66/
pattern $mVALUE_INTERNED_STRING :: forall {r}. Int32 -> ((# #) -> r) -> ((# #) -> r) -> r
$bVALUE_INTERNED_STRING :: Int32
VALUE_INTERNED_STRING = 268435456 :: Int32

-- | First available fundamental type number to create new fundamental
-- type id with @/G_TYPE_MAKE_FUNDAMENTAL()/@.
pattern $mTYPE_RESERVED_USER_FIRST :: forall {r}. Int32 -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_RESERVED_USER_FIRST :: Int32
TYPE_RESERVED_USER_FIRST = 49 :: Int32

-- | Last fundamental type number reserved for GLib.
pattern $mTYPE_RESERVED_GLIB_LAST :: forall {r}. Int32 -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_RESERVED_GLIB_LAST :: Int32
TYPE_RESERVED_GLIB_LAST = 31 :: Int32

-- | First fundamental type number to create a new fundamental type id with
-- @/G_TYPE_MAKE_FUNDAMENTAL()/@ reserved for GLib.
pattern $mTYPE_RESERVED_GLIB_FIRST :: forall {r}. Int32 -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_RESERVED_GLIB_FIRST :: Int32
TYPE_RESERVED_GLIB_FIRST = 22 :: Int32

-- | Last fundamental type number reserved for BSE.
pattern $mTYPE_RESERVED_BSE_LAST :: forall {r}. Int32 -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_RESERVED_BSE_LAST :: Int32
TYPE_RESERVED_BSE_LAST = 48 :: Int32

-- | First fundamental type number to create a new fundamental type id with
-- @/G_TYPE_MAKE_FUNDAMENTAL()/@ reserved for BSE.
pattern $mTYPE_RESERVED_BSE_FIRST :: forall {r}. Int32 -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_RESERVED_BSE_FIRST :: Int32
TYPE_RESERVED_BSE_FIRST = 32 :: Int32

-- | Shift value used in converting numbers to type IDs.
pattern $mTYPE_FUNDAMENTAL_SHIFT :: forall {r}. Int32 -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FUNDAMENTAL_SHIFT :: Int32
TYPE_FUNDAMENTAL_SHIFT = 2 :: Int32

-- | An integer constant that represents the number of identifiers reserved
-- for types that are assigned at compile-time.
pattern $mTYPE_FUNDAMENTAL_MAX :: forall {r}. Int32 -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FUNDAMENTAL_MAX :: Int32
TYPE_FUNDAMENTAL_MAX = 255 :: Int32

-- | A bit in the type number that\'s supposed to be left untouched.
pattern $mTYPE_FLAG_RESERVED_ID_BIT :: forall {r}. Word64 -> ((# #) -> r) -> ((# #) -> r) -> r
$bTYPE_FLAG_RESERVED_ID_BIT :: Word64
TYPE_FLAG_RESERVED_ID_BIT = 1 :: Word64

-- | A mask for all t'GI.GObject.Flags.SignalMatchType' bits.
pattern $mSIGNAL_MATCH_MASK :: forall {r}. Int32 -> ((# #) -> r) -> ((# #) -> r) -> r
$bSIGNAL_MATCH_MASK :: Int32
SIGNAL_MATCH_MASK = 63 :: Int32

-- | A mask for all t'GI.GObject.Flags.SignalFlags' bits.
pattern $mSIGNAL_FLAGS_MASK :: forall {r}. Int32 -> ((# #) -> r) -> ((# #) -> r) -> r
$bSIGNAL_FLAGS_MASK :: Int32
SIGNAL_FLAGS_MASK = 511 :: Int32

-- | Minimum shift count to be used for user defined flags, to be stored in
-- t'GI.GObject.Objects.ParamSpec.ParamSpec'.@/flags/@. The maximum allowed is 10.
pattern $mPARAM_USER_SHIFT :: forall {r}. Int32 -> ((# #) -> r) -> ((# #) -> r) -> r
$bPARAM_USER_SHIFT :: Int32
PARAM_USER_SHIFT = 8 :: Int32

-- | t'GI.GObject.Flags.ParamFlags' value alias for 'GI.GObject.Flags.ParamFlagsStaticName' | 'GI.GObject.Flags.ParamFlagsStaticNick' | 'GI.GObject.Flags.ParamFlagsStaticBlurb'.
-- 
-- It is recommended to use this for all properties by default, as it allows for
-- internal performance improvements in GObject.
-- 
-- It is very rare that a property would have a dynamically constructed name,
-- nickname or blurb.
-- 
-- Since 2.13.0
pattern $mPARAM_STATIC_STRINGS :: forall {r}. Int32 -> ((# #) -> r) -> ((# #) -> r) -> r
$bPARAM_STATIC_STRINGS :: Int32
PARAM_STATIC_STRINGS = 224 :: Int32

-- | Mask containing the bits of t'GI.GObject.Objects.ParamSpec.ParamSpec'.@/flags/@ which are reserved for GLib.
pattern $mPARAM_MASK :: forall {r}. Int32 -> ((# #) -> r) -> ((# #) -> r) -> r
$bPARAM_MASK :: Int32
PARAM_MASK = 255 :: Int32