{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents the options used when creating a t'GI.Ggit.Objects.Diff.Diff'.

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

module GI.Ggit.Objects.DiffOptions
    ( 

-- * Exported types
    DiffOptions(..)                         ,
    IsDiffOptions                           ,
    toDiffOptions                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDiffOptionsMethod                ,
#endif


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    DiffOptionsGetFlagsMethodInfo           ,
#endif
    diffOptionsGetFlags                     ,


-- ** getNContextLines #method:getNContextLines#

#if defined(ENABLE_OVERLOADING)
    DiffOptionsGetNContextLinesMethodInfo   ,
#endif
    diffOptionsGetNContextLines             ,


-- ** getNInterhunkLines #method:getNInterhunkLines#

#if defined(ENABLE_OVERLOADING)
    DiffOptionsGetNInterhunkLinesMethodInfo ,
#endif
    diffOptionsGetNInterhunkLines           ,


-- ** getNewPrefix #method:getNewPrefix#

#if defined(ENABLE_OVERLOADING)
    DiffOptionsGetNewPrefixMethodInfo       ,
#endif
    diffOptionsGetNewPrefix                 ,


-- ** getOldPrefix #method:getOldPrefix#

#if defined(ENABLE_OVERLOADING)
    DiffOptionsGetOldPrefixMethodInfo       ,
#endif
    diffOptionsGetOldPrefix                 ,


-- ** getPathspec #method:getPathspec#

#if defined(ENABLE_OVERLOADING)
    DiffOptionsGetPathspecMethodInfo        ,
#endif
    diffOptionsGetPathspec                  ,


-- ** new #method:new#

    diffOptionsNew                          ,


-- ** setFlags #method:setFlags#

#if defined(ENABLE_OVERLOADING)
    DiffOptionsSetFlagsMethodInfo           ,
#endif
    diffOptionsSetFlags                     ,


-- ** setNContextLines #method:setNContextLines#

#if defined(ENABLE_OVERLOADING)
    DiffOptionsSetNContextLinesMethodInfo   ,
#endif
    diffOptionsSetNContextLines             ,


-- ** setNInterhunkLines #method:setNInterhunkLines#

#if defined(ENABLE_OVERLOADING)
    DiffOptionsSetNInterhunkLinesMethodInfo ,
#endif
    diffOptionsSetNInterhunkLines           ,


-- ** setNewPrefix #method:setNewPrefix#

#if defined(ENABLE_OVERLOADING)
    DiffOptionsSetNewPrefixMethodInfo       ,
#endif
    diffOptionsSetNewPrefix                 ,


-- ** setOldPrefix #method:setOldPrefix#

#if defined(ENABLE_OVERLOADING)
    DiffOptionsSetOldPrefixMethodInfo       ,
#endif
    diffOptionsSetOldPrefix                 ,


-- ** setPathspec #method:setPathspec#

#if defined(ENABLE_OVERLOADING)
    DiffOptionsSetPathspecMethodInfo        ,
#endif
    diffOptionsSetPathspec                  ,




 -- * Properties
-- ** flags #attr:flags#
-- | The diff option flags.

#if defined(ENABLE_OVERLOADING)
    DiffOptionsFlagsPropertyInfo            ,
#endif
    constructDiffOptionsFlags               ,
#if defined(ENABLE_OVERLOADING)
    diffOptionsFlags                        ,
#endif
    getDiffOptionsFlags                     ,
    setDiffOptionsFlags                     ,


-- ** nContextLines #attr:nContextLines#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DiffOptionsNContextLinesPropertyInfo    ,
#endif
    constructDiffOptionsNContextLines       ,
#if defined(ENABLE_OVERLOADING)
    diffOptionsNContextLines                ,
#endif
    getDiffOptionsNContextLines             ,
    setDiffOptionsNContextLines             ,


-- ** nInterhunkLines #attr:nInterhunkLines#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DiffOptionsNInterhunkLinesPropertyInfo  ,
#endif
    constructDiffOptionsNInterhunkLines     ,
#if defined(ENABLE_OVERLOADING)
    diffOptionsNInterhunkLines              ,
#endif
    getDiffOptionsNInterhunkLines           ,
    setDiffOptionsNInterhunkLines           ,


-- ** newPrefix #attr:newPrefix#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DiffOptionsNewPrefixPropertyInfo        ,
#endif
    constructDiffOptionsNewPrefix           ,
#if defined(ENABLE_OVERLOADING)
    diffOptionsNewPrefix                    ,
#endif
    getDiffOptionsNewPrefix                 ,
    setDiffOptionsNewPrefix                 ,


-- ** oldPrefix #attr:oldPrefix#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DiffOptionsOldPrefixPropertyInfo        ,
#endif
    constructDiffOptionsOldPrefix           ,
#if defined(ENABLE_OVERLOADING)
    diffOptionsOldPrefix                    ,
#endif
    getDiffOptionsOldPrefix                 ,
    setDiffOptionsOldPrefix                 ,


-- ** pathspec #attr:pathspec#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DiffOptionsPathspecPropertyInfo         ,
#endif
    clearDiffOptionsPathspec                ,
    constructDiffOptionsPathspec            ,
#if defined(ENABLE_OVERLOADING)
    diffOptionsPathspec                     ,
#endif
    getDiffOptionsPathspec                  ,
    setDiffOptionsPathspec                  ,




    ) 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

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

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

foreign import ccall "ggit_diff_options_get_type"
    c_ggit_diff_options_get_type :: IO B.Types.GType

instance B.Types.TypedObject DiffOptions where
    glibType :: IO GType
glibType = IO GType
c_ggit_diff_options_get_type

instance B.Types.GObject DiffOptions

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

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

instance O.HasParentTypes DiffOptions
type instance O.ParentTypes DiffOptions = '[GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDiffOptionsMethod (t :: Symbol) (o :: *) :: * where
    ResolveDiffOptionsMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDiffOptionsMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDiffOptionsMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDiffOptionsMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDiffOptionsMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDiffOptionsMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDiffOptionsMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDiffOptionsMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDiffOptionsMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDiffOptionsMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDiffOptionsMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDiffOptionsMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDiffOptionsMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDiffOptionsMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDiffOptionsMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDiffOptionsMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDiffOptionsMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDiffOptionsMethod "getFlags" o = DiffOptionsGetFlagsMethodInfo
    ResolveDiffOptionsMethod "getNContextLines" o = DiffOptionsGetNContextLinesMethodInfo
    ResolveDiffOptionsMethod "getNInterhunkLines" o = DiffOptionsGetNInterhunkLinesMethodInfo
    ResolveDiffOptionsMethod "getNewPrefix" o = DiffOptionsGetNewPrefixMethodInfo
    ResolveDiffOptionsMethod "getOldPrefix" o = DiffOptionsGetOldPrefixMethodInfo
    ResolveDiffOptionsMethod "getPathspec" o = DiffOptionsGetPathspecMethodInfo
    ResolveDiffOptionsMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDiffOptionsMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDiffOptionsMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDiffOptionsMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDiffOptionsMethod "setFlags" o = DiffOptionsSetFlagsMethodInfo
    ResolveDiffOptionsMethod "setNContextLines" o = DiffOptionsSetNContextLinesMethodInfo
    ResolveDiffOptionsMethod "setNInterhunkLines" o = DiffOptionsSetNInterhunkLinesMethodInfo
    ResolveDiffOptionsMethod "setNewPrefix" o = DiffOptionsSetNewPrefixMethodInfo
    ResolveDiffOptionsMethod "setOldPrefix" o = DiffOptionsSetOldPrefixMethodInfo
    ResolveDiffOptionsMethod "setPathspec" o = DiffOptionsSetPathspecMethodInfo
    ResolveDiffOptionsMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDiffOptionsMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "flags"
   -- Type: TInterface (Name {namespace = "Ggit", name = "DiffOption"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' diffOptions #flags
-- @
getDiffOptionsFlags :: (MonadIO m, IsDiffOptions o) => o -> m [Ggit.Flags.DiffOption]
getDiffOptionsFlags :: o -> m [DiffOption]
getDiffOptionsFlags o
obj = IO [DiffOption] -> m [DiffOption]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DiffOption] -> m [DiffOption])
-> IO [DiffOption] -> m [DiffOption]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [DiffOption]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"flags"

-- | Set the value of the “@flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffOptions [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffOptionsFlags :: (MonadIO m, IsDiffOptions o) => o -> [Ggit.Flags.DiffOption] -> m ()
setDiffOptionsFlags :: o -> [DiffOption] -> m ()
setDiffOptionsFlags o
obj [DiffOption]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> [DiffOption] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"flags" [DiffOption]
val

-- | Construct a `GValueConstruct` with valid value for the “@flags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDiffOptionsFlags :: (IsDiffOptions o, MIO.MonadIO m) => [Ggit.Flags.DiffOption] -> m (GValueConstruct o)
constructDiffOptionsFlags :: [DiffOption] -> m (GValueConstruct o)
constructDiffOptionsFlags [DiffOption]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [DiffOption] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"flags" [DiffOption]
val

#if defined(ENABLE_OVERLOADING)
data DiffOptionsFlagsPropertyInfo
instance AttrInfo DiffOptionsFlagsPropertyInfo where
    type AttrAllowedOps DiffOptionsFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DiffOptionsFlagsPropertyInfo = IsDiffOptions
    type AttrSetTypeConstraint DiffOptionsFlagsPropertyInfo = (~) [Ggit.Flags.DiffOption]
    type AttrTransferTypeConstraint DiffOptionsFlagsPropertyInfo = (~) [Ggit.Flags.DiffOption]
    type AttrTransferType DiffOptionsFlagsPropertyInfo = [Ggit.Flags.DiffOption]
    type AttrGetType DiffOptionsFlagsPropertyInfo = [Ggit.Flags.DiffOption]
    type AttrLabel DiffOptionsFlagsPropertyInfo = "flags"
    type AttrOrigin DiffOptionsFlagsPropertyInfo = DiffOptions
    attrGet = getDiffOptionsFlags
    attrSet = setDiffOptionsFlags
    attrTransfer _ v = do
        return v
    attrConstruct = constructDiffOptionsFlags
    attrClear = undefined
#endif

-- VVV Prop "n-context-lines"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@n-context-lines@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' diffOptions #nContextLines
-- @
getDiffOptionsNContextLines :: (MonadIO m, IsDiffOptions o) => o -> m Int32
getDiffOptionsNContextLines :: o -> m Int32
getDiffOptionsNContextLines o
obj = IO Int32 -> m Int32
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
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"n-context-lines"

-- | Set the value of the “@n-context-lines@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffOptions [ #nContextLines 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffOptionsNContextLines :: (MonadIO m, IsDiffOptions o) => o -> Int32 -> m ()
setDiffOptionsNContextLines :: o -> Int32 -> m ()
setDiffOptionsNContextLines o
obj Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"n-context-lines" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@n-context-lines@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDiffOptionsNContextLines :: (IsDiffOptions o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructDiffOptionsNContextLines :: Int32 -> m (GValueConstruct o)
constructDiffOptionsNContextLines Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"n-context-lines" Int32
val

#if defined(ENABLE_OVERLOADING)
data DiffOptionsNContextLinesPropertyInfo
instance AttrInfo DiffOptionsNContextLinesPropertyInfo where
    type AttrAllowedOps DiffOptionsNContextLinesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DiffOptionsNContextLinesPropertyInfo = IsDiffOptions
    type AttrSetTypeConstraint DiffOptionsNContextLinesPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint DiffOptionsNContextLinesPropertyInfo = (~) Int32
    type AttrTransferType DiffOptionsNContextLinesPropertyInfo = Int32
    type AttrGetType DiffOptionsNContextLinesPropertyInfo = Int32
    type AttrLabel DiffOptionsNContextLinesPropertyInfo = "n-context-lines"
    type AttrOrigin DiffOptionsNContextLinesPropertyInfo = DiffOptions
    attrGet = getDiffOptionsNContextLines
    attrSet = setDiffOptionsNContextLines
    attrTransfer _ v = do
        return v
    attrConstruct = constructDiffOptionsNContextLines
    attrClear = undefined
#endif

-- VVV Prop "n-interhunk-lines"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@n-interhunk-lines@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' diffOptions #nInterhunkLines
-- @
getDiffOptionsNInterhunkLines :: (MonadIO m, IsDiffOptions o) => o -> m Int32
getDiffOptionsNInterhunkLines :: o -> m Int32
getDiffOptionsNInterhunkLines o
obj = IO Int32 -> m Int32
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
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"n-interhunk-lines"

-- | Set the value of the “@n-interhunk-lines@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffOptions [ #nInterhunkLines 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffOptionsNInterhunkLines :: (MonadIO m, IsDiffOptions o) => o -> Int32 -> m ()
setDiffOptionsNInterhunkLines :: o -> Int32 -> m ()
setDiffOptionsNInterhunkLines o
obj Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"n-interhunk-lines" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@n-interhunk-lines@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDiffOptionsNInterhunkLines :: (IsDiffOptions o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructDiffOptionsNInterhunkLines :: Int32 -> m (GValueConstruct o)
constructDiffOptionsNInterhunkLines Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"n-interhunk-lines" Int32
val

#if defined(ENABLE_OVERLOADING)
data DiffOptionsNInterhunkLinesPropertyInfo
instance AttrInfo DiffOptionsNInterhunkLinesPropertyInfo where
    type AttrAllowedOps DiffOptionsNInterhunkLinesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DiffOptionsNInterhunkLinesPropertyInfo = IsDiffOptions
    type AttrSetTypeConstraint DiffOptionsNInterhunkLinesPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint DiffOptionsNInterhunkLinesPropertyInfo = (~) Int32
    type AttrTransferType DiffOptionsNInterhunkLinesPropertyInfo = Int32
    type AttrGetType DiffOptionsNInterhunkLinesPropertyInfo = Int32
    type AttrLabel DiffOptionsNInterhunkLinesPropertyInfo = "n-interhunk-lines"
    type AttrOrigin DiffOptionsNInterhunkLinesPropertyInfo = DiffOptions
    attrGet = getDiffOptionsNInterhunkLines
    attrSet = setDiffOptionsNInterhunkLines
    attrTransfer _ v = do
        return v
    attrConstruct = constructDiffOptionsNInterhunkLines
    attrClear = undefined
#endif

-- VVV Prop "new-prefix"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just True,Just False)

-- | Get the value of the “@new-prefix@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' diffOptions #newPrefix
-- @
getDiffOptionsNewPrefix :: (MonadIO m, IsDiffOptions o) => o -> m (Maybe T.Text)
getDiffOptionsNewPrefix :: o -> m (Maybe Text)
getDiffOptionsNewPrefix o
obj = IO (Maybe Text) -> m (Maybe Text)
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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"new-prefix"

-- | Set the value of the “@new-prefix@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffOptions [ #newPrefix 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffOptionsNewPrefix :: (MonadIO m, IsDiffOptions o) => o -> T.Text -> m ()
setDiffOptionsNewPrefix :: o -> Text -> m ()
setDiffOptionsNewPrefix o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"new-prefix" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@new-prefix@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDiffOptionsNewPrefix :: (IsDiffOptions o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDiffOptionsNewPrefix :: Text -> m (GValueConstruct o)
constructDiffOptionsNewPrefix Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"new-prefix" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DiffOptionsNewPrefixPropertyInfo
instance AttrInfo DiffOptionsNewPrefixPropertyInfo where
    type AttrAllowedOps DiffOptionsNewPrefixPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DiffOptionsNewPrefixPropertyInfo = IsDiffOptions
    type AttrSetTypeConstraint DiffOptionsNewPrefixPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DiffOptionsNewPrefixPropertyInfo = (~) T.Text
    type AttrTransferType DiffOptionsNewPrefixPropertyInfo = T.Text
    type AttrGetType DiffOptionsNewPrefixPropertyInfo = (Maybe T.Text)
    type AttrLabel DiffOptionsNewPrefixPropertyInfo = "new-prefix"
    type AttrOrigin DiffOptionsNewPrefixPropertyInfo = DiffOptions
    attrGet = getDiffOptionsNewPrefix
    attrSet = setDiffOptionsNewPrefix
    attrTransfer _ v = do
        return v
    attrConstruct = constructDiffOptionsNewPrefix
    attrClear = undefined
#endif

-- VVV Prop "old-prefix"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Just False)

-- | Get the value of the “@old-prefix@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' diffOptions #oldPrefix
-- @
getDiffOptionsOldPrefix :: (MonadIO m, IsDiffOptions o) => o -> m (Maybe T.Text)
getDiffOptionsOldPrefix :: o -> m (Maybe Text)
getDiffOptionsOldPrefix o
obj = IO (Maybe Text) -> m (Maybe Text)
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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"old-prefix"

-- | Set the value of the “@old-prefix@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffOptions [ #oldPrefix 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffOptionsOldPrefix :: (MonadIO m, IsDiffOptions o) => o -> T.Text -> m ()
setDiffOptionsOldPrefix :: o -> Text -> m ()
setDiffOptionsOldPrefix o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"old-prefix" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@old-prefix@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDiffOptionsOldPrefix :: (IsDiffOptions o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDiffOptionsOldPrefix :: Text -> m (GValueConstruct o)
constructDiffOptionsOldPrefix Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"old-prefix" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DiffOptionsOldPrefixPropertyInfo
instance AttrInfo DiffOptionsOldPrefixPropertyInfo where
    type AttrAllowedOps DiffOptionsOldPrefixPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DiffOptionsOldPrefixPropertyInfo = IsDiffOptions
    type AttrSetTypeConstraint DiffOptionsOldPrefixPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DiffOptionsOldPrefixPropertyInfo = (~) T.Text
    type AttrTransferType DiffOptionsOldPrefixPropertyInfo = T.Text
    type AttrGetType DiffOptionsOldPrefixPropertyInfo = (Maybe T.Text)
    type AttrLabel DiffOptionsOldPrefixPropertyInfo = "old-prefix"
    type AttrOrigin DiffOptionsOldPrefixPropertyInfo = DiffOptions
    attrGet = getDiffOptionsOldPrefix
    attrSet = setDiffOptionsOldPrefix
    attrTransfer _ v = do
        return v
    attrConstruct = constructDiffOptionsOldPrefix
    attrClear = undefined
#endif

-- VVV Prop "pathspec"
   -- Type: TCArray True (-1) (-1) (TBasicType TUTF8)
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@pathspec@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' diffOptions #pathspec
-- @
getDiffOptionsPathspec :: (MonadIO m, IsDiffOptions o) => o -> m (Maybe [T.Text])
getDiffOptionsPathspec :: o -> m (Maybe [Text])
getDiffOptionsPathspec o
obj = IO (Maybe [Text]) -> m (Maybe [Text])
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
$ o -> String -> IO (Maybe [Text])
forall a. GObject a => a -> String -> IO (Maybe [Text])
B.Properties.getObjectPropertyStringArray o
obj String
"pathspec"

-- | Set the value of the “@pathspec@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' diffOptions [ #pathspec 'Data.GI.Base.Attributes.:=' value ]
-- @
setDiffOptionsPathspec :: (MonadIO m, IsDiffOptions o) => o -> [T.Text] -> m ()
setDiffOptionsPathspec :: o -> [Text] -> m ()
setDiffOptionsPathspec o
obj [Text]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe [Text] -> IO ()
forall a. GObject a => a -> String -> Maybe [Text] -> IO ()
B.Properties.setObjectPropertyStringArray o
obj String
"pathspec" ([Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
val)

-- | Construct a `GValueConstruct` with valid value for the “@pathspec@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDiffOptionsPathspec :: (IsDiffOptions o, MIO.MonadIO m) => [T.Text] -> m (GValueConstruct o)
constructDiffOptionsPathspec :: [Text] -> m (GValueConstruct o)
constructDiffOptionsPathspec [Text]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe [Text] -> IO (GValueConstruct o)
forall o. String -> Maybe [Text] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyStringArray String
"pathspec" ([Text] -> Maybe [Text]
forall a. a -> Maybe a
P.Just [Text]
val)

-- | Set the value of the “@pathspec@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #pathspec
-- @
clearDiffOptionsPathspec :: (MonadIO m, IsDiffOptions o) => o -> m ()
clearDiffOptionsPathspec :: o -> m ()
clearDiffOptionsPathspec o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe [Text] -> IO ()
forall a. GObject a => a -> String -> Maybe [Text] -> IO ()
B.Properties.setObjectPropertyStringArray o
obj String
"pathspec" (Maybe [Text]
forall a. Maybe a
Nothing :: Maybe [T.Text])

#if defined(ENABLE_OVERLOADING)
data DiffOptionsPathspecPropertyInfo
instance AttrInfo DiffOptionsPathspecPropertyInfo where
    type AttrAllowedOps DiffOptionsPathspecPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DiffOptionsPathspecPropertyInfo = IsDiffOptions
    type AttrSetTypeConstraint DiffOptionsPathspecPropertyInfo = (~) [T.Text]
    type AttrTransferTypeConstraint DiffOptionsPathspecPropertyInfo = (~) [T.Text]
    type AttrTransferType DiffOptionsPathspecPropertyInfo = [T.Text]
    type AttrGetType DiffOptionsPathspecPropertyInfo = (Maybe [T.Text])
    type AttrLabel DiffOptionsPathspecPropertyInfo = "pathspec"
    type AttrOrigin DiffOptionsPathspecPropertyInfo = DiffOptions
    attrGet = getDiffOptionsPathspec
    attrSet = setDiffOptionsPathspec
    attrTransfer _ v = do
        return v
    attrConstruct = constructDiffOptionsPathspec
    attrClear = clearDiffOptionsPathspec
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DiffOptions
type instance O.AttributeList DiffOptions = DiffOptionsAttributeList
type DiffOptionsAttributeList = ('[ '("flags", DiffOptionsFlagsPropertyInfo), '("nContextLines", DiffOptionsNContextLinesPropertyInfo), '("nInterhunkLines", DiffOptionsNInterhunkLinesPropertyInfo), '("newPrefix", DiffOptionsNewPrefixPropertyInfo), '("oldPrefix", DiffOptionsOldPrefixPropertyInfo), '("pathspec", DiffOptionsPathspecPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
diffOptionsFlags :: AttrLabelProxy "flags"
diffOptionsFlags = AttrLabelProxy

diffOptionsNContextLines :: AttrLabelProxy "nContextLines"
diffOptionsNContextLines = AttrLabelProxy

diffOptionsNInterhunkLines :: AttrLabelProxy "nInterhunkLines"
diffOptionsNInterhunkLines = AttrLabelProxy

diffOptionsNewPrefix :: AttrLabelProxy "newPrefix"
diffOptionsNewPrefix = AttrLabelProxy

diffOptionsOldPrefix :: AttrLabelProxy "oldPrefix"
diffOptionsOldPrefix = AttrLabelProxy

diffOptionsPathspec :: AttrLabelProxy "pathspec"
diffOptionsPathspec = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "ggit_diff_options_new" ggit_diff_options_new :: 
    IO (Ptr DiffOptions)

-- | Create a new diff options object.
diffOptionsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m (Maybe DiffOptions)
    -- ^ __Returns:__ a t'GI.Ggit.Objects.DiffOptions.DiffOptions' or 'P.Nothing'.
diffOptionsNew :: m (Maybe DiffOptions)
diffOptionsNew  = IO (Maybe DiffOptions) -> m (Maybe DiffOptions)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DiffOptions) -> m (Maybe DiffOptions))
-> IO (Maybe DiffOptions) -> m (Maybe DiffOptions)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffOptions
result <- IO (Ptr DiffOptions)
ggit_diff_options_new
    Maybe DiffOptions
maybeResult <- Ptr DiffOptions
-> (Ptr DiffOptions -> IO DiffOptions) -> IO (Maybe DiffOptions)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DiffOptions
result ((Ptr DiffOptions -> IO DiffOptions) -> IO (Maybe DiffOptions))
-> (Ptr DiffOptions -> IO DiffOptions) -> IO (Maybe DiffOptions)
forall a b. (a -> b) -> a -> b
$ \Ptr DiffOptions
result' -> do
        DiffOptions
result'' <- ((ManagedPtr DiffOptions -> DiffOptions)
-> Ptr DiffOptions -> IO DiffOptions
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DiffOptions -> DiffOptions
DiffOptions) Ptr DiffOptions
result'
        DiffOptions -> IO DiffOptions
forall (m :: * -> *) a. Monad m => a -> m a
return DiffOptions
result''
    Maybe DiffOptions -> IO (Maybe DiffOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiffOptions
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "ggit_diff_options_get_flags" ggit_diff_options_get_flags :: 
    Ptr DiffOptions ->                      -- options : TInterface (Name {namespace = "Ggit", name = "DiffOptions"})
    IO CUInt

-- | Get the diff flags.
diffOptionsGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffOptions.DiffOptions'.
    -> m [Ggit.Flags.DiffOption]
    -- ^ __Returns:__ a t'GI.Ggit.Flags.DiffOption'.
diffOptionsGetFlags :: a -> m [DiffOption]
diffOptionsGetFlags a
options = IO [DiffOption] -> m [DiffOption]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DiffOption] -> m [DiffOption])
-> IO [DiffOption] -> m [DiffOption]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffOptions
options' <- a -> IO (Ptr DiffOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    CUInt
result <- Ptr DiffOptions -> IO CUInt
ggit_diff_options_get_flags Ptr DiffOptions
options'
    let result' :: [DiffOption]
result' = CUInt -> [DiffOption]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    [DiffOption] -> IO [DiffOption]
forall (m :: * -> *) a. Monad m => a -> m a
return [DiffOption]
result'

#if defined(ENABLE_OVERLOADING)
data DiffOptionsGetFlagsMethodInfo
instance (signature ~ (m [Ggit.Flags.DiffOption]), MonadIO m, IsDiffOptions a) => O.MethodInfo DiffOptionsGetFlagsMethodInfo a signature where
    overloadedMethod = diffOptionsGetFlags

#endif

-- method DiffOptions::get_n_context_lines
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffOptions."
--                 , 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_options_get_n_context_lines" ggit_diff_options_get_n_context_lines :: 
    Ptr DiffOptions ->                      -- options : TInterface (Name {namespace = "Ggit", name = "DiffOptions"})
    IO Int32

-- | Get the number of context lines to include in the diff.
diffOptionsGetNContextLines ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffOptions.DiffOptions'.
    -> m Int32
    -- ^ __Returns:__ the number of context lines.
diffOptionsGetNContextLines :: a -> m Int32
diffOptionsGetNContextLines a
options = IO Int32 -> m Int32
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 DiffOptions
options' <- a -> IO (Ptr DiffOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Int32
result <- Ptr DiffOptions -> IO Int32
ggit_diff_options_get_n_context_lines Ptr DiffOptions
options'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DiffOptionsGetNContextLinesMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsDiffOptions a) => O.MethodInfo DiffOptionsGetNContextLinesMethodInfo a signature where
    overloadedMethod = diffOptionsGetNContextLines

#endif

-- method DiffOptions::get_n_interhunk_lines
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffOptions."
--                 , 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_options_get_n_interhunk_lines" ggit_diff_options_get_n_interhunk_lines :: 
    Ptr DiffOptions ->                      -- options : TInterface (Name {namespace = "Ggit", name = "DiffOptions"})
    IO Int32

-- | Get the number of interhunk lines to include in the diff.
diffOptionsGetNInterhunkLines ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffOptions.DiffOptions'.
    -> m Int32
    -- ^ __Returns:__ the number of lines.
diffOptionsGetNInterhunkLines :: a -> m Int32
diffOptionsGetNInterhunkLines a
options = IO Int32 -> m Int32
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 DiffOptions
options' <- a -> IO (Ptr DiffOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Int32
result <- Ptr DiffOptions -> IO Int32
ggit_diff_options_get_n_interhunk_lines Ptr DiffOptions
options'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DiffOptionsGetNInterhunkLinesMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsDiffOptions a) => O.MethodInfo DiffOptionsGetNInterhunkLinesMethodInfo a signature where
    overloadedMethod = diffOptionsGetNInterhunkLines

#endif

-- method DiffOptions::get_new_prefix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffOptions."
--                 , 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_options_get_new_prefix" ggit_diff_options_get_new_prefix :: 
    Ptr DiffOptions ->                      -- options : TInterface (Name {namespace = "Ggit", name = "DiffOptions"})
    IO CString

-- | Get the diff new-prefix string.
diffOptionsGetNewPrefix ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffOptions.DiffOptions'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the new-prefix string or 'P.Nothing'.
diffOptionsGetNewPrefix :: a -> m (Maybe Text)
diffOptionsGetNewPrefix a
options = IO (Maybe Text) -> m (Maybe Text)
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 DiffOptions
options' <- a -> IO (Ptr DiffOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    CString
result <- Ptr DiffOptions -> IO CString
ggit_diff_options_get_new_prefix Ptr DiffOptions
options'
    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 (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiffOptionsGetNewPrefixMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsDiffOptions a) => O.MethodInfo DiffOptionsGetNewPrefixMethodInfo a signature where
    overloadedMethod = diffOptionsGetNewPrefix

#endif

-- method DiffOptions::get_old_prefix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffOptions."
--                 , 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_options_get_old_prefix" ggit_diff_options_get_old_prefix :: 
    Ptr DiffOptions ->                      -- options : TInterface (Name {namespace = "Ggit", name = "DiffOptions"})
    IO CString

-- | Get the diff old-prefix string.
diffOptionsGetOldPrefix ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffOptions.DiffOptions'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the old-prefix string or 'P.Nothing'.
diffOptionsGetOldPrefix :: a -> m (Maybe Text)
diffOptionsGetOldPrefix a
options = IO (Maybe Text) -> m (Maybe Text)
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 DiffOptions
options' <- a -> IO (Ptr DiffOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    CString
result <- Ptr DiffOptions -> IO CString
ggit_diff_options_get_old_prefix Ptr DiffOptions
options'
    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'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiffOptionsGetOldPrefixMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsDiffOptions a) => O.MethodInfo DiffOptionsGetOldPrefixMethodInfo a signature where
    overloadedMethod = diffOptionsGetOldPrefix

#endif

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

foreign import ccall "ggit_diff_options_get_pathspec" ggit_diff_options_get_pathspec :: 
    Ptr DiffOptions ->                      -- options : TInterface (Name {namespace = "Ggit", name = "DiffOptions"})
    IO (Ptr CString)

-- | Get the pathspec.
diffOptionsGetPathspec ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffOptions.DiffOptions'.
    -> m (Maybe [T.Text])
    -- ^ __Returns:__ the pathspec or 'P.Nothing'.
diffOptionsGetPathspec :: a -> m (Maybe [Text])
diffOptionsGetPathspec a
options = IO (Maybe [Text]) -> m (Maybe [Text])
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 DiffOptions
options' <- a -> IO (Ptr DiffOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr CString
result <- Ptr DiffOptions -> IO (Ptr CString)
ggit_diff_options_get_pathspec Ptr DiffOptions
options'
    Maybe [Text]
maybeResult <- Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CString
result ((Ptr CString -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr CString
result' -> do
        [Text]
result'' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result'
        [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    Maybe [Text] -> IO (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiffOptionsGetPathspecMethodInfo
instance (signature ~ (m (Maybe [T.Text])), MonadIO m, IsDiffOptions a) => O.MethodInfo DiffOptionsGetPathspecMethodInfo a signature where
    overloadedMethod = diffOptionsGetPathspec

#endif

-- method DiffOptions::set_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffOption" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffOption." , 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_options_set_flags" ggit_diff_options_set_flags :: 
    Ptr DiffOptions ->                      -- options : TInterface (Name {namespace = "Ggit", name = "DiffOptions"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Ggit", name = "DiffOption"})
    IO ()

-- | Set the diff flags.
diffOptionsSetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffOptions.DiffOptions'.
    -> [Ggit.Flags.DiffOption]
    -- ^ /@flags@/: a t'GI.Ggit.Flags.DiffOption'.
    -> m ()
diffOptionsSetFlags :: a -> [DiffOption] -> m ()
diffOptionsSetFlags a
options [DiffOption]
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 DiffOptions
options' <- a -> IO (Ptr DiffOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    let flags' :: CUInt
flags' = [DiffOption] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DiffOption]
flags
    Ptr DiffOptions -> CUInt -> IO ()
ggit_diff_options_set_flags Ptr DiffOptions
options' CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffOptionsSetFlagsMethodInfo
instance (signature ~ ([Ggit.Flags.DiffOption] -> m ()), MonadIO m, IsDiffOptions a) => O.MethodInfo DiffOptionsSetFlagsMethodInfo a signature where
    overloadedMethod = diffOptionsSetFlags

#endif

-- method DiffOptions::set_n_context_lines
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of lines."
--                 , 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_options_set_n_context_lines" ggit_diff_options_set_n_context_lines :: 
    Ptr DiffOptions ->                      -- options : TInterface (Name {namespace = "Ggit", name = "DiffOptions"})
    Int32 ->                                -- n : TBasicType TInt
    IO ()

-- | Set the number of context lines to include in the diff.
diffOptionsSetNContextLines ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffOptions.DiffOptions'.
    -> Int32
    -- ^ /@n@/: the number of lines.
    -> m ()
diffOptionsSetNContextLines :: a -> Int32 -> m ()
diffOptionsSetNContextLines a
options Int32
n = 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 DiffOptions
options' <- a -> IO (Ptr DiffOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr DiffOptions -> Int32 -> IO ()
ggit_diff_options_set_n_context_lines Ptr DiffOptions
options' Int32
n
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffOptionsSetNContextLinesMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsDiffOptions a) => O.MethodInfo DiffOptionsSetNContextLinesMethodInfo a signature where
    overloadedMethod = diffOptionsSetNContextLines

#endif

-- method DiffOptions::set_n_interhunk_lines
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of lines."
--                 , 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_options_set_n_interhunk_lines" ggit_diff_options_set_n_interhunk_lines :: 
    Ptr DiffOptions ->                      -- options : TInterface (Name {namespace = "Ggit", name = "DiffOptions"})
    Int32 ->                                -- n : TBasicType TInt
    IO ()

-- | Set the number of interhunk lines to include in the diff.
diffOptionsSetNInterhunkLines ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffOptions.DiffOptions'.
    -> Int32
    -- ^ /@n@/: the number of lines.
    -> m ()
diffOptionsSetNInterhunkLines :: a -> Int32 -> m ()
diffOptionsSetNInterhunkLines a
options Int32
n = 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 DiffOptions
options' <- a -> IO (Ptr DiffOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr DiffOptions -> Int32 -> IO ()
ggit_diff_options_set_n_interhunk_lines Ptr DiffOptions
options' Int32
n
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffOptionsSetNInterhunkLinesMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsDiffOptions a) => O.MethodInfo DiffOptionsSetNInterhunkLinesMethodInfo a signature where
    overloadedMethod = diffOptionsSetNInterhunkLines

#endif

-- method DiffOptions::set_new_prefix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prefix"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the prefix." , 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_options_set_new_prefix" ggit_diff_options_set_new_prefix :: 
    Ptr DiffOptions ->                      -- options : TInterface (Name {namespace = "Ggit", name = "DiffOptions"})
    CString ->                              -- prefix : TBasicType TUTF8
    IO ()

-- | Set the diff new-prefix string.
diffOptionsSetNewPrefix ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffOptions.DiffOptions'.
    -> T.Text
    -- ^ /@prefix@/: the prefix.
    -> m ()
diffOptionsSetNewPrefix :: a -> Text -> m ()
diffOptionsSetNewPrefix a
options Text
prefix = 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 DiffOptions
options' <- a -> IO (Ptr DiffOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    CString
prefix' <- Text -> IO CString
textToCString Text
prefix
    Ptr DiffOptions -> CString -> IO ()
ggit_diff_options_set_new_prefix Ptr DiffOptions
options' CString
prefix'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
prefix'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffOptionsSetNewPrefixMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsDiffOptions a) => O.MethodInfo DiffOptionsSetNewPrefixMethodInfo a signature where
    overloadedMethod = diffOptionsSetNewPrefix

#endif

-- method DiffOptions::set_old_prefix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prefix"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the prefix." , 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_options_set_old_prefix" ggit_diff_options_set_old_prefix :: 
    Ptr DiffOptions ->                      -- options : TInterface (Name {namespace = "Ggit", name = "DiffOptions"})
    CString ->                              -- prefix : TBasicType TUTF8
    IO ()

-- | Get the diff old-prefix string.
diffOptionsSetOldPrefix ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffOptions.DiffOptions'.
    -> T.Text
    -- ^ /@prefix@/: the prefix.
    -> m ()
diffOptionsSetOldPrefix :: a -> Text -> m ()
diffOptionsSetOldPrefix a
options Text
prefix = 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 DiffOptions
options' <- a -> IO (Ptr DiffOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    CString
prefix' <- Text -> IO CString
textToCString Text
prefix
    Ptr DiffOptions -> CString -> IO ()
ggit_diff_options_set_old_prefix Ptr DiffOptions
options' CString
prefix'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
prefix'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffOptionsSetOldPrefixMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsDiffOptions a) => O.MethodInfo DiffOptionsSetOldPrefixMethodInfo a signature where
    overloadedMethod = diffOptionsSetOldPrefix

#endif

-- method DiffOptions::set_pathspec
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pathspec"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the pathspec." , 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_options_set_pathspec" ggit_diff_options_set_pathspec :: 
    Ptr DiffOptions ->                      -- options : TInterface (Name {namespace = "Ggit", name = "DiffOptions"})
    Ptr CString ->                          -- pathspec : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO ()

-- | Set the pathspec.
diffOptionsSetPathspec ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiffOptions a) =>
    a
    -- ^ /@options@/: a t'GI.Ggit.Objects.DiffOptions.DiffOptions'.
    -> Maybe ([T.Text])
    -- ^ /@pathspec@/: the pathspec.
    -> m ()
diffOptionsSetPathspec :: a -> Maybe [Text] -> m ()
diffOptionsSetPathspec a
options Maybe [Text]
pathspec = 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 DiffOptions
options' <- a -> IO (Ptr DiffOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    Ptr CString
maybePathspec <- case Maybe [Text]
pathspec of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jPathspec -> do
            Ptr CString
jPathspec' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jPathspec
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jPathspec'
    Ptr DiffOptions -> Ptr CString -> IO ()
ggit_diff_options_set_pathspec Ptr DiffOptions
options' Ptr CString
maybePathspec
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybePathspec
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybePathspec
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DiffOptionsSetPathspecMethodInfo
instance (signature ~ (Maybe ([T.Text]) -> m ()), MonadIO m, IsDiffOptions a) => O.MethodInfo DiffOptionsSetPathspecMethodInfo a signature where
    overloadedMethod = diffOptionsSetPathspec

#endif