{-# 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.Gtk.Structs.CssLocation
    ( 

-- * Exported types
    CssLocation(..)                         ,
    newZeroCssLocation                      ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveCssLocationMethod                ,
#endif



 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    cssLocation_bytes                       ,
#endif
    getCssLocationBytes                     ,
    setCssLocationBytes                     ,


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

#if defined(ENABLE_OVERLOADING)
    cssLocation_chars                       ,
#endif
    getCssLocationChars                     ,
    setCssLocationChars                     ,


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

#if defined(ENABLE_OVERLOADING)
    cssLocation_lineBytes                   ,
#endif
    getCssLocationLineBytes                 ,
    setCssLocationLineBytes                 ,


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

#if defined(ENABLE_OVERLOADING)
    cssLocation_lineChars                   ,
#endif
    getCssLocationLineChars                 ,
    setCssLocationLineChars                 ,


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

#if defined(ENABLE_OVERLOADING)
    cssLocation_lines                       ,
#endif
    getCssLocationLines                     ,
    setCssLocationLines                     ,




    ) 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)

#else

#endif

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

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

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


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

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


-- | Get the value of the “@bytes@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cssLocation #bytes
-- @
getCssLocationBytes :: MonadIO m => CssLocation -> m FCT.CSize
getCssLocationBytes :: forall (m :: * -> *). MonadIO m => CssLocation -> m CSize
getCssLocationBytes CssLocation
s = IO CSize -> m CSize
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> m CSize) -> IO CSize -> m CSize
forall a b. (a -> b) -> a -> b
$ CssLocation -> (Ptr CssLocation -> IO CSize) -> IO CSize
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CssLocation
s ((Ptr CssLocation -> IO CSize) -> IO CSize)
-> (Ptr CssLocation -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \Ptr CssLocation
ptr -> do
    CSize
val <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek (Ptr CssLocation
ptr Ptr CssLocation -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO FCT.CSize
    CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
val

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

#if defined(ENABLE_OVERLOADING)
data CssLocationBytesFieldInfo
instance AttrInfo CssLocationBytesFieldInfo where
    type AttrBaseTypeConstraint CssLocationBytesFieldInfo = (~) CssLocation
    type AttrAllowedOps CssLocationBytesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint CssLocationBytesFieldInfo = (~) FCT.CSize
    type AttrTransferTypeConstraint CssLocationBytesFieldInfo = (~)FCT.CSize
    type AttrTransferType CssLocationBytesFieldInfo = FCT.CSize
    type AttrGetType CssLocationBytesFieldInfo = FCT.CSize
    type AttrLabel CssLocationBytesFieldInfo = "bytes"
    type AttrOrigin CssLocationBytesFieldInfo = CssLocation
    attrGet = getCssLocationBytes
    attrSet = setCssLocationBytes
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.CssLocation.bytes"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Structs-CssLocation.html#g:attr:bytes"
        })

cssLocation_bytes :: AttrLabelProxy "bytes"
cssLocation_bytes = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data CssLocationCharsFieldInfo
instance AttrInfo CssLocationCharsFieldInfo where
    type AttrBaseTypeConstraint CssLocationCharsFieldInfo = (~) CssLocation
    type AttrAllowedOps CssLocationCharsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint CssLocationCharsFieldInfo = (~) FCT.CSize
    type AttrTransferTypeConstraint CssLocationCharsFieldInfo = (~)FCT.CSize
    type AttrTransferType CssLocationCharsFieldInfo = FCT.CSize
    type AttrGetType CssLocationCharsFieldInfo = FCT.CSize
    type AttrLabel CssLocationCharsFieldInfo = "chars"
    type AttrOrigin CssLocationCharsFieldInfo = CssLocation
    attrGet = getCssLocationChars
    attrSet = setCssLocationChars
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.CssLocation.chars"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Structs-CssLocation.html#g:attr:chars"
        })

cssLocation_chars :: AttrLabelProxy "chars"
cssLocation_chars = AttrLabelProxy

#endif


-- | Get the value of the “@lines@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cssLocation #lines
-- @
getCssLocationLines :: MonadIO m => CssLocation -> m FCT.CSize
getCssLocationLines :: forall (m :: * -> *). MonadIO m => CssLocation -> m CSize
getCssLocationLines CssLocation
s = IO CSize -> m CSize
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> m CSize) -> IO CSize -> m CSize
forall a b. (a -> b) -> a -> b
$ CssLocation -> (Ptr CssLocation -> IO CSize) -> IO CSize
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CssLocation
s ((Ptr CssLocation -> IO CSize) -> IO CSize)
-> (Ptr CssLocation -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \Ptr CssLocation
ptr -> do
    CSize
val <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek (Ptr CssLocation
ptr Ptr CssLocation -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO FCT.CSize
    CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
val

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

#if defined(ENABLE_OVERLOADING)
data CssLocationLinesFieldInfo
instance AttrInfo CssLocationLinesFieldInfo where
    type AttrBaseTypeConstraint CssLocationLinesFieldInfo = (~) CssLocation
    type AttrAllowedOps CssLocationLinesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint CssLocationLinesFieldInfo = (~) FCT.CSize
    type AttrTransferTypeConstraint CssLocationLinesFieldInfo = (~)FCT.CSize
    type AttrTransferType CssLocationLinesFieldInfo = FCT.CSize
    type AttrGetType CssLocationLinesFieldInfo = FCT.CSize
    type AttrLabel CssLocationLinesFieldInfo = "lines"
    type AttrOrigin CssLocationLinesFieldInfo = CssLocation
    attrGet = getCssLocationLines
    attrSet = setCssLocationLines
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.CssLocation.lines"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Structs-CssLocation.html#g:attr:lines"
        })

cssLocation_lines :: AttrLabelProxy "lines"
cssLocation_lines = AttrLabelProxy

#endif


-- | Get the value of the “@line_bytes@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cssLocation #lineBytes
-- @
getCssLocationLineBytes :: MonadIO m => CssLocation -> m FCT.CSize
getCssLocationLineBytes :: forall (m :: * -> *). MonadIO m => CssLocation -> m CSize
getCssLocationLineBytes CssLocation
s = IO CSize -> m CSize
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> m CSize) -> IO CSize -> m CSize
forall a b. (a -> b) -> a -> b
$ CssLocation -> (Ptr CssLocation -> IO CSize) -> IO CSize
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CssLocation
s ((Ptr CssLocation -> IO CSize) -> IO CSize)
-> (Ptr CssLocation -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \Ptr CssLocation
ptr -> do
    CSize
val <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek (Ptr CssLocation
ptr Ptr CssLocation -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO FCT.CSize
    CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
val

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

#if defined(ENABLE_OVERLOADING)
data CssLocationLineBytesFieldInfo
instance AttrInfo CssLocationLineBytesFieldInfo where
    type AttrBaseTypeConstraint CssLocationLineBytesFieldInfo = (~) CssLocation
    type AttrAllowedOps CssLocationLineBytesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint CssLocationLineBytesFieldInfo = (~) FCT.CSize
    type AttrTransferTypeConstraint CssLocationLineBytesFieldInfo = (~)FCT.CSize
    type AttrTransferType CssLocationLineBytesFieldInfo = FCT.CSize
    type AttrGetType CssLocationLineBytesFieldInfo = FCT.CSize
    type AttrLabel CssLocationLineBytesFieldInfo = "line_bytes"
    type AttrOrigin CssLocationLineBytesFieldInfo = CssLocation
    attrGet = getCssLocationLineBytes
    attrSet = setCssLocationLineBytes
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.CssLocation.lineBytes"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Structs-CssLocation.html#g:attr:lineBytes"
        })

cssLocation_lineBytes :: AttrLabelProxy "lineBytes"
cssLocation_lineBytes = AttrLabelProxy

#endif


-- | Get the value of the “@line_chars@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cssLocation #lineChars
-- @
getCssLocationLineChars :: MonadIO m => CssLocation -> m FCT.CSize
getCssLocationLineChars :: forall (m :: * -> *). MonadIO m => CssLocation -> m CSize
getCssLocationLineChars CssLocation
s = IO CSize -> m CSize
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> m CSize) -> IO CSize -> m CSize
forall a b. (a -> b) -> a -> b
$ CssLocation -> (Ptr CssLocation -> IO CSize) -> IO CSize
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CssLocation
s ((Ptr CssLocation -> IO CSize) -> IO CSize)
-> (Ptr CssLocation -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \Ptr CssLocation
ptr -> do
    CSize
val <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek (Ptr CssLocation
ptr Ptr CssLocation -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO FCT.CSize
    CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
val

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

#if defined(ENABLE_OVERLOADING)
data CssLocationLineCharsFieldInfo
instance AttrInfo CssLocationLineCharsFieldInfo where
    type AttrBaseTypeConstraint CssLocationLineCharsFieldInfo = (~) CssLocation
    type AttrAllowedOps CssLocationLineCharsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint CssLocationLineCharsFieldInfo = (~) FCT.CSize
    type AttrTransferTypeConstraint CssLocationLineCharsFieldInfo = (~)FCT.CSize
    type AttrTransferType CssLocationLineCharsFieldInfo = FCT.CSize
    type AttrGetType CssLocationLineCharsFieldInfo = FCT.CSize
    type AttrLabel CssLocationLineCharsFieldInfo = "line_chars"
    type AttrOrigin CssLocationLineCharsFieldInfo = CssLocation
    attrGet = getCssLocationLineChars
    attrSet = setCssLocationLineChars
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.CssLocation.lineChars"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Structs-CssLocation.html#g:attr:lineChars"
        })

cssLocation_lineChars :: AttrLabelProxy "lineChars"
cssLocation_lineChars = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList CssLocation
type instance O.AttributeList CssLocation = CssLocationAttributeList
type CssLocationAttributeList = ('[ '("bytes", CssLocationBytesFieldInfo), '("chars", CssLocationCharsFieldInfo), '("lines", CssLocationLinesFieldInfo), '("lineBytes", CssLocationLineBytesFieldInfo), '("lineChars", CssLocationLineCharsFieldInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveCssLocationMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveCssLocationMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveCssLocationMethod t CssLocation, O.OverloadedMethod info CssLocation p) => OL.IsLabel t (CssLocation -> 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 ~ ResolveCssLocationMethod t CssLocation, O.OverloadedMethod info CssLocation p, R.HasField t CssLocation p) => R.HasField t CssLocation p where
    getField = O.overloadedMethod @info

#endif

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

#endif