{-# LANGUAGE TypeApplications #-}


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

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

module GI.Ggit.Structs.BlameOptions
    ( 

-- * Exported types
    BlameOptions(..)                        ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveBlameOptionsMethod               ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    BlameOptionsCopyMethodInfo              ,
#endif
    blameOptionsCopy                        ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    BlameOptionsFreeMethodInfo              ,
#endif
    blameOptionsFree                        ,


-- ** getMaximumLine #method:getMaximumLine#

#if defined(ENABLE_OVERLOADING)
    BlameOptionsGetMaximumLineMethodInfo    ,
#endif
    blameOptionsGetMaximumLine              ,


-- ** getMinimumLine #method:getMinimumLine#

#if defined(ENABLE_OVERLOADING)
    BlameOptionsGetMinimumLineMethodInfo    ,
#endif
    blameOptionsGetMinimumLine              ,


-- ** getMinimumMatchCharacters #method:getMinimumMatchCharacters#

#if defined(ENABLE_OVERLOADING)
    BlameOptionsGetMinimumMatchCharactersMethodInfo,
#endif
    blameOptionsGetMinimumMatchCharacters   ,


-- ** getNewestCommit #method:getNewestCommit#

#if defined(ENABLE_OVERLOADING)
    BlameOptionsGetNewestCommitMethodInfo   ,
#endif
    blameOptionsGetNewestCommit             ,


-- ** getOldestCommit #method:getOldestCommit#

#if defined(ENABLE_OVERLOADING)
    BlameOptionsGetOldestCommitMethodInfo   ,
#endif
    blameOptionsGetOldestCommit             ,


-- ** new #method:new#

    blameOptionsNew                         ,


-- ** setMaximumLine #method:setMaximumLine#

#if defined(ENABLE_OVERLOADING)
    BlameOptionsSetMaximumLineMethodInfo    ,
#endif
    blameOptionsSetMaximumLine              ,


-- ** setMinimumLine #method:setMinimumLine#

#if defined(ENABLE_OVERLOADING)
    BlameOptionsSetMinimumLineMethodInfo    ,
#endif
    blameOptionsSetMinimumLine              ,


-- ** setMinimumMatchCharacters #method:setMinimumMatchCharacters#

#if defined(ENABLE_OVERLOADING)
    BlameOptionsSetMinimumMatchCharactersMethodInfo,
#endif
    blameOptionsSetMinimumMatchCharacters   ,


-- ** setNewestCommit #method:setNewestCommit#

#if defined(ENABLE_OVERLOADING)
    BlameOptionsSetNewestCommitMethodInfo   ,
#endif
    blameOptionsSetNewestCommit             ,


-- ** setOldestCommit #method:setOldestCommit#

#if defined(ENABLE_OVERLOADING)
    BlameOptionsSetOldestCommitMethodInfo   ,
#endif
    blameOptionsSetOldestCommit             ,




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

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

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

foreign import ccall "ggit_blame_options_get_type" c_ggit_blame_options_get_type :: 
    IO GType

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

instance B.Types.TypedObject BlameOptions where
    glibType :: IO GType
glibType = IO GType
c_ggit_blame_options_get_type

instance B.Types.GBoxed BlameOptions

-- | Convert 'BlameOptions' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue BlameOptions where
    toGValue :: BlameOptions -> IO GValue
toGValue BlameOptions
o = do
        GType
gtype <- IO GType
c_ggit_blame_options_get_type
        BlameOptions -> (Ptr BlameOptions -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr BlameOptions
o (GType
-> (GValue -> Ptr BlameOptions -> IO ())
-> Ptr BlameOptions
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr BlameOptions -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO BlameOptions
fromGValue GValue
gv = do
        Ptr BlameOptions
ptr <- GValue -> IO (Ptr BlameOptions)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr BlameOptions)
        (ManagedPtr BlameOptions -> BlameOptions)
-> Ptr BlameOptions -> IO BlameOptions
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr BlameOptions -> BlameOptions
BlameOptions Ptr BlameOptions
ptr
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BlameOptions
type instance O.AttributeList BlameOptions = BlameOptionsAttributeList
type BlameOptionsAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method BlameOptions::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Ggit" , name = "BlameOptions" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_blame_options_new" ggit_blame_options_new :: 
    IO (Ptr BlameOptions)

-- | Create a new, empty t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
blameOptionsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m BlameOptions
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
blameOptionsNew :: m BlameOptions
blameOptionsNew  = IO BlameOptions -> m BlameOptions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BlameOptions -> m BlameOptions)
-> IO BlameOptions -> m BlameOptions
forall a b. (a -> b) -> a -> b
$ do
    Ptr BlameOptions
result <- IO (Ptr BlameOptions)
ggit_blame_options_new
    Text -> Ptr BlameOptions -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"blameOptionsNew" Ptr BlameOptions
result
    BlameOptions
result' <- ((ManagedPtr BlameOptions -> BlameOptions)
-> Ptr BlameOptions -> IO BlameOptions
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BlameOptions -> BlameOptions
BlameOptions) Ptr BlameOptions
result
    BlameOptions -> IO BlameOptions
forall (m :: * -> *) a. Monad m => a -> m a
return BlameOptions
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BlameOptions::copy
-- method type : OrdinaryMethod
-- 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 = "BlameOptions" })
-- throws : False
-- Skip return : False

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

-- | Copies /@blameOptions@/ into a newly allocated t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
blameOptionsCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameOptions
    -- ^ /@blameOptions@/: a t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
    -> m (Maybe BlameOptions)
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Structs.BlameOptions.BlameOptions' or 'P.Nothing'.
blameOptionsCopy :: BlameOptions -> m (Maybe BlameOptions)
blameOptionsCopy BlameOptions
blameOptions = IO (Maybe BlameOptions) -> m (Maybe BlameOptions)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BlameOptions) -> m (Maybe BlameOptions))
-> IO (Maybe BlameOptions) -> m (Maybe BlameOptions)
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
    Ptr BlameOptions
result <- Ptr BlameOptions -> IO (Ptr BlameOptions)
ggit_blame_options_copy Ptr BlameOptions
blameOptions'
    Maybe BlameOptions
maybeResult <- Ptr BlameOptions
-> (Ptr BlameOptions -> IO BlameOptions) -> IO (Maybe BlameOptions)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr BlameOptions
result ((Ptr BlameOptions -> IO BlameOptions) -> IO (Maybe BlameOptions))
-> (Ptr BlameOptions -> IO BlameOptions) -> IO (Maybe BlameOptions)
forall a b. (a -> b) -> a -> b
$ \Ptr BlameOptions
result' -> do
        BlameOptions
result'' <- ((ManagedPtr BlameOptions -> BlameOptions)
-> Ptr BlameOptions -> IO BlameOptions
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BlameOptions -> BlameOptions
BlameOptions) Ptr BlameOptions
result'
        BlameOptions -> IO BlameOptions
forall (m :: * -> *) a. Monad m => a -> m a
return BlameOptions
result''
    BlameOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameOptions
blameOptions
    Maybe BlameOptions -> IO (Maybe BlameOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BlameOptions
maybeResult

#if defined(ENABLE_OVERLOADING)
data BlameOptionsCopyMethodInfo
instance (signature ~ (m (Maybe BlameOptions)), MonadIO m) => O.MethodInfo BlameOptionsCopyMethodInfo BlameOptions signature where
    overloadedMethod = blameOptionsCopy

#endif

-- method BlameOptions::free
-- method type : OrdinaryMethod
-- 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: Nothing
-- throws : False
-- Skip return : False

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

-- | Frees /@blameOptions@/.
blameOptionsFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameOptions
    -- ^ /@blameOptions@/: a t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
    -> m ()
blameOptionsFree :: BlameOptions -> m ()
blameOptionsFree BlameOptions
blameOptions = 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
    Ptr BlameOptions -> IO ()
ggit_blame_options_free Ptr BlameOptions
blameOptions'
    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)
data BlameOptionsFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo BlameOptionsFreeMethodInfo BlameOptions signature where
    overloadedMethod = blameOptionsFree

#endif

-- method BlameOptions::get_maximum_line
-- method type : OrdinaryMethod
-- 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 (TBasicType TUInt32)
-- throws : False
-- Skip return : False

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

-- | Get the last line in the file to consider. The default is 1.
blameOptionsGetMaximumLine ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameOptions
    -- ^ /@blameOptions@/: a t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
    -> m Word32
    -- ^ __Returns:__ the last line to consider.
blameOptionsGetMaximumLine :: BlameOptions -> m Word32
blameOptionsGetMaximumLine BlameOptions
blameOptions = 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 BlameOptions
blameOptions' <- BlameOptions -> IO (Ptr BlameOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BlameOptions
blameOptions
    Word32
result <- Ptr BlameOptions -> IO Word32
ggit_blame_options_get_maximum_line Ptr BlameOptions
blameOptions'
    BlameOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameOptions
blameOptions
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data BlameOptionsGetMaximumLineMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo BlameOptionsGetMaximumLineMethodInfo BlameOptions signature where
    overloadedMethod = blameOptionsGetMaximumLine

#endif

-- method BlameOptions::get_minimum_line
-- method type : OrdinaryMethod
-- 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 (TBasicType TUInt32)
-- throws : False
-- Skip return : False

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

-- | Get the first line in the file to consider. The default is 1.
blameOptionsGetMinimumLine ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameOptions
    -- ^ /@blameOptions@/: a t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
    -> m Word32
    -- ^ __Returns:__ the first line to consider.
blameOptionsGetMinimumLine :: BlameOptions -> m Word32
blameOptionsGetMinimumLine BlameOptions
blameOptions = 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 BlameOptions
blameOptions' <- BlameOptions -> IO (Ptr BlameOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BlameOptions
blameOptions
    Word32
result <- Ptr BlameOptions -> IO Word32
ggit_blame_options_get_minimum_line Ptr BlameOptions
blameOptions'
    BlameOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameOptions
blameOptions
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data BlameOptionsGetMinimumLineMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo BlameOptionsGetMinimumLineMethodInfo BlameOptions signature where
    overloadedMethod = blameOptionsGetMinimumLine

#endif

-- method BlameOptions::get_minimum_match_characters
-- method type : OrdinaryMethod
-- 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 (TBasicType TUInt16)
-- throws : False
-- Skip return : False

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

-- | Get the minimum number of characters that must be detected as moving\/copying
-- within a file for it to associate those lines with a parent commit. This is
-- only used when any of the @/GGIT_BLAME_TRACK_COPIES_SAME_FILE/@ flag is
-- specified. The default value is 20.
blameOptionsGetMinimumMatchCharacters ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameOptions
    -- ^ /@blameOptions@/: a t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
    -> m Word16
    -- ^ __Returns:__ the minimum number of characters.
blameOptionsGetMinimumMatchCharacters :: BlameOptions -> m Word16
blameOptionsGetMinimumMatchCharacters BlameOptions
blameOptions = IO Word16 -> m Word16
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
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
    Word16
result <- Ptr BlameOptions -> IO Word16
ggit_blame_options_get_minimum_match_characters Ptr BlameOptions
blameOptions'
    BlameOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameOptions
blameOptions
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data BlameOptionsGetMinimumMatchCharactersMethodInfo
instance (signature ~ (m Word16), MonadIO m) => O.MethodInfo BlameOptionsGetMinimumMatchCharactersMethodInfo BlameOptions signature where
    overloadedMethod = blameOptionsGetMinimumMatchCharacters

#endif

-- method BlameOptions::get_newest_commit
-- method type : OrdinaryMethod
-- 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 = "OId" })
-- throws : False
-- Skip return : False

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

-- | Get the id of the newest commit to consider in the blame. The default
-- value of 'P.Nothing' indicates to use HEAD.
blameOptionsGetNewestCommit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameOptions
    -- ^ /@blameOptions@/: a t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ a t'GI.Ggit.Structs.OId.OId' or 'P.Nothing'.
blameOptionsGetNewestCommit :: BlameOptions -> m (Maybe OId)
blameOptionsGetNewestCommit BlameOptions
blameOptions = IO (Maybe OId) -> m (Maybe OId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe OId) -> m (Maybe OId))
-> IO (Maybe OId) -> m (Maybe OId)
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
    Ptr OId
result <- Ptr BlameOptions -> IO (Ptr OId)
ggit_blame_options_get_newest_commit Ptr BlameOptions
blameOptions'
    Maybe OId
maybeResult <- Ptr OId -> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr OId
result ((Ptr OId -> IO OId) -> IO (Maybe OId))
-> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. (a -> b) -> a -> b
$ \Ptr OId
result' -> do
        OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr OId -> OId
Ggit.OId.OId) Ptr OId
result'
        OId -> IO OId
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
    BlameOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameOptions
blameOptions
    Maybe OId -> IO (Maybe OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data BlameOptionsGetNewestCommitMethodInfo
instance (signature ~ (m (Maybe Ggit.OId.OId)), MonadIO m) => O.MethodInfo BlameOptionsGetNewestCommitMethodInfo BlameOptions signature where
    overloadedMethod = blameOptionsGetNewestCommit

#endif

-- method BlameOptions::get_oldest_commit
-- method type : OrdinaryMethod
-- 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 = "OId" })
-- throws : False
-- Skip return : False

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

-- | Get the id of the oldest commit to consider in the blame. Teh default value
-- of 'P.Nothing' indicates to used HEAD.
blameOptionsGetOldestCommit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameOptions
    -- ^ /@blameOptions@/: a t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ a t'GI.Ggit.Structs.OId.OId' or 'P.Nothing'.
blameOptionsGetOldestCommit :: BlameOptions -> m (Maybe OId)
blameOptionsGetOldestCommit BlameOptions
blameOptions = IO (Maybe OId) -> m (Maybe OId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe OId) -> m (Maybe OId))
-> IO (Maybe OId) -> m (Maybe OId)
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
    Ptr OId
result <- Ptr BlameOptions -> IO (Ptr OId)
ggit_blame_options_get_oldest_commit Ptr BlameOptions
blameOptions'
    Maybe OId
maybeResult <- Ptr OId -> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr OId
result ((Ptr OId -> IO OId) -> IO (Maybe OId))
-> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. (a -> b) -> a -> b
$ \Ptr OId
result' -> do
        OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr OId -> OId
Ggit.OId.OId) Ptr OId
result'
        OId -> IO OId
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
    BlameOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameOptions
blameOptions
    Maybe OId -> IO (Maybe OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data BlameOptionsGetOldestCommitMethodInfo
instance (signature ~ (m (Maybe Ggit.OId.OId)), MonadIO m) => O.MethodInfo BlameOptionsGetOldestCommitMethodInfo BlameOptions signature where
    overloadedMethod = blameOptionsGetOldestCommit

#endif

-- method BlameOptions::set_maximum_line
-- method type : OrdinaryMethod
-- 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 = "line"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the last line to consider."
--                 , 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_options_set_maximum_line" ggit_blame_options_set_maximum_line :: 
    Ptr BlameOptions ->                     -- blame_options : TInterface (Name {namespace = "Ggit", name = "BlameOptions"})
    Word32 ->                               -- line : TBasicType TUInt32
    IO ()

-- | Set the last line in the file to consider. Lines start at 1.
blameOptionsSetMaximumLine ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameOptions
    -- ^ /@blameOptions@/: a t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
    -> Word32
    -- ^ /@line@/: the last line to consider.
    -> m ()
blameOptionsSetMaximumLine :: BlameOptions -> Word32 -> m ()
blameOptionsSetMaximumLine BlameOptions
blameOptions Word32
line = 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
    Ptr BlameOptions -> Word32 -> IO ()
ggit_blame_options_set_maximum_line Ptr BlameOptions
blameOptions' Word32
line
    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)
data BlameOptionsSetMaximumLineMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo BlameOptionsSetMaximumLineMethodInfo BlameOptions signature where
    overloadedMethod = blameOptionsSetMaximumLine

#endif

-- method BlameOptions::set_minimum_line
-- method type : OrdinaryMethod
-- 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 = "line"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first line to consider."
--                 , 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_options_set_minimum_line" ggit_blame_options_set_minimum_line :: 
    Ptr BlameOptions ->                     -- blame_options : TInterface (Name {namespace = "Ggit", name = "BlameOptions"})
    Word32 ->                               -- line : TBasicType TUInt32
    IO ()

-- | Set the first line in the file to consider. Lines start at 1.
blameOptionsSetMinimumLine ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameOptions
    -- ^ /@blameOptions@/: a t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
    -> Word32
    -- ^ /@line@/: the first line to consider.
    -> m ()
blameOptionsSetMinimumLine :: BlameOptions -> Word32 -> m ()
blameOptionsSetMinimumLine BlameOptions
blameOptions Word32
line = 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
    Ptr BlameOptions -> Word32 -> IO ()
ggit_blame_options_set_minimum_line Ptr BlameOptions
blameOptions' Word32
line
    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)
data BlameOptionsSetMinimumLineMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo BlameOptionsSetMinimumLineMethodInfo BlameOptions signature where
    overloadedMethod = blameOptionsSetMinimumLine

#endif

-- method BlameOptions::set_minimum_match_characters
-- method type : OrdinaryMethod
-- 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 = "characters"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the minimum number of characters."
--                 , 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_options_set_minimum_match_characters" ggit_blame_options_set_minimum_match_characters :: 
    Ptr BlameOptions ->                     -- blame_options : TInterface (Name {namespace = "Ggit", name = "BlameOptions"})
    Word16 ->                               -- characters : TBasicType TUInt16
    IO ()

-- | Set the minimum number of characters that must be detected as moving\/copying
-- within a file for it to associate those lines with a parent commit. This is
-- only used when any of the @/GGIT_BLAME_TRACK_COPIES_/@ flags are specified. The
-- default value is 20.
blameOptionsSetMinimumMatchCharacters ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameOptions
    -- ^ /@blameOptions@/: a t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
    -> Word16
    -- ^ /@characters@/: the minimum number of characters.
    -> m ()
blameOptionsSetMinimumMatchCharacters :: BlameOptions -> Word16 -> m ()
blameOptionsSetMinimumMatchCharacters BlameOptions
blameOptions Word16
characters = 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
    Ptr BlameOptions -> Word16 -> IO ()
ggit_blame_options_set_minimum_match_characters Ptr BlameOptions
blameOptions' Word16
characters
    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)
data BlameOptionsSetMinimumMatchCharactersMethodInfo
instance (signature ~ (Word16 -> m ()), MonadIO m) => O.MethodInfo BlameOptionsSetMinimumMatchCharactersMethodInfo BlameOptions signature where
    overloadedMethod = blameOptionsSetMinimumMatchCharacters

#endif

-- method BlameOptions::set_newest_commit
-- method type : OrdinaryMethod
-- 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 = "oid"
--           , argType = TInterface Name { namespace = "Ggit" , name = "OId" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitOId or %NULL."
--                 , 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_options_set_newest_commit" ggit_blame_options_set_newest_commit :: 
    Ptr BlameOptions ->                     -- blame_options : TInterface (Name {namespace = "Ggit", name = "BlameOptions"})
    Ptr Ggit.OId.OId ->                     -- oid : TInterface (Name {namespace = "Ggit", name = "OId"})
    IO ()

-- | Set the id of the newest commit to consider in the blame. Specify 'P.Nothing' to
-- set the default value which indicates to use HEAD.
blameOptionsSetNewestCommit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameOptions
    -- ^ /@blameOptions@/: a t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
    -> Maybe (Ggit.OId.OId)
    -- ^ /@oid@/: a t'GI.Ggit.Structs.OId.OId' or 'P.Nothing'.
    -> m ()
blameOptionsSetNewestCommit :: BlameOptions -> Maybe OId -> m ()
blameOptionsSetNewestCommit BlameOptions
blameOptions Maybe OId
oid = 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
    Ptr OId
maybeOid <- case Maybe OId
oid of
        Maybe OId
Nothing -> Ptr OId -> IO (Ptr OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr OId
forall a. Ptr a
nullPtr
        Just OId
jOid -> do
            Ptr OId
jOid' <- OId -> IO (Ptr OId)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OId
jOid
            Ptr OId -> IO (Ptr OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr OId
jOid'
    Ptr BlameOptions -> Ptr OId -> IO ()
ggit_blame_options_set_newest_commit Ptr BlameOptions
blameOptions' Ptr OId
maybeOid
    BlameOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameOptions
blameOptions
    Maybe OId -> (OId -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe OId
oid OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BlameOptionsSetNewestCommitMethodInfo
instance (signature ~ (Maybe (Ggit.OId.OId) -> m ()), MonadIO m) => O.MethodInfo BlameOptionsSetNewestCommitMethodInfo BlameOptions signature where
    overloadedMethod = blameOptionsSetNewestCommit

#endif

-- method BlameOptions::set_oldest_commit
-- method type : OrdinaryMethod
-- 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 = "oid"
--           , argType = TInterface Name { namespace = "Ggit" , name = "OId" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitOId." , 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_options_set_oldest_commit" ggit_blame_options_set_oldest_commit :: 
    Ptr BlameOptions ->                     -- blame_options : TInterface (Name {namespace = "Ggit", name = "BlameOptions"})
    Ptr Ggit.OId.OId ->                     -- oid : TInterface (Name {namespace = "Ggit", name = "OId"})
    IO ()

-- | Set the id of the oldest commit to consider in the blame. Specify 'P.Nothing' to
-- set the default value which indicates to consider the first commit without
-- a parent.
blameOptionsSetOldestCommit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BlameOptions
    -- ^ /@blameOptions@/: a t'GI.Ggit.Structs.BlameOptions.BlameOptions'.
    -> Maybe (Ggit.OId.OId)
    -- ^ /@oid@/: a t'GI.Ggit.Structs.OId.OId'.
    -> m ()
blameOptionsSetOldestCommit :: BlameOptions -> Maybe OId -> m ()
blameOptionsSetOldestCommit BlameOptions
blameOptions Maybe OId
oid = 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
    Ptr OId
maybeOid <- case Maybe OId
oid of
        Maybe OId
Nothing -> Ptr OId -> IO (Ptr OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr OId
forall a. Ptr a
nullPtr
        Just OId
jOid -> do
            Ptr OId
jOid' <- OId -> IO (Ptr OId)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OId
jOid
            Ptr OId -> IO (Ptr OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr OId
jOid'
    Ptr BlameOptions -> Ptr OId -> IO ()
ggit_blame_options_set_oldest_commit Ptr BlameOptions
blameOptions' Ptr OId
maybeOid
    BlameOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BlameOptions
blameOptions
    Maybe OId -> (OId -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe OId
oid OId -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BlameOptionsSetOldestCommitMethodInfo
instance (signature ~ (Maybe (Ggit.OId.OId) -> m ()), MonadIO m) => O.MethodInfo BlameOptionsSetOldestCommitMethodInfo BlameOptions signature where
    overloadedMethod = blameOptionsSetOldestCommit

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveBlameOptionsMethod (t :: Symbol) (o :: *) :: * where
    ResolveBlameOptionsMethod "copy" o = BlameOptionsCopyMethodInfo
    ResolveBlameOptionsMethod "free" o = BlameOptionsFreeMethodInfo
    ResolveBlameOptionsMethod "getMaximumLine" o = BlameOptionsGetMaximumLineMethodInfo
    ResolveBlameOptionsMethod "getMinimumLine" o = BlameOptionsGetMinimumLineMethodInfo
    ResolveBlameOptionsMethod "getMinimumMatchCharacters" o = BlameOptionsGetMinimumMatchCharactersMethodInfo
    ResolveBlameOptionsMethod "getNewestCommit" o = BlameOptionsGetNewestCommitMethodInfo
    ResolveBlameOptionsMethod "getOldestCommit" o = BlameOptionsGetOldestCommitMethodInfo
    ResolveBlameOptionsMethod "setMaximumLine" o = BlameOptionsSetMaximumLineMethodInfo
    ResolveBlameOptionsMethod "setMinimumLine" o = BlameOptionsSetMinimumLineMethodInfo
    ResolveBlameOptionsMethod "setMinimumMatchCharacters" o = BlameOptionsSetMinimumMatchCharactersMethodInfo
    ResolveBlameOptionsMethod "setNewestCommit" o = BlameOptionsSetNewestCommitMethodInfo
    ResolveBlameOptionsMethod "setOldestCommit" o = BlameOptionsSetOldestCommitMethodInfo
    ResolveBlameOptionsMethod l o = O.MethodResolutionFailed l o

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

#endif