{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents a blame.

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

module GI.Ggit.Objects.Blame
    ( 

-- * Exported types
    Blame(..)                               ,
    IsBlame                                 ,
    toBlame                                 ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveBlameMethod                      ,
#endif


-- ** fromBuffer #method:fromBuffer#

#if defined(ENABLE_OVERLOADING)
    BlameFromBufferMethodInfo               ,
#endif
    blameFromBuffer                         ,


-- ** getFlags #method:getFlags#

    blameGetFlags                           ,


-- ** getHunkByIndex #method:getHunkByIndex#

#if defined(ENABLE_OVERLOADING)
    BlameGetHunkByIndexMethodInfo           ,
#endif
    blameGetHunkByIndex                     ,


-- ** getHunkByLine #method:getHunkByLine#

#if defined(ENABLE_OVERLOADING)
    BlameGetHunkByLineMethodInfo            ,
#endif
    blameGetHunkByLine                      ,


-- ** getHunkCount #method:getHunkCount#

#if defined(ENABLE_OVERLOADING)
    BlameGetHunkCountMethodInfo             ,
#endif
    blameGetHunkCount                       ,


-- ** setFlags #method:setFlags#

    blameSetFlags                           ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
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.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 GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Ggit.Flags as Ggit.Flags
import {-# SOURCE #-} qualified GI.Ggit.Objects.Native as Ggit.Native
import {-# SOURCE #-} qualified GI.Ggit.Objects.ObjectFactoryBase as Ggit.ObjectFactoryBase
import {-# SOURCE #-} qualified GI.Ggit.Structs.BlameHunk as Ggit.BlameHunk
import {-# SOURCE #-} qualified GI.Ggit.Structs.BlameOptions as Ggit.BlameOptions

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

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

foreign import ccall "ggit_blame_get_type"
    c_ggit_blame_get_type :: IO B.Types.GType

instance B.Types.TypedObject Blame where
    glibType :: IO GType
glibType = IO GType
c_ggit_blame_get_type

instance B.Types.GObject Blame

-- | Convert 'Blame' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Blame where
    toGValue :: Blame -> IO GValue
toGValue Blame
o = do
        GType
gtype <- IO GType
c_ggit_blame_get_type
        Blame -> (Ptr Blame -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Blame
o (GType -> (GValue -> Ptr Blame -> IO ()) -> Ptr Blame -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Blame -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Blame
fromGValue GValue
gv = do
        Ptr Blame
ptr <- GValue -> IO (Ptr Blame)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Blame)
        (ManagedPtr Blame -> Blame) -> Ptr Blame -> IO Blame
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Blame -> Blame
Blame Ptr Blame
ptr
        
    

-- | Type class for types which can be safely cast to `Blame`, for instance with `toBlame`.
class (SP.GObject o, O.IsDescendantOf Blame o) => IsBlame o
instance (SP.GObject o, O.IsDescendantOf Blame o) => IsBlame o

instance O.HasParentTypes Blame
type instance O.ParentTypes Blame = '[Ggit.Native.Native, Ggit.ObjectFactoryBase.ObjectFactoryBase, GObject.Object.Object]

-- | Cast to `Blame`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toBlame :: (MonadIO m, IsBlame o) => o -> m Blame
toBlame :: o -> m Blame
toBlame = IO Blame -> m Blame
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Blame -> m Blame) -> (o -> IO Blame) -> o -> m Blame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Blame -> Blame) -> o -> IO Blame
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Blame -> Blame
Blame

#if defined(ENABLE_OVERLOADING)
type family ResolveBlameMethod (t :: Symbol) (o :: *) :: * where
    ResolveBlameMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveBlameMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveBlameMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveBlameMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveBlameMethod "fromBuffer" o = BlameFromBufferMethodInfo
    ResolveBlameMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveBlameMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveBlameMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveBlameMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveBlameMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveBlameMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveBlameMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveBlameMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveBlameMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveBlameMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveBlameMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveBlameMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveBlameMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveBlameMethod "getHunkByIndex" o = BlameGetHunkByIndexMethodInfo
    ResolveBlameMethod "getHunkByLine" o = BlameGetHunkByLineMethodInfo
    ResolveBlameMethod "getHunkCount" o = BlameGetHunkCountMethodInfo
    ResolveBlameMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveBlameMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveBlameMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveBlameMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveBlameMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveBlameMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveBlameMethod t Blame, O.MethodInfo info Blame p) => OL.IsLabel t (Blame -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Blame
type instance O.AttributeList Blame = BlameAttributeList
type BlameAttributeList = ('[ '("native", Ggit.Native.NativeNativePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Blame = BlameSignalList
type BlameSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Blame::from_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "blame"
--           , argType = TInterface Name { namespace = "Ggit" , name = "Blame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitBlame." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the contents of the file."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer_length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of the buffer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "buffer_length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of the buffer."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "Blame" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_blame_from_buffer" ggit_blame_from_buffer :: 
    Ptr Blame ->                            -- blame : TInterface (Name {namespace = "Ggit", name = "Blame"})
    Ptr Word8 ->                            -- buffer : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- buffer_length : TBasicType TUInt64
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Blame)

-- | Get blame data for a file that has been modified in memory. /@blame@/ is a
-- pre-calculated blame for the in-odb history of the file. This means that once
-- a file blame is completed (which can be expensitve), updating the buffer
-- blame is very fast.
-- 
-- Lines that differ between the buffer and the committed version are marked as
-- having a zero id for their @/ggit_blame_hunk_get_final_commit_id/@.
blameFromBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsBlame a) =>
    a
    -- ^ /@blame@/: a t'GI.Ggit.Objects.Blame.Blame'.
    -> ByteString
    -- ^ /@buffer@/: the contents of the file.
    -> m (Maybe Blame)
    -- ^ __Returns:__ a t'GI.Ggit.Objects.Blame.Blame' or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
blameFromBuffer :: a -> ByteString -> m (Maybe Blame)
blameFromBuffer a
blame ByteString
buffer = IO (Maybe Blame) -> m (Maybe Blame)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Blame) -> m (Maybe Blame))
-> IO (Maybe Blame) -> m (Maybe Blame)
forall a b. (a -> b) -> a -> b
$ do
    let bufferLength :: Word64
bufferLength = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
buffer
    Ptr Blame
blame' <- a -> IO (Ptr Blame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
blame
    Ptr Word8
buffer' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
buffer
    IO (Maybe Blame) -> IO () -> IO (Maybe Blame)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Blame
result <- (Ptr (Ptr GError) -> IO (Ptr Blame)) -> IO (Ptr Blame)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Blame)) -> IO (Ptr Blame))
-> (Ptr (Ptr GError) -> IO (Ptr Blame)) -> IO (Ptr Blame)
forall a b. (a -> b) -> a -> b
$ Ptr Blame
-> Ptr Word8 -> Word64 -> Ptr (Ptr GError) -> IO (Ptr Blame)
ggit_blame_from_buffer Ptr Blame
blame' Ptr Word8
buffer' Word64
bufferLength
        Maybe Blame
maybeResult <- Ptr Blame -> (Ptr Blame -> IO Blame) -> IO (Maybe Blame)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Blame
result ((Ptr Blame -> IO Blame) -> IO (Maybe Blame))
-> (Ptr Blame -> IO Blame) -> IO (Maybe Blame)
forall a b. (a -> b) -> a -> b
$ \Ptr Blame
result' -> do
            Blame
result'' <- ((ManagedPtr Blame -> Blame) -> Ptr Blame -> IO Blame
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Blame -> Blame
Blame) Ptr Blame
result'
            Blame -> IO Blame
forall (m :: * -> *) a. Monad m => a -> m a
return Blame
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
blame
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
buffer'
        Maybe Blame -> IO (Maybe Blame)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Blame
maybeResult
     ) (do
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
buffer'
     )

#if defined(ENABLE_OVERLOADING)
data BlameFromBufferMethodInfo
instance (signature ~ (ByteString -> m (Maybe Blame)), MonadIO m, IsBlame a) => O.MethodInfo BlameFromBufferMethodInfo a signature where
    overloadedMethod = blameFromBuffer

#endif

-- method Blame::get_hunk_by_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "blame"
--           , argType = TInterface Name { namespace = "Ggit" , name = "Blame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "BlameHunk" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_blame_get_hunk_by_index" ggit_blame_get_hunk_by_index :: 
    Ptr Blame ->                            -- blame : TInterface (Name {namespace = "Ggit", name = "Blame"})
    Word32 ->                               -- idx : TBasicType TUInt32
    IO (Ptr Ggit.BlameHunk.BlameHunk)

-- | /No description available in the introspection data./
blameGetHunkByIndex ::
    (B.CallStack.HasCallStack, MonadIO m, IsBlame a) =>
    a
    -> Word32
    -> m Ggit.BlameHunk.BlameHunk
blameGetHunkByIndex :: a -> Word32 -> m BlameHunk
blameGetHunkByIndex a
blame Word32
idx = IO BlameHunk -> m BlameHunk
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BlameHunk -> m BlameHunk) -> IO BlameHunk -> m BlameHunk
forall a b. (a -> b) -> a -> b
$ do
    Ptr Blame
blame' <- a -> IO (Ptr Blame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
blame
    Ptr BlameHunk
result <- Ptr Blame -> Word32 -> IO (Ptr BlameHunk)
ggit_blame_get_hunk_by_index Ptr Blame
blame' Word32
idx
    Text -> Ptr BlameHunk -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"blameGetHunkByIndex" Ptr BlameHunk
result
    BlameHunk
result' <- ((ManagedPtr BlameHunk -> BlameHunk)
-> Ptr BlameHunk -> IO BlameHunk
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BlameHunk -> BlameHunk
Ggit.BlameHunk.BlameHunk) Ptr BlameHunk
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
blame
    BlameHunk -> IO BlameHunk
forall (m :: * -> *) a. Monad m => a -> m a
return BlameHunk
result'

#if defined(ENABLE_OVERLOADING)
data BlameGetHunkByIndexMethodInfo
instance (signature ~ (Word32 -> m Ggit.BlameHunk.BlameHunk), MonadIO m, IsBlame a) => O.MethodInfo BlameGetHunkByIndexMethodInfo a signature where
    overloadedMethod = blameGetHunkByIndex

#endif

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

foreign import ccall "ggit_blame_get_hunk_by_line" ggit_blame_get_hunk_by_line :: 
    Ptr Blame ->                            -- blame : TInterface (Name {namespace = "Ggit", name = "Blame"})
    Word32 ->                               -- line : TBasicType TUInt32
    IO (Ptr Ggit.BlameHunk.BlameHunk)

-- | /No description available in the introspection data./
blameGetHunkByLine ::
    (B.CallStack.HasCallStack, MonadIO m, IsBlame a) =>
    a
    -> Word32
    -> m Ggit.BlameHunk.BlameHunk
blameGetHunkByLine :: a -> Word32 -> m BlameHunk
blameGetHunkByLine a
blame Word32
line = IO BlameHunk -> m BlameHunk
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BlameHunk -> m BlameHunk) -> IO BlameHunk -> m BlameHunk
forall a b. (a -> b) -> a -> b
$ do
    Ptr Blame
blame' <- a -> IO (Ptr Blame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
blame
    Ptr BlameHunk
result <- Ptr Blame -> Word32 -> IO (Ptr BlameHunk)
ggit_blame_get_hunk_by_line Ptr Blame
blame' Word32
line
    Text -> Ptr BlameHunk -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"blameGetHunkByLine" Ptr BlameHunk
result
    BlameHunk
result' <- ((ManagedPtr BlameHunk -> BlameHunk)
-> Ptr BlameHunk -> IO BlameHunk
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BlameHunk -> BlameHunk
Ggit.BlameHunk.BlameHunk) Ptr BlameHunk
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
blame
    BlameHunk -> IO BlameHunk
forall (m :: * -> *) a. Monad m => a -> m a
return BlameHunk
result'

#if defined(ENABLE_OVERLOADING)
data BlameGetHunkByLineMethodInfo
instance (signature ~ (Word32 -> m Ggit.BlameHunk.BlameHunk), MonadIO m, IsBlame a) => O.MethodInfo BlameGetHunkByLineMethodInfo a signature where
    overloadedMethod = blameGetHunkByLine

#endif

-- method Blame::get_hunk_count
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "blame"
--           , argType = TInterface Name { namespace = "Ggit" , name = "Blame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "ggit_blame_get_hunk_count" ggit_blame_get_hunk_count :: 
    Ptr Blame ->                            -- blame : TInterface (Name {namespace = "Ggit", name = "Blame"})
    IO Word32

-- | /No description available in the introspection data./
blameGetHunkCount ::
    (B.CallStack.HasCallStack, MonadIO m, IsBlame a) =>
    a
    -> m Word32
blameGetHunkCount :: a -> m Word32
blameGetHunkCount a
blame = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Blame
blame' <- a -> IO (Ptr Blame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
blame
    Word32
result <- Ptr Blame -> IO Word32
ggit_blame_get_hunk_count Ptr Blame
blame'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
blame
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data BlameGetHunkCountMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsBlame a) => O.MethodInfo BlameGetHunkCountMethodInfo a signature where
    overloadedMethod = blameGetHunkCount

#endif

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

foreign import ccall "ggit_blame_get_flags" ggit_blame_get_flags :: 
    Ptr Ggit.BlameOptions.BlameOptions ->   -- blame_options : TInterface (Name {namespace = "Ggit", name = "BlameOptions"})
    IO CUInt

-- | Get the blame options flags.
blameGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ggit.BlameOptions.BlameOptions
    -- ^ /@blameOptions@/: a t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
    -> m [Ggit.Flags.BlameFlags]
    -- ^ __Returns:__ a t'GI.Ggit.Flags.BlameFlags'.
blameGetFlags :: BlameOptions -> m [BlameFlags]
blameGetFlags BlameOptions
blameOptions = IO [BlameFlags] -> m [BlameFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [BlameFlags] -> m [BlameFlags])
-> IO [BlameFlags] -> m [BlameFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr BlameOptions
blameOptions' <- BlameOptions -> IO (Ptr BlameOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BlameOptions
blameOptions
    CUInt
result <- Ptr BlameOptions -> IO CUInt
ggit_blame_get_flags Ptr BlameOptions
blameOptions'
    let result' :: [BlameFlags]
result' = CUInt -> [BlameFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    BlameOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameOptions
blameOptions
    [BlameFlags] -> IO [BlameFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [BlameFlags]
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Blame::set_flags
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "blame_options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "BlameOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitBlameOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "BlameFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitBlameFlags." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ggit_blame_set_flags" ggit_blame_set_flags :: 
    Ptr Ggit.BlameOptions.BlameOptions ->   -- blame_options : TInterface (Name {namespace = "Ggit", name = "BlameOptions"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Ggit", name = "BlameFlags"})
    IO ()

-- | Set the blame options flags.
blameSetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ggit.BlameOptions.BlameOptions
    -- ^ /@blameOptions@/: a t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
    -> [Ggit.Flags.BlameFlags]
    -- ^ /@flags@/: a t'GI.Ggit.Flags.BlameFlags'.
    -> m ()
blameSetFlags :: BlameOptions -> [BlameFlags] -> m ()
blameSetFlags BlameOptions
blameOptions [BlameFlags]
flags = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BlameOptions
blameOptions' <- BlameOptions -> IO (Ptr BlameOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BlameOptions
blameOptions
    let flags' :: CUInt
flags' = [BlameFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [BlameFlags]
flags
    Ptr BlameOptions -> CUInt -> IO ()
ggit_blame_set_flags Ptr BlameOptions
blameOptions' CUInt
flags'
    BlameOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameOptions
blameOptions
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif