{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents the line of a diff.

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

module GI.Ggit.Structs.DiffLine
    ( 

-- * Exported types
    DiffLine(..)                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [ref]("GI.Ggit.Structs.DiffLine#g:method:ref"), [unref]("GI.Ggit.Structs.DiffLine#g:method:unref").
-- 
-- ==== Getters
-- [getContent]("GI.Ggit.Structs.DiffLine#g:method:getContent"), [getContentOffset]("GI.Ggit.Structs.DiffLine#g:method:getContentOffset"), [getNewLineno]("GI.Ggit.Structs.DiffLine#g:method:getNewLineno"), [getOldLineno]("GI.Ggit.Structs.DiffLine#g:method:getOldLineno"), [getOrigin]("GI.Ggit.Structs.DiffLine#g:method:getOrigin"), [getText]("GI.Ggit.Structs.DiffLine#g:method:getText").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveDiffLineMethod                   ,
#endif

-- ** getContent #method:getContent#

#if defined(ENABLE_OVERLOADING)
    DiffLineGetContentMethodInfo            ,
#endif
    diffLineGetContent                      ,


-- ** getContentOffset #method:getContentOffset#

#if defined(ENABLE_OVERLOADING)
    DiffLineGetContentOffsetMethodInfo      ,
#endif
    diffLineGetContentOffset                ,


-- ** getNewLineno #method:getNewLineno#

#if defined(ENABLE_OVERLOADING)
    DiffLineGetNewLinenoMethodInfo          ,
#endif
    diffLineGetNewLineno                    ,


-- ** getOldLineno #method:getOldLineno#

#if defined(ENABLE_OVERLOADING)
    DiffLineGetOldLinenoMethodInfo          ,
#endif
    diffLineGetOldLineno                    ,


-- ** getOrigin #method:getOrigin#

#if defined(ENABLE_OVERLOADING)
    DiffLineGetOriginMethodInfo             ,
#endif
    diffLineGetOrigin                       ,


-- ** getText #method:getText#

#if defined(ENABLE_OVERLOADING)
    DiffLineGetTextMethodInfo               ,
#endif
    diffLineGetText                         ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    DiffLineRefMethodInfo                   ,
#endif
    diffLineRef                             ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    DiffLineUnrefMethodInfo                 ,
#endif
    diffLineUnref                           ,




    ) 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 {-# SOURCE #-} qualified GI.Ggit.Enums as Ggit.Enums

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

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

foreign import ccall "ggit_diff_line_get_type" c_ggit_diff_line_get_type :: 
    IO GType

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

instance B.Types.TypedObject DiffLine where
    glibType :: IO GType
glibType = IO GType
c_ggit_diff_line_get_type

instance B.Types.GBoxed DiffLine

-- | Convert 'DiffLine' 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 DiffLine) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ggit_diff_line_get_type
    gvalueSet_ :: Ptr GValue -> Maybe DiffLine -> IO ()
gvalueSet_ Ptr GValue
gv Maybe DiffLine
P.Nothing = Ptr GValue -> Ptr DiffLine -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr DiffLine
forall a. Ptr a
FP.nullPtr :: FP.Ptr DiffLine)
    gvalueSet_ Ptr GValue
gv (P.Just DiffLine
obj) = DiffLine -> (Ptr DiffLine -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DiffLine
obj (Ptr GValue -> Ptr DiffLine -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe DiffLine)
gvalueGet_ Ptr GValue
gv = do
        Ptr DiffLine
ptr <- Ptr GValue -> IO (Ptr DiffLine)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr DiffLine)
        if Ptr DiffLine
ptr Ptr DiffLine -> Ptr DiffLine -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr DiffLine
forall a. Ptr a
FP.nullPtr
        then DiffLine -> Maybe DiffLine
forall a. a -> Maybe a
P.Just (DiffLine -> Maybe DiffLine) -> IO DiffLine -> IO (Maybe DiffLine)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr DiffLine -> DiffLine) -> Ptr DiffLine -> IO DiffLine
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr DiffLine -> DiffLine
DiffLine Ptr DiffLine
ptr
        else Maybe DiffLine -> IO (Maybe DiffLine)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiffLine
forall a. Maybe a
P.Nothing
        
    


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

-- method DiffLine::get_content
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "line"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffLine" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffLine." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of returned bytes."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of returned bytes."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TUInt8))
-- throws : False
-- Skip return : False

foreign import ccall "ggit_diff_line_get_content" ggit_diff_line_get_content :: 
    Ptr DiffLine ->                         -- line : TInterface (Name {namespace = "Ggit", name = "DiffLine"})
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    IO (Ptr Word8)

-- | Gets the content in bytes.
diffLineGetContent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffLine
    -- ^ /@line@/: a t'GI.Ggit.Structs.DiffLine.DiffLine'.
    -> m ByteString
    -- ^ __Returns:__ the content in bytes.
diffLineGetContent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffLine -> m ByteString
diffLineGetContent DiffLine
line = IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffLine
line' <- DiffLine -> IO (Ptr DiffLine)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffLine
line
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word8
result <- Ptr DiffLine -> Ptr Word64 -> IO (Ptr Word8)
ggit_diff_line_get_content Ptr DiffLine
line' Ptr Word64
length_
    Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
    Text -> Ptr Word8 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"diffLineGetContent" Ptr Word8
result
    ByteString
result' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
length_') Ptr Word8
result
    DiffLine -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffLine
line
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result'

#if defined(ENABLE_OVERLOADING)
data DiffLineGetContentMethodInfo
instance (signature ~ (m ByteString), MonadIO m) => O.OverloadedMethod DiffLineGetContentMethodInfo DiffLine signature where
    overloadedMethod = diffLineGetContent

instance O.OverloadedMethodInfo DiffLineGetContentMethodInfo DiffLine where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.DiffLine.diffLineGetContent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Structs-DiffLine.html#v:diffLineGetContent"
        })


#endif

-- method DiffLine::get_content_offset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "line"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffLine" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffLine." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt64)
-- throws : False
-- Skip return : False

foreign import ccall "ggit_diff_line_get_content_offset" ggit_diff_line_get_content_offset :: 
    Ptr DiffLine ->                         -- line : TInterface (Name {namespace = "Ggit", name = "DiffLine"})
    IO Int64

-- | Gets the content offset.
diffLineGetContentOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffLine
    -- ^ /@line@/: a t'GI.Ggit.Structs.DiffLine.DiffLine'.
    -> m Int64
    -- ^ __Returns:__ the content offset.
diffLineGetContentOffset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffLine -> m Int64
diffLineGetContentOffset DiffLine
line = IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffLine
line' <- DiffLine -> IO (Ptr DiffLine)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffLine
line
    Int64
result <- Ptr DiffLine -> IO Int64
ggit_diff_line_get_content_offset Ptr DiffLine
line'
    DiffLine -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffLine
line
    Int64 -> IO Int64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data DiffLineGetContentOffsetMethodInfo
instance (signature ~ (m Int64), MonadIO m) => O.OverloadedMethod DiffLineGetContentOffsetMethodInfo DiffLine signature where
    overloadedMethod = diffLineGetContentOffset

instance O.OverloadedMethodInfo DiffLineGetContentOffsetMethodInfo DiffLine where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.DiffLine.diffLineGetContentOffset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Structs-DiffLine.html#v:diffLineGetContentOffset"
        })


#endif

-- method DiffLine::get_new_lineno
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "line"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffLine" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffLine." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "ggit_diff_line_get_new_lineno" ggit_diff_line_get_new_lineno :: 
    Ptr DiffLine ->                         -- line : TInterface (Name {namespace = "Ggit", name = "DiffLine"})
    IO Int32

-- | Gets the Line number in new file or -1 for deleted line.
diffLineGetNewLineno ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffLine
    -- ^ /@line@/: a t'GI.Ggit.Structs.DiffLine.DiffLine'.
    -> m Int32
    -- ^ __Returns:__ the line\'s old number of lines.
diffLineGetNewLineno :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffLine -> m Int32
diffLineGetNewLineno DiffLine
line = 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 DiffLine
line' <- DiffLine -> IO (Ptr DiffLine)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffLine
line
    Int32
result <- Ptr DiffLine -> IO Int32
ggit_diff_line_get_new_lineno Ptr DiffLine
line'
    DiffLine -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffLine
line
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DiffLineGetNewLinenoMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod DiffLineGetNewLinenoMethodInfo DiffLine signature where
    overloadedMethod = diffLineGetNewLineno

instance O.OverloadedMethodInfo DiffLineGetNewLinenoMethodInfo DiffLine where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.DiffLine.diffLineGetNewLineno",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Structs-DiffLine.html#v:diffLineGetNewLineno"
        })


#endif

-- method DiffLine::get_old_lineno
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "line"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffLine" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffLine." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "ggit_diff_line_get_old_lineno" ggit_diff_line_get_old_lineno :: 
    Ptr DiffLine ->                         -- line : TInterface (Name {namespace = "Ggit", name = "DiffLine"})
    IO Int32

-- | Gets the line number in old file or -1 for added line.
diffLineGetOldLineno ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffLine
    -- ^ /@line@/: a t'GI.Ggit.Structs.DiffLine.DiffLine'.
    -> m Int32
    -- ^ __Returns:__ the line\'s old line number.
diffLineGetOldLineno :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffLine -> m Int32
diffLineGetOldLineno DiffLine
line = 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 DiffLine
line' <- DiffLine -> IO (Ptr DiffLine)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffLine
line
    Int32
result <- Ptr DiffLine -> IO Int32
ggit_diff_line_get_old_lineno Ptr DiffLine
line'
    DiffLine -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffLine
line
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DiffLineGetOldLinenoMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod DiffLineGetOldLinenoMethodInfo DiffLine signature where
    overloadedMethod = diffLineGetOldLineno

instance O.OverloadedMethodInfo DiffLineGetOldLinenoMethodInfo DiffLine where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.DiffLine.diffLineGetOldLineno",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Structs-DiffLine.html#v:diffLineGetOldLineno"
        })


#endif

-- method DiffLine::get_origin
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "line"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffLine" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffLine." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Ggit" , name = "DiffLineType" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_diff_line_get_origin" ggit_diff_line_get_origin :: 
    Ptr DiffLine ->                         -- line : TInterface (Name {namespace = "Ggit", name = "DiffLine"})
    IO CUInt

-- | Gets the t'GI.Ggit.Enums.DiffLineType' value.
diffLineGetOrigin ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffLine
    -- ^ /@line@/: a t'GI.Ggit.Structs.DiffLine.DiffLine'.
    -> m Ggit.Enums.DiffLineType
    -- ^ __Returns:__ the t'GI.Ggit.Enums.DiffLineType' value.
diffLineGetOrigin :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffLine -> m DiffLineType
diffLineGetOrigin DiffLine
line = IO DiffLineType -> m DiffLineType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DiffLineType -> m DiffLineType)
-> IO DiffLineType -> m DiffLineType
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffLine
line' <- DiffLine -> IO (Ptr DiffLine)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffLine
line
    CUInt
result <- Ptr DiffLine -> IO CUInt
ggit_diff_line_get_origin Ptr DiffLine
line'
    let result' :: DiffLineType
result' = (Int -> DiffLineType
forall a. Enum a => Int -> a
toEnum (Int -> DiffLineType) -> (CUInt -> Int) -> CUInt -> DiffLineType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    DiffLine -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffLine
line
    DiffLineType -> IO DiffLineType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DiffLineType
result'

#if defined(ENABLE_OVERLOADING)
data DiffLineGetOriginMethodInfo
instance (signature ~ (m Ggit.Enums.DiffLineType), MonadIO m) => O.OverloadedMethod DiffLineGetOriginMethodInfo DiffLine signature where
    overloadedMethod = diffLineGetOrigin

instance O.OverloadedMethodInfo DiffLineGetOriginMethodInfo DiffLine where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.DiffLine.diffLineGetOrigin",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Structs-DiffLine.html#v:diffLineGetOrigin"
        })


#endif

-- method DiffLine::get_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "line"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffLine" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffLine." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "ggit_diff_line_get_text" ggit_diff_line_get_text :: 
    Ptr DiffLine ->                         -- line : TInterface (Name {namespace = "Ggit", name = "DiffLine"})
    IO CString

-- | Get the content of the diff line as UTF-8 encoded text.
diffLineGetText ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffLine
    -- ^ /@line@/: a t'GI.Ggit.Structs.DiffLine.DiffLine'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the content in utf-8 encoding or 'P.Nothing'.
diffLineGetText :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffLine -> m (Maybe Text)
diffLineGetText DiffLine
line = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffLine
line' <- DiffLine -> IO (Ptr DiffLine)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffLine
line
    CString
result <- Ptr DiffLine -> IO CString
ggit_diff_line_get_text Ptr DiffLine
line'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    DiffLine -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffLine
line
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiffLineGetTextMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod DiffLineGetTextMethodInfo DiffLine signature where
    overloadedMethod = diffLineGetText

instance O.OverloadedMethodInfo DiffLineGetTextMethodInfo DiffLine where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.DiffLine.diffLineGetText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Structs-DiffLine.html#v:diffLineGetText"
        })


#endif

-- method DiffLine::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "line"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffLine" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffLine." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "DiffLine" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_diff_line_ref" ggit_diff_line_ref :: 
    Ptr DiffLine ->                         -- line : TInterface (Name {namespace = "Ggit", name = "DiffLine"})
    IO (Ptr DiffLine)

-- | Atomically increments the reference count of /@line@/ by one.
-- This function is MT-safe and may be called from any thread.
diffLineRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffLine
    -- ^ /@line@/: a t'GI.Ggit.Structs.DiffLine.DiffLine'.
    -> m (Maybe DiffLine)
    -- ^ __Returns:__ a t'GI.Ggit.Structs.DiffLine.DiffLine' or 'P.Nothing'.
diffLineRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DiffLine -> m (Maybe DiffLine)
diffLineRef DiffLine
line = IO (Maybe DiffLine) -> m (Maybe DiffLine)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DiffLine) -> m (Maybe DiffLine))
-> IO (Maybe DiffLine) -> m (Maybe DiffLine)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffLine
line' <- DiffLine -> IO (Ptr DiffLine)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffLine
line
    Ptr DiffLine
result <- Ptr DiffLine -> IO (Ptr DiffLine)
ggit_diff_line_ref Ptr DiffLine
line'
    Maybe DiffLine
maybeResult <- Ptr DiffLine
-> (Ptr DiffLine -> IO DiffLine) -> IO (Maybe DiffLine)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DiffLine
result ((Ptr DiffLine -> IO DiffLine) -> IO (Maybe DiffLine))
-> (Ptr DiffLine -> IO DiffLine) -> IO (Maybe DiffLine)
forall a b. (a -> b) -> a -> b
$ \Ptr DiffLine
result' -> do
        DiffLine
result'' <- ((ManagedPtr DiffLine -> DiffLine) -> Ptr DiffLine -> IO DiffLine
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DiffLine -> DiffLine
DiffLine) Ptr DiffLine
result'
        DiffLine -> IO DiffLine
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DiffLine
result''
    DiffLine -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffLine
line
    Maybe DiffLine -> IO (Maybe DiffLine)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiffLine
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiffLineRefMethodInfo
instance (signature ~ (m (Maybe DiffLine)), MonadIO m) => O.OverloadedMethod DiffLineRefMethodInfo DiffLine signature where
    overloadedMethod = diffLineRef

instance O.OverloadedMethodInfo DiffLineRefMethodInfo DiffLine where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.DiffLine.diffLineRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Structs-DiffLine.html#v:diffLineRef"
        })


#endif

-- method DiffLine::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "line"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffLine" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffLine." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_diff_line_unref" ggit_diff_line_unref :: 
    Ptr DiffLine ->                         -- line : TInterface (Name {namespace = "Ggit", name = "DiffLine"})
    IO ()

-- | Atomically decrements the reference count of /@line@/ by one.
-- If the reference count drops to 0, /@line@/ is freed.
diffLineUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffLine
    -- ^ /@line@/: a t'GI.Ggit.Structs.DiffLine.DiffLine'.
    -> m ()
diffLineUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => DiffLine -> m ()
diffLineUnref DiffLine
line = 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 DiffLine
line' <- DiffLine -> IO (Ptr DiffLine)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffLine
line
    Ptr DiffLine -> IO ()
ggit_diff_line_unref Ptr DiffLine
line'
    DiffLine -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffLine
line
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffLineUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod DiffLineUnrefMethodInfo DiffLine signature where
    overloadedMethod = diffLineUnref

instance O.OverloadedMethodInfo DiffLineUnrefMethodInfo DiffLine where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.DiffLine.diffLineUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.14/docs/GI-Ggit-Structs-DiffLine.html#v:diffLineUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDiffLineMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveDiffLineMethod "ref" o = DiffLineRefMethodInfo
    ResolveDiffLineMethod "unref" o = DiffLineUnrefMethodInfo
    ResolveDiffLineMethod "getContent" o = DiffLineGetContentMethodInfo
    ResolveDiffLineMethod "getContentOffset" o = DiffLineGetContentOffsetMethodInfo
    ResolveDiffLineMethod "getNewLineno" o = DiffLineGetNewLinenoMethodInfo
    ResolveDiffLineMethod "getOldLineno" o = DiffLineGetOldLinenoMethodInfo
    ResolveDiffLineMethod "getOrigin" o = DiffLineGetOriginMethodInfo
    ResolveDiffLineMethod "getText" o = DiffLineGetTextMethodInfo
    ResolveDiffLineMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif