{-# 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 reverting.

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

module GI.Ggit.Structs.RevertOptions
    ( 

-- * Exported types
    RevertOptions(..)                       ,
    noRevertOptions                         ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveRevertOptionsMethod              ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    RevertOptionsCopyMethodInfo             ,
#endif
    revertOptionsCopy                       ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    RevertOptionsFreeMethodInfo             ,
#endif
    revertOptionsFree                       ,


-- ** new #method:new#

    revertOptionsNew                        ,




    ) 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.Objects.CheckoutOptions as Ggit.CheckoutOptions
import {-# SOURCE #-} qualified GI.Ggit.Structs.MergeOptions as Ggit.MergeOptions

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

instance BoxedObject RevertOptions where
    boxedType :: RevertOptions -> IO GType
boxedType _ = IO GType
c_ggit_revert_options_get_type

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

-- | A convenience alias for `Nothing` :: `Maybe` `RevertOptions`.
noRevertOptions :: Maybe RevertOptions
noRevertOptions :: Maybe RevertOptions
noRevertOptions = Maybe RevertOptions
forall a. Maybe a
Nothing


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

-- method RevertOptions::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "mainline"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mainline." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "merge_options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "MergeOptions" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitMergeOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checkout_options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "CheckoutOptions" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitCheckoutOptions."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Ggit" , name = "RevertOptions" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_revert_options_new" ggit_revert_options_new :: 
    Word32 ->                               -- mainline : TBasicType TUInt
    Ptr Ggit.MergeOptions.MergeOptions ->   -- merge_options : TInterface (Name {namespace = "Ggit", name = "MergeOptions"})
    Ptr Ggit.CheckoutOptions.CheckoutOptions -> -- checkout_options : TInterface (Name {namespace = "Ggit", name = "CheckoutOptions"})
    IO (Ptr RevertOptions)

-- | Create a new t'GI.Ggit.Structs.RevertOptions.RevertOptions'. Note that the passed in /@mergeOptions@/ and
-- /@checkoutOptions@/ are copied by this function, and alterations in either
-- after this call are therefore not reflected in the revert options.
-- 
-- The /@mainline@/ indicates which parent to use for the revert when reverting
-- a merge commit.
revertOptionsNew ::
    (B.CallStack.HasCallStack, MonadIO m, Ggit.CheckoutOptions.IsCheckoutOptions a) =>
    Word32
    -- ^ /@mainline@/: the mainline.
    -> Maybe (Ggit.MergeOptions.MergeOptions)
    -- ^ /@mergeOptions@/: a t'GI.Ggit.Structs.MergeOptions.MergeOptions'.
    -> Maybe (a)
    -- ^ /@checkoutOptions@/: a t'GI.Ggit.Objects.CheckoutOptions.CheckoutOptions'.
    -> m (Maybe RevertOptions)
    -- ^ __Returns:__ a t'GI.Ggit.Structs.RevertOptions.RevertOptions' or 'P.Nothing'.
revertOptionsNew :: Word32 -> Maybe MergeOptions -> Maybe a -> m (Maybe RevertOptions)
revertOptionsNew mainline :: Word32
mainline mergeOptions :: Maybe MergeOptions
mergeOptions checkoutOptions :: Maybe a
checkoutOptions = IO (Maybe RevertOptions) -> m (Maybe RevertOptions)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe RevertOptions) -> m (Maybe RevertOptions))
-> IO (Maybe RevertOptions) -> m (Maybe RevertOptions)
forall a b. (a -> b) -> a -> b
$ do
    Ptr MergeOptions
maybeMergeOptions <- case Maybe MergeOptions
mergeOptions of
        Nothing -> Ptr MergeOptions -> IO (Ptr MergeOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MergeOptions
forall a. Ptr a
nullPtr
        Just jMergeOptions :: MergeOptions
jMergeOptions -> do
            Ptr MergeOptions
jMergeOptions' <- MergeOptions -> IO (Ptr MergeOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MergeOptions
jMergeOptions
            Ptr MergeOptions -> IO (Ptr MergeOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MergeOptions
jMergeOptions'
    Ptr CheckoutOptions
maybeCheckoutOptions <- case Maybe a
checkoutOptions of
        Nothing -> Ptr CheckoutOptions -> IO (Ptr CheckoutOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CheckoutOptions
forall a. Ptr a
nullPtr
        Just jCheckoutOptions :: a
jCheckoutOptions -> do
            Ptr CheckoutOptions
jCheckoutOptions' <- a -> IO (Ptr CheckoutOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCheckoutOptions
            Ptr CheckoutOptions -> IO (Ptr CheckoutOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CheckoutOptions
jCheckoutOptions'
    Ptr RevertOptions
result <- Word32
-> Ptr MergeOptions
-> Ptr CheckoutOptions
-> IO (Ptr RevertOptions)
ggit_revert_options_new Word32
mainline Ptr MergeOptions
maybeMergeOptions Ptr CheckoutOptions
maybeCheckoutOptions
    Maybe RevertOptions
maybeResult <- Ptr RevertOptions
-> (Ptr RevertOptions -> IO RevertOptions)
-> IO (Maybe RevertOptions)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr RevertOptions
result ((Ptr RevertOptions -> IO RevertOptions)
 -> IO (Maybe RevertOptions))
-> (Ptr RevertOptions -> IO RevertOptions)
-> IO (Maybe RevertOptions)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr RevertOptions
result' -> do
        RevertOptions
result'' <- ((ManagedPtr RevertOptions -> RevertOptions)
-> Ptr RevertOptions -> IO RevertOptions
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr RevertOptions -> RevertOptions
RevertOptions) Ptr RevertOptions
result'
        RevertOptions -> IO RevertOptions
forall (m :: * -> *) a. Monad m => a -> m a
return RevertOptions
result''
    Maybe MergeOptions -> (MergeOptions -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe MergeOptions
mergeOptions MergeOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
checkoutOptions a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe RevertOptions -> IO (Maybe RevertOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RevertOptions
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "ggit_revert_options_copy" ggit_revert_options_copy :: 
    Ptr RevertOptions ->                    -- revert_options : TInterface (Name {namespace = "Ggit", name = "RevertOptions"})
    IO (Ptr RevertOptions)

-- | Copies /@revertOptions@/ into a newly allocated t'GI.Ggit.Structs.RevertOptions.RevertOptions'.
revertOptionsCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RevertOptions
    -- ^ /@revertOptions@/: a t'GI.Ggit.Structs.RevertOptions.RevertOptions'.
    -> m (Maybe RevertOptions)
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Structs.RevertOptions.RevertOptions' or 'P.Nothing'.
revertOptionsCopy :: RevertOptions -> m (Maybe RevertOptions)
revertOptionsCopy revertOptions :: RevertOptions
revertOptions = IO (Maybe RevertOptions) -> m (Maybe RevertOptions)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe RevertOptions) -> m (Maybe RevertOptions))
-> IO (Maybe RevertOptions) -> m (Maybe RevertOptions)
forall a b. (a -> b) -> a -> b
$ do
    Ptr RevertOptions
revertOptions' <- RevertOptions -> IO (Ptr RevertOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RevertOptions
revertOptions
    Ptr RevertOptions
result <- Ptr RevertOptions -> IO (Ptr RevertOptions)
ggit_revert_options_copy Ptr RevertOptions
revertOptions'
    Maybe RevertOptions
maybeResult <- Ptr RevertOptions
-> (Ptr RevertOptions -> IO RevertOptions)
-> IO (Maybe RevertOptions)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr RevertOptions
result ((Ptr RevertOptions -> IO RevertOptions)
 -> IO (Maybe RevertOptions))
-> (Ptr RevertOptions -> IO RevertOptions)
-> IO (Maybe RevertOptions)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr RevertOptions
result' -> do
        RevertOptions
result'' <- ((ManagedPtr RevertOptions -> RevertOptions)
-> Ptr RevertOptions -> IO RevertOptions
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr RevertOptions -> RevertOptions
RevertOptions) Ptr RevertOptions
result'
        RevertOptions -> IO RevertOptions
forall (m :: * -> *) a. Monad m => a -> m a
return RevertOptions
result''
    RevertOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RevertOptions
revertOptions
    Maybe RevertOptions -> IO (Maybe RevertOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RevertOptions
maybeResult

#if defined(ENABLE_OVERLOADING)
data RevertOptionsCopyMethodInfo
instance (signature ~ (m (Maybe RevertOptions)), MonadIO m) => O.MethodInfo RevertOptionsCopyMethodInfo RevertOptions signature where
    overloadedMethod = revertOptionsCopy

#endif

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

foreign import ccall "ggit_revert_options_free" ggit_revert_options_free :: 
    Ptr RevertOptions ->                    -- revert_options : TInterface (Name {namespace = "Ggit", name = "RevertOptions"})
    IO ()

-- | Frees /@revertOptions@/.
revertOptionsFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    RevertOptions
    -- ^ /@revertOptions@/: a t'GI.Ggit.Structs.RevertOptions.RevertOptions'.
    -> m ()
revertOptionsFree :: RevertOptions -> m ()
revertOptionsFree revertOptions :: RevertOptions
revertOptions = 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 RevertOptions
revertOptions' <- RevertOptions -> IO (Ptr RevertOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RevertOptions
revertOptions
    Ptr RevertOptions -> IO ()
ggit_revert_options_free Ptr RevertOptions
revertOptions'
    RevertOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RevertOptions
revertOptions
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RevertOptionsFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo RevertOptionsFreeMethodInfo RevertOptions signature where
    overloadedMethod = revertOptionsFree

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveRevertOptionsMethod (t :: Symbol) (o :: *) :: * where
    ResolveRevertOptionsMethod "copy" o = RevertOptionsCopyMethodInfo
    ResolveRevertOptionsMethod "free" o = RevertOptionsFreeMethodInfo
    ResolveRevertOptionsMethod l o = O.MethodResolutionFailed l o

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

#endif