{-# 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.NM.Structs.Range
    ( 

-- * Exported types
    Range(..)                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [cmp]("GI.NM.Structs.Range#g:method:cmp"), [ref]("GI.NM.Structs.Range#g:method:ref"), [toStr]("GI.NM.Structs.Range#g:method:toStr"), [unref]("GI.NM.Structs.Range#g:method:unref").
-- 
-- ==== Getters
-- [getRange]("GI.NM.Structs.Range#g:method:getRange").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveRangeMethod                      ,
#endif

-- ** cmp #method:cmp#

#if defined(ENABLE_OVERLOADING)
    RangeCmpMethodInfo                      ,
#endif
    rangeCmp                                ,


-- ** fromStr #method:fromStr#

    rangeFromStr                            ,


-- ** getRange #method:getRange#

#if defined(ENABLE_OVERLOADING)
    RangeGetRangeMethodInfo                 ,
#endif
    rangeGetRange                           ,


-- ** new #method:new#

    rangeNew                                ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    RangeRefMethodInfo                      ,
#endif
    rangeRef                                ,


-- ** toStr #method:toStr#

#if defined(ENABLE_OVERLOADING)
    RangeToStrMethodInfo                    ,
#endif
    rangeToStr                              ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    RangeUnrefMethodInfo                    ,
#endif
    rangeUnref                              ,




    ) 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 Range = Range (SP.ManagedPtr Range)
    deriving (Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
/= :: Range -> Range -> Bool
Eq)

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

foreign import ccall "nm_range_get_type" c_nm_range_get_type :: 
    IO GType

type instance O.ParentTypes Range = '[]
instance O.HasParentTypes Range

instance B.Types.TypedObject Range where
    glibType :: IO GType
glibType = IO GType
c_nm_range_get_type

instance B.Types.GBoxed Range

-- | Convert t'Range' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Range) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_range_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Range -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Range
P.Nothing = Ptr GValue -> Ptr Range -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Range
forall a. Ptr a
FP.nullPtr :: FP.Ptr Range)
    gvalueSet_ Ptr GValue
gv (P.Just Range
obj) = Range -> (Ptr Range -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Range
obj (Ptr GValue -> Ptr Range -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Range)
gvalueGet_ Ptr GValue
gv = do
        Ptr Range
ptr <- Ptr GValue -> IO (Ptr Range)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Range)
        if Ptr Range
ptr Ptr Range -> Ptr Range -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Range
forall a. Ptr a
FP.nullPtr
        then Range -> Maybe Range
forall a. a -> Maybe a
P.Just (Range -> Maybe Range) -> IO Range -> IO (Maybe Range)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Range -> Range) -> Ptr Range -> IO Range
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Range -> Range
Range Ptr Range
ptr
        else Maybe Range -> IO (Maybe Range)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Range
forall a. Maybe a
P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Range
type instance O.AttributeList Range = RangeAttributeList
type RangeAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method Range::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "start"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first element of the range"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the last element of the range, must be greater than or equal\nto @start."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "Range" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_range_new" nm_range_new :: 
    Word64 ->                               -- start : TBasicType TUInt64
    Word64 ->                               -- end : TBasicType TUInt64
    IO (Ptr Range)

-- | Creates a new t'GI.NM.Structs.Range.Range' object for the given range. Setting /@end@/
-- equal to /@start@/ creates a single-element range.
-- 
-- /Since: 1.42/
rangeNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word64
    -- ^ /@start@/: the first element of the range
    -> Word64
    -- ^ /@end@/: the last element of the range, must be greater than or equal
    -- to /@start@/.
    -> m Range
    -- ^ __Returns:__ the new t'GI.NM.Structs.Range.Range' object.
rangeNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word64 -> Word64 -> m Range
rangeNew Word64
start Word64
end = IO Range -> m Range
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Range -> m Range) -> IO Range -> m Range
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
result <- Word64 -> Word64 -> IO (Ptr Range)
nm_range_new Word64
start Word64
end
    Text -> Ptr Range -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"rangeNew" Ptr Range
result
    Range
result' <- ((ManagedPtr Range -> Range) -> Ptr Range -> IO Range
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Range -> Range
Range) Ptr Range
result
    Range -> IO Range
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Range
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Range::cmp
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType = TInterface Name { namespace = "NM" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType = TInterface Name { namespace = "NM" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another #NMRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "nm_range_cmp" nm_range_cmp :: 
    Ptr Range ->                            -- a : TInterface (Name {namespace = "NM", name = "Range"})
    Ptr Range ->                            -- b : TInterface (Name {namespace = "NM", name = "Range"})
    IO Int32

-- | Compare two ranges.
-- 
-- /Since: 1.42/
rangeCmp ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Range
    -- ^ /@a@/: a t'GI.NM.Structs.Range.Range'
    -> Range
    -- ^ /@b@/: another t'GI.NM.Structs.Range.Range'
    -> m Int32
    -- ^ __Returns:__ zero if the two instances are equivalent or
    --   a non-zero integer otherwise. This defines a total ordering
    --   over the ranges.
rangeCmp :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Range -> Range -> m Int32
rangeCmp Range
a Range
b = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
a' <- Range -> IO (Ptr Range)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Range
a
    Ptr Range
b' <- Range -> IO (Ptr Range)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Range
b
    Int32
result <- Ptr Range -> Ptr Range -> IO Int32
nm_range_cmp Ptr Range
a' Ptr Range
b'
    Range -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Range
a
    Range -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Range
b
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data RangeCmpMethodInfo
instance (signature ~ (Range -> m Int32), MonadIO m) => O.OverloadedMethod RangeCmpMethodInfo Range signature where
    overloadedMethod = rangeCmp

instance O.OverloadedMethodInfo RangeCmpMethodInfo Range where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.Range.rangeCmp",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-Range.html#v:rangeCmp"
        })


#endif

-- method Range::get_range
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "NM" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the start value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "end"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the end value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_range_get_range" nm_range_get_range :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "NM", name = "Range"})
    Ptr Word64 ->                           -- start : TBasicType TUInt64
    Ptr Word64 ->                           -- end : TBasicType TUInt64
    IO CInt

-- | Gets the start and end values for the range.
-- 
-- /Since: 1.42/
rangeGetRange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Range
    -- ^ /@range@/: the t'GI.NM.Structs.Range.Range'
    -> m ((Bool, Word64, Word64))
    -- ^ __Returns:__ 'P.True' if the range contains more than one
    -- element, 'P.False' otherwise.
rangeGetRange :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Range -> m (Bool, Word64, Word64)
rangeGetRange Range
range = IO (Bool, Word64, Word64) -> m (Bool, Word64, Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word64, Word64) -> m (Bool, Word64, Word64))
-> IO (Bool, Word64, Word64) -> m (Bool, Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- Range -> IO (Ptr Range)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Range
range
    Ptr Word64
start <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
end <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CInt
result <- Ptr Range -> Ptr Word64 -> Ptr Word64 -> IO CInt
nm_range_get_range Ptr Range
range' Ptr Word64
start Ptr Word64
end
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word64
start' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
start
    Word64
end' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
end
    Range -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Range
range
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
start
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
end
    (Bool, Word64, Word64) -> IO (Bool, Word64, Word64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word64
start', Word64
end')

#if defined(ENABLE_OVERLOADING)
data RangeGetRangeMethodInfo
instance (signature ~ (m ((Bool, Word64, Word64))), MonadIO m) => O.OverloadedMethod RangeGetRangeMethodInfo Range signature where
    overloadedMethod = rangeGetRange

instance O.OverloadedMethodInfo RangeGetRangeMethodInfo Range where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.Range.rangeGetRange",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-Range.html#v:rangeGetRange"
        })


#endif

-- method Range::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "NM" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "Range" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_range_ref" nm_range_ref :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "NM", name = "Range"})
    IO (Ptr Range)

-- | Increases the reference count of the object.
-- This is thread-safe.
-- 
-- /Since: 1.42/
rangeRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Range
    -- ^ /@range@/: the t'GI.NM.Structs.Range.Range'
    -> m Range
    -- ^ __Returns:__ the input argument /@range@/ object.
rangeRef :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Range -> m Range
rangeRef Range
range = IO Range -> m Range
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Range -> m Range) -> IO Range -> m Range
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- Range -> IO (Ptr Range)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Range
range
    Ptr Range
result <- Ptr Range -> IO (Ptr Range)
nm_range_ref Ptr Range
range'
    Text -> Ptr Range -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"rangeRef" Ptr Range
result
    Range
result' <- ((ManagedPtr Range -> Range) -> Ptr Range -> IO Range
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Range -> Range
Range) Ptr Range
result
    Range -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Range
range
    Range -> IO Range
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Range
result'

#if defined(ENABLE_OVERLOADING)
data RangeRefMethodInfo
instance (signature ~ (m Range), MonadIO m) => O.OverloadedMethod RangeRefMethodInfo Range signature where
    overloadedMethod = rangeRef

instance O.OverloadedMethodInfo RangeRefMethodInfo Range where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.Range.rangeRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-Range.html#v:rangeRef"
        })


#endif

-- method Range::to_str
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "NM" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_range_to_str" nm_range_to_str :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "NM", name = "Range"})
    IO CString

-- | Convert a @/NMRange/@ to a string.
-- 
-- /Since: 1.42/
rangeToStr ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Range
    -- ^ /@range@/: the @/NMRange/@
    -> m T.Text
    -- ^ __Returns:__ a string representing the range.
rangeToStr :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Range -> m Text
rangeToStr Range
range = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- Range -> IO (Ptr Range)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Range
range
    CString
result <- Ptr Range -> IO CString
nm_range_to_str Ptr Range
range'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"rangeToStr" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    Range -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Range
range
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data RangeToStrMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod RangeToStrMethodInfo Range signature where
    overloadedMethod = rangeToStr

instance O.OverloadedMethodInfo RangeToStrMethodInfo Range where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.Range.rangeToStr",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-Range.html#v:rangeToStr"
        })


#endif

-- method Range::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "NM" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_range_unref" nm_range_unref :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "NM", name = "Range"})
    IO ()

-- | Decreases the reference count of the object.  If the reference count
-- reaches zero the object will be destroyed.
-- This is thread-safe.
-- 
-- /Since: 1.42/
rangeUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Range
    -- ^ /@range@/: the t'GI.NM.Structs.Range.Range'
    -> m ()
rangeUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Range -> m ()
rangeUnref Range
range = 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
$ do
    Ptr Range
range' <- Range -> IO (Ptr Range)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Range
range
    Ptr Range -> IO ()
nm_range_unref Ptr Range
range'
    Range -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Range
range
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RangeUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod RangeUnrefMethodInfo Range signature where
    overloadedMethod = rangeUnref

instance O.OverloadedMethodInfo RangeUnrefMethodInfo Range where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.Range.rangeUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-Range.html#v:rangeUnref"
        })


#endif

-- method Range::from_str
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the string representation of a range"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "Range" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_range_from_str" nm_range_from_str :: 
    CString ->                              -- str : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Range)

-- | Parses the string representation of the range to create a @/NMRange/@
-- instance.
-- 
-- /Since: 1.42/
rangeFromStr ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@str@/: the string representation of a range
    -> m Range
    -- ^ __Returns:__ the @/NMRange/@ or 'P.Nothing' /(Can throw 'Data.GI.Base.GError.GError')/
rangeFromStr :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m Range
rangeFromStr Text
str = IO Range -> m Range
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Range -> m Range) -> IO Range -> m Range
forall a b. (a -> b) -> a -> b
$ do
    CString
str' <- Text -> IO CString
textToCString Text
str
    IO Range -> IO () -> IO Range
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Range
result <- (Ptr (Ptr GError) -> IO (Ptr Range)) -> IO (Ptr Range)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Range)) -> IO (Ptr Range))
-> (Ptr (Ptr GError) -> IO (Ptr Range)) -> IO (Ptr Range)
forall a b. (a -> b) -> a -> b
$ CString -> Ptr (Ptr GError) -> IO (Ptr Range)
nm_range_from_str CString
str'
        Text -> Ptr Range -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"rangeFromStr" Ptr Range
result
        Range
result' <- ((ManagedPtr Range -> Range) -> Ptr Range -> IO Range
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Range -> Range
Range) Ptr Range
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
        Range -> IO Range
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Range
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
     )

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveRangeMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveRangeMethod "cmp" o = RangeCmpMethodInfo
    ResolveRangeMethod "ref" o = RangeRefMethodInfo
    ResolveRangeMethod "toStr" o = RangeToStrMethodInfo
    ResolveRangeMethod "unref" o = RangeUnrefMethodInfo
    ResolveRangeMethod "getRange" o = RangeGetRangeMethodInfo
    ResolveRangeMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif