{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A location in a parse buffer.

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

module GI.Gsk.Structs.ParseLocation
    ( 

-- * Exported types
    ParseLocation(..)                       ,
    newZeroParseLocation                    ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveParseLocationMethod              ,
#endif



 -- * Properties


-- ** bytes #attr:bytes#
-- | the offset of the location in the parse buffer, as bytes

    getParseLocationBytes                   ,
#if defined(ENABLE_OVERLOADING)
    parseLocation_bytes                     ,
#endif
    setParseLocationBytes                   ,


-- ** chars #attr:chars#
-- | the offset of the location in the parse buffer, as characters

    getParseLocationChars                   ,
#if defined(ENABLE_OVERLOADING)
    parseLocation_chars                     ,
#endif
    setParseLocationChars                   ,


-- ** lineBytes #attr:lineBytes#
-- | the position in the line, as bytes

    getParseLocationLineBytes               ,
#if defined(ENABLE_OVERLOADING)
    parseLocation_lineBytes                 ,
#endif
    setParseLocationLineBytes               ,


-- ** lineChars #attr:lineChars#
-- | the position in the line, as characters

    getParseLocationLineChars               ,
#if defined(ENABLE_OVERLOADING)
    parseLocation_lineChars                 ,
#endif
    setParseLocationLineChars               ,


-- ** lines #attr:lines#
-- | the line of the location in the parse buffer

    getParseLocationLines                   ,
#if defined(ENABLE_OVERLOADING)
    parseLocation_lines                     ,
#endif
    setParseLocationLines                   ,




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


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

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

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


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

instance tag ~ 'AttrSet => Constructible ParseLocation tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr ParseLocation -> ParseLocation)
-> [AttrOp ParseLocation tag] -> m ParseLocation
new ManagedPtr ParseLocation -> ParseLocation
_ [AttrOp ParseLocation tag]
attrs = do
        ParseLocation
o <- m ParseLocation
forall (m :: * -> *). MonadIO m => m ParseLocation
newZeroParseLocation
        ParseLocation -> [AttrOp ParseLocation 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set ParseLocation
o [AttrOp ParseLocation tag]
[AttrOp ParseLocation 'AttrSet]
attrs
        ParseLocation -> m ParseLocation
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ParseLocation
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' parseLocation #bytes
-- @
getParseLocationBytes :: MonadIO m => ParseLocation -> m Word64
getParseLocationBytes :: forall (m :: * -> *). MonadIO m => ParseLocation -> m Word64
getParseLocationBytes ParseLocation
s = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ ParseLocation -> (Ptr ParseLocation -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParseLocation
s ((Ptr ParseLocation -> IO Word64) -> IO Word64)
-> (Ptr ParseLocation -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr ParseLocation
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr ParseLocation
ptr Ptr ParseLocation -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO Word64
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
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' parseLocation [ #bytes 'Data.GI.Base.Attributes.:=' value ]
-- @
setParseLocationBytes :: MonadIO m => ParseLocation -> Word64 -> m ()
setParseLocationBytes :: forall (m :: * -> *). MonadIO m => ParseLocation -> Word64 -> m ()
setParseLocationBytes ParseLocation
s Word64
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
$ ParseLocation -> (Ptr ParseLocation -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParseLocation
s ((Ptr ParseLocation -> IO ()) -> IO ())
-> (Ptr ParseLocation -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ParseLocation
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ParseLocation
ptr Ptr ParseLocation -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Word64
val :: Word64)

#if defined(ENABLE_OVERLOADING)
data ParseLocationBytesFieldInfo
instance AttrInfo ParseLocationBytesFieldInfo where
    type AttrBaseTypeConstraint ParseLocationBytesFieldInfo = (~) ParseLocation
    type AttrAllowedOps ParseLocationBytesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ParseLocationBytesFieldInfo = (~) Word64
    type AttrTransferTypeConstraint ParseLocationBytesFieldInfo = (~)Word64
    type AttrTransferType ParseLocationBytesFieldInfo = Word64
    type AttrGetType ParseLocationBytesFieldInfo = Word64
    type AttrLabel ParseLocationBytesFieldInfo = "bytes"
    type AttrOrigin ParseLocationBytesFieldInfo = ParseLocation
    attrGet = getParseLocationBytes
    attrSet = setParseLocationBytes
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.ParseLocation.bytes"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Structs-ParseLocation.html#g:attr:bytes"
        })

parseLocation_bytes :: AttrLabelProxy "bytes"
parseLocation_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' parseLocation #chars
-- @
getParseLocationChars :: MonadIO m => ParseLocation -> m Word64
getParseLocationChars :: forall (m :: * -> *). MonadIO m => ParseLocation -> m Word64
getParseLocationChars ParseLocation
s = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ ParseLocation -> (Ptr ParseLocation -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParseLocation
s ((Ptr ParseLocation -> IO Word64) -> IO Word64)
-> (Ptr ParseLocation -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr ParseLocation
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr ParseLocation
ptr Ptr ParseLocation -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO Word64
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
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' parseLocation [ #chars 'Data.GI.Base.Attributes.:=' value ]
-- @
setParseLocationChars :: MonadIO m => ParseLocation -> Word64 -> m ()
setParseLocationChars :: forall (m :: * -> *). MonadIO m => ParseLocation -> Word64 -> m ()
setParseLocationChars ParseLocation
s Word64
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
$ ParseLocation -> (Ptr ParseLocation -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParseLocation
s ((Ptr ParseLocation -> IO ()) -> IO ())
-> (Ptr ParseLocation -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ParseLocation
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ParseLocation
ptr Ptr ParseLocation -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Word64
val :: Word64)

#if defined(ENABLE_OVERLOADING)
data ParseLocationCharsFieldInfo
instance AttrInfo ParseLocationCharsFieldInfo where
    type AttrBaseTypeConstraint ParseLocationCharsFieldInfo = (~) ParseLocation
    type AttrAllowedOps ParseLocationCharsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ParseLocationCharsFieldInfo = (~) Word64
    type AttrTransferTypeConstraint ParseLocationCharsFieldInfo = (~)Word64
    type AttrTransferType ParseLocationCharsFieldInfo = Word64
    type AttrGetType ParseLocationCharsFieldInfo = Word64
    type AttrLabel ParseLocationCharsFieldInfo = "chars"
    type AttrOrigin ParseLocationCharsFieldInfo = ParseLocation
    attrGet = getParseLocationChars
    attrSet = setParseLocationChars
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.ParseLocation.chars"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Structs-ParseLocation.html#g:attr:chars"
        })

parseLocation_chars :: AttrLabelProxy "chars"
parseLocation_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' parseLocation #lines
-- @
getParseLocationLines :: MonadIO m => ParseLocation -> m Word64
getParseLocationLines :: forall (m :: * -> *). MonadIO m => ParseLocation -> m Word64
getParseLocationLines ParseLocation
s = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ ParseLocation -> (Ptr ParseLocation -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParseLocation
s ((Ptr ParseLocation -> IO Word64) -> IO Word64)
-> (Ptr ParseLocation -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr ParseLocation
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr ParseLocation
ptr Ptr ParseLocation -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO Word64
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
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' parseLocation [ #lines 'Data.GI.Base.Attributes.:=' value ]
-- @
setParseLocationLines :: MonadIO m => ParseLocation -> Word64 -> m ()
setParseLocationLines :: forall (m :: * -> *). MonadIO m => ParseLocation -> Word64 -> m ()
setParseLocationLines ParseLocation
s Word64
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
$ ParseLocation -> (Ptr ParseLocation -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParseLocation
s ((Ptr ParseLocation -> IO ()) -> IO ())
-> (Ptr ParseLocation -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ParseLocation
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ParseLocation
ptr Ptr ParseLocation -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Word64
val :: Word64)

#if defined(ENABLE_OVERLOADING)
data ParseLocationLinesFieldInfo
instance AttrInfo ParseLocationLinesFieldInfo where
    type AttrBaseTypeConstraint ParseLocationLinesFieldInfo = (~) ParseLocation
    type AttrAllowedOps ParseLocationLinesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ParseLocationLinesFieldInfo = (~) Word64
    type AttrTransferTypeConstraint ParseLocationLinesFieldInfo = (~)Word64
    type AttrTransferType ParseLocationLinesFieldInfo = Word64
    type AttrGetType ParseLocationLinesFieldInfo = Word64
    type AttrLabel ParseLocationLinesFieldInfo = "lines"
    type AttrOrigin ParseLocationLinesFieldInfo = ParseLocation
    attrGet = getParseLocationLines
    attrSet = setParseLocationLines
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.ParseLocation.lines"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Structs-ParseLocation.html#g:attr:lines"
        })

parseLocation_lines :: AttrLabelProxy "lines"
parseLocation_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' parseLocation #lineBytes
-- @
getParseLocationLineBytes :: MonadIO m => ParseLocation -> m Word64
getParseLocationLineBytes :: forall (m :: * -> *). MonadIO m => ParseLocation -> m Word64
getParseLocationLineBytes ParseLocation
s = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ ParseLocation -> (Ptr ParseLocation -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParseLocation
s ((Ptr ParseLocation -> IO Word64) -> IO Word64)
-> (Ptr ParseLocation -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr ParseLocation
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr ParseLocation
ptr Ptr ParseLocation -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO Word64
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
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' parseLocation [ #lineBytes 'Data.GI.Base.Attributes.:=' value ]
-- @
setParseLocationLineBytes :: MonadIO m => ParseLocation -> Word64 -> m ()
setParseLocationLineBytes :: forall (m :: * -> *). MonadIO m => ParseLocation -> Word64 -> m ()
setParseLocationLineBytes ParseLocation
s Word64
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
$ ParseLocation -> (Ptr ParseLocation -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParseLocation
s ((Ptr ParseLocation -> IO ()) -> IO ())
-> (Ptr ParseLocation -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ParseLocation
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ParseLocation
ptr Ptr ParseLocation -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (Word64
val :: Word64)

#if defined(ENABLE_OVERLOADING)
data ParseLocationLineBytesFieldInfo
instance AttrInfo ParseLocationLineBytesFieldInfo where
    type AttrBaseTypeConstraint ParseLocationLineBytesFieldInfo = (~) ParseLocation
    type AttrAllowedOps ParseLocationLineBytesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ParseLocationLineBytesFieldInfo = (~) Word64
    type AttrTransferTypeConstraint ParseLocationLineBytesFieldInfo = (~)Word64
    type AttrTransferType ParseLocationLineBytesFieldInfo = Word64
    type AttrGetType ParseLocationLineBytesFieldInfo = Word64
    type AttrLabel ParseLocationLineBytesFieldInfo = "line_bytes"
    type AttrOrigin ParseLocationLineBytesFieldInfo = ParseLocation
    attrGet = getParseLocationLineBytes
    attrSet = setParseLocationLineBytes
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.ParseLocation.lineBytes"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Structs-ParseLocation.html#g:attr:lineBytes"
        })

parseLocation_lineBytes :: AttrLabelProxy "lineBytes"
parseLocation_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' parseLocation #lineChars
-- @
getParseLocationLineChars :: MonadIO m => ParseLocation -> m Word64
getParseLocationLineChars :: forall (m :: * -> *). MonadIO m => ParseLocation -> m Word64
getParseLocationLineChars ParseLocation
s = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ ParseLocation -> (Ptr ParseLocation -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParseLocation
s ((Ptr ParseLocation -> IO Word64) -> IO Word64)
-> (Ptr ParseLocation -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr ParseLocation
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr ParseLocation
ptr Ptr ParseLocation -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO Word64
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
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' parseLocation [ #lineChars 'Data.GI.Base.Attributes.:=' value ]
-- @
setParseLocationLineChars :: MonadIO m => ParseLocation -> Word64 -> m ()
setParseLocationLineChars :: forall (m :: * -> *). MonadIO m => ParseLocation -> Word64 -> m ()
setParseLocationLineChars ParseLocation
s Word64
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
$ ParseLocation -> (Ptr ParseLocation -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParseLocation
s ((Ptr ParseLocation -> IO ()) -> IO ())
-> (Ptr ParseLocation -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ParseLocation
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ParseLocation
ptr Ptr ParseLocation -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (Word64
val :: Word64)

#if defined(ENABLE_OVERLOADING)
data ParseLocationLineCharsFieldInfo
instance AttrInfo ParseLocationLineCharsFieldInfo where
    type AttrBaseTypeConstraint ParseLocationLineCharsFieldInfo = (~) ParseLocation
    type AttrAllowedOps ParseLocationLineCharsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ParseLocationLineCharsFieldInfo = (~) Word64
    type AttrTransferTypeConstraint ParseLocationLineCharsFieldInfo = (~)Word64
    type AttrTransferType ParseLocationLineCharsFieldInfo = Word64
    type AttrGetType ParseLocationLineCharsFieldInfo = Word64
    type AttrLabel ParseLocationLineCharsFieldInfo = "line_chars"
    type AttrOrigin ParseLocationLineCharsFieldInfo = ParseLocation
    attrGet = getParseLocationLineChars
    attrSet = setParseLocationLineChars
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Structs.ParseLocation.lineChars"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Structs-ParseLocation.html#g:attr:lineChars"
        })

parseLocation_lineChars :: AttrLabelProxy "lineChars"
parseLocation_lineChars = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ParseLocation
type instance O.AttributeList ParseLocation = ParseLocationAttributeList
type ParseLocationAttributeList = ('[ '("bytes", ParseLocationBytesFieldInfo), '("chars", ParseLocationCharsFieldInfo), '("lines", ParseLocationLinesFieldInfo), '("lineBytes", ParseLocationLineBytesFieldInfo), '("lineChars", ParseLocationLineCharsFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#endif

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

#endif