{-# LANGUAGE TypeApplications #-}


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

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

module GI.Ggit.Structs.DiffBinary
    ( 

-- * Exported types
    DiffBinary(..)                          ,
    noDiffBinary                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDiffBinaryMethod                 ,
#endif


-- ** getNewFile #method:getNewFile#

#if defined(ENABLE_OVERLOADING)
    DiffBinaryGetNewFileMethodInfo          ,
#endif
    diffBinaryGetNewFile                    ,


-- ** getOldFile #method:getOldFile#

#if defined(ENABLE_OVERLOADING)
    DiffBinaryGetOldFileMethodInfo          ,
#endif
    diffBinaryGetOldFile                    ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    DiffBinaryRefMethodInfo                 ,
#endif
    diffBinaryRef                           ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    DiffBinaryUnrefMethodInfo               ,
#endif
    diffBinaryUnref                         ,




    ) 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.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 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.DiffBinaryFile as Ggit.DiffBinaryFile

-- | Memory-managed wrapper type.
newtype DiffBinary = DiffBinary (ManagedPtr DiffBinary)
    deriving (DiffBinary -> DiffBinary -> Bool
(DiffBinary -> DiffBinary -> Bool)
-> (DiffBinary -> DiffBinary -> Bool) -> Eq DiffBinary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiffBinary -> DiffBinary -> Bool
$c/= :: DiffBinary -> DiffBinary -> Bool
== :: DiffBinary -> DiffBinary -> Bool
$c== :: DiffBinary -> DiffBinary -> Bool
Eq)
foreign import ccall "ggit_diff_binary_get_type" c_ggit_diff_binary_get_type :: 
    IO GType

instance BoxedObject DiffBinary where
    boxedType :: DiffBinary -> IO GType
boxedType _ = IO GType
c_ggit_diff_binary_get_type

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

-- | A convenience alias for `Nothing` :: `Maybe` `DiffBinary`.
noDiffBinary :: Maybe DiffBinary
noDiffBinary :: Maybe DiffBinary
noDiffBinary = Maybe DiffBinary
forall a. Maybe a
Nothing


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

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

foreign import ccall "ggit_diff_binary_get_new_file" ggit_diff_binary_get_new_file :: 
    Ptr DiffBinary ->                       -- binary : TInterface (Name {namespace = "Ggit", name = "DiffBinary"})
    IO (Ptr Ggit.DiffBinaryFile.DiffBinaryFile)

-- | Gets the t'GI.Ggit.Structs.DiffBinaryFile.DiffBinaryFile' new file for /@binary@/.
diffBinaryGetNewFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffBinary
    -- ^ /@binary@/: a t'GI.Ggit.Structs.DiffBinary.DiffBinary'.
    -> m (Maybe Ggit.DiffBinaryFile.DiffBinaryFile)
    -- ^ __Returns:__ the contents of the new file or 'P.Nothing'.
diffBinaryGetNewFile :: DiffBinary -> m (Maybe DiffBinaryFile)
diffBinaryGetNewFile binary :: DiffBinary
binary = IO (Maybe DiffBinaryFile) -> m (Maybe DiffBinaryFile)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DiffBinaryFile) -> m (Maybe DiffBinaryFile))
-> IO (Maybe DiffBinaryFile) -> m (Maybe DiffBinaryFile)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffBinary
binary' <- DiffBinary -> IO (Ptr DiffBinary)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffBinary
binary
    Ptr DiffBinaryFile
result <- Ptr DiffBinary -> IO (Ptr DiffBinaryFile)
ggit_diff_binary_get_new_file Ptr DiffBinary
binary'
    Maybe DiffBinaryFile
maybeResult <- Ptr DiffBinaryFile
-> (Ptr DiffBinaryFile -> IO DiffBinaryFile)
-> IO (Maybe DiffBinaryFile)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DiffBinaryFile
result ((Ptr DiffBinaryFile -> IO DiffBinaryFile)
 -> IO (Maybe DiffBinaryFile))
-> (Ptr DiffBinaryFile -> IO DiffBinaryFile)
-> IO (Maybe DiffBinaryFile)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr DiffBinaryFile
result' -> do
        DiffBinaryFile
result'' <- ((ManagedPtr DiffBinaryFile -> DiffBinaryFile)
-> Ptr DiffBinaryFile -> IO DiffBinaryFile
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DiffBinaryFile -> DiffBinaryFile
Ggit.DiffBinaryFile.DiffBinaryFile) Ptr DiffBinaryFile
result'
        DiffBinaryFile -> IO DiffBinaryFile
forall (m :: * -> *) a. Monad m => a -> m a
return DiffBinaryFile
result''
    DiffBinary -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffBinary
binary
    Maybe DiffBinaryFile -> IO (Maybe DiffBinaryFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiffBinaryFile
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiffBinaryGetNewFileMethodInfo
instance (signature ~ (m (Maybe Ggit.DiffBinaryFile.DiffBinaryFile)), MonadIO m) => O.MethodInfo DiffBinaryGetNewFileMethodInfo DiffBinary signature where
    overloadedMethod = diffBinaryGetNewFile

#endif

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

foreign import ccall "ggit_diff_binary_get_old_file" ggit_diff_binary_get_old_file :: 
    Ptr DiffBinary ->                       -- binary : TInterface (Name {namespace = "Ggit", name = "DiffBinary"})
    IO (Ptr Ggit.DiffBinaryFile.DiffBinaryFile)

-- | Gets the t'GI.Ggit.Structs.DiffBinaryFile.DiffBinaryFile' old file for /@binary@/.
diffBinaryGetOldFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DiffBinary
    -- ^ /@binary@/: a t'GI.Ggit.Structs.DiffBinary.DiffBinary'.
    -> m (Maybe Ggit.DiffBinaryFile.DiffBinaryFile)
    -- ^ __Returns:__ the contents of the old file or 'P.Nothing'.
diffBinaryGetOldFile :: DiffBinary -> m (Maybe DiffBinaryFile)
diffBinaryGetOldFile binary :: DiffBinary
binary = IO (Maybe DiffBinaryFile) -> m (Maybe DiffBinaryFile)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DiffBinaryFile) -> m (Maybe DiffBinaryFile))
-> IO (Maybe DiffBinaryFile) -> m (Maybe DiffBinaryFile)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiffBinary
binary' <- DiffBinary -> IO (Ptr DiffBinary)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DiffBinary
binary
    Ptr DiffBinaryFile
result <- Ptr DiffBinary -> IO (Ptr DiffBinaryFile)
ggit_diff_binary_get_old_file Ptr DiffBinary
binary'
    Maybe DiffBinaryFile
maybeResult <- Ptr DiffBinaryFile
-> (Ptr DiffBinaryFile -> IO DiffBinaryFile)
-> IO (Maybe DiffBinaryFile)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DiffBinaryFile
result ((Ptr DiffBinaryFile -> IO DiffBinaryFile)
 -> IO (Maybe DiffBinaryFile))
-> (Ptr DiffBinaryFile -> IO DiffBinaryFile)
-> IO (Maybe DiffBinaryFile)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr DiffBinaryFile
result' -> do
        DiffBinaryFile
result'' <- ((ManagedPtr DiffBinaryFile -> DiffBinaryFile)
-> Ptr DiffBinaryFile -> IO DiffBinaryFile
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DiffBinaryFile -> DiffBinaryFile
Ggit.DiffBinaryFile.DiffBinaryFile) Ptr DiffBinaryFile
result'
        DiffBinaryFile -> IO DiffBinaryFile
forall (m :: * -> *) a. Monad m => a -> m a
return DiffBinaryFile
result''
    DiffBinary -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DiffBinary
binary
    Maybe DiffBinaryFile -> IO (Maybe DiffBinaryFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiffBinaryFile
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiffBinaryGetOldFileMethodInfo
instance (signature ~ (m (Maybe Ggit.DiffBinaryFile.DiffBinaryFile)), MonadIO m) => O.MethodInfo DiffBinaryGetOldFileMethodInfo DiffBinary signature where
    overloadedMethod = diffBinaryGetOldFile

#endif

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

foreign import ccall "ggit_diff_binary_ref" ggit_diff_binary_ref :: 
    Ptr DiffBinary ->                       -- binary : TInterface (Name {namespace = "Ggit", name = "DiffBinary"})
    IO (Ptr DiffBinary)

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

#if defined(ENABLE_OVERLOADING)
data DiffBinaryRefMethodInfo
instance (signature ~ (m (Maybe DiffBinary)), MonadIO m) => O.MethodInfo DiffBinaryRefMethodInfo DiffBinary signature where
    overloadedMethod = diffBinaryRef

#endif

-- method DiffBinary::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "binary"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "DiffBinary" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitDiffBinary." , 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_binary_unref" ggit_diff_binary_unref :: 
    Ptr DiffBinary ->                       -- binary : TInterface (Name {namespace = "Ggit", name = "DiffBinary"})
    IO ()

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

#if defined(ENABLE_OVERLOADING)
data DiffBinaryUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo DiffBinaryUnrefMethodInfo DiffBinary signature where
    overloadedMethod = diffBinaryUnref

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDiffBinaryMethod (t :: Symbol) (o :: *) :: * where
    ResolveDiffBinaryMethod "ref" o = DiffBinaryRefMethodInfo
    ResolveDiffBinaryMethod "unref" o = DiffBinaryUnrefMethodInfo
    ResolveDiffBinaryMethod "getNewFile" o = DiffBinaryGetNewFileMethodInfo
    ResolveDiffBinaryMethod "getOldFile" o = DiffBinaryGetOldFileMethodInfo
    ResolveDiffBinaryMethod l o = O.MethodResolutionFailed l o

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

#endif