{-# 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 getting file status.

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

module GI.Ggit.Structs.StatusOptions
    ( 

-- * Exported types
    StatusOptions(..)                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveStatusOptionsMethod              ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    StatusOptionsCopyMethodInfo             ,
#endif
    statusOptionsCopy                       ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    StatusOptionsFreeMethodInfo             ,
#endif
    statusOptionsFree                       ,


-- ** new #method:new#

    statusOptionsNew                        ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import {-# SOURCE #-} qualified GI.Ggit.Enums as Ggit.Enums
import {-# SOURCE #-} qualified GI.Ggit.Flags as Ggit.Flags

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

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

foreign import ccall "ggit_status_options_get_type" c_ggit_status_options_get_type :: 
    IO GType

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

instance B.Types.TypedObject StatusOptions where
    glibType :: IO GType
glibType = IO GType
c_ggit_status_options_get_type

instance B.Types.GBoxed StatusOptions

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


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

-- method StatusOptions::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "StatusOption" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "status options." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "show"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "StatusShow" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "status show options."
--                 , 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 "which paths to show, defaults to showing all paths."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Ggit" , name = "StatusOptions" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_status_options_new" ggit_status_options_new :: 
    CUInt ->                                -- options : TInterface (Name {namespace = "Ggit", name = "StatusOption"})
    CUInt ->                                -- show : TInterface (Name {namespace = "Ggit", name = "StatusShow"})
    Ptr CString ->                          -- pathspec : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO (Ptr StatusOptions)

-- | Creates a new t'GI.Ggit.Structs.StatusOptions.StatusOptions' for use in @/ggit_repository_stash_foreach/@.
statusOptionsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Ggit.Flags.StatusOption]
    -- ^ /@options@/: status options.
    -> Ggit.Enums.StatusShow
    -- ^ /@show@/: status show options.
    -> Maybe ([T.Text])
    -- ^ /@pathspec@/: which paths to show, defaults to showing all paths.
    -> m StatusOptions
    -- ^ __Returns:__ a newly allocated t'GI.Ggit.Structs.StatusOptions.StatusOptions'.
statusOptionsNew :: [StatusOption] -> StatusShow -> Maybe [Text] -> m StatusOptions
statusOptionsNew [StatusOption]
options StatusShow
show_ Maybe [Text]
pathspec = IO StatusOptions -> m StatusOptions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StatusOptions -> m StatusOptions)
-> IO StatusOptions -> m StatusOptions
forall a b. (a -> b) -> a -> b
$ do
    let options' :: CUInt
options' = [StatusOption] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [StatusOption]
options
    let show_' :: CUInt
show_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (StatusShow -> Int) -> StatusShow -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusShow -> Int
forall a. Enum a => a -> Int
fromEnum) StatusShow
show_
    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 StatusOptions
result <- CUInt -> CUInt -> Ptr CString -> IO (Ptr StatusOptions)
ggit_status_options_new CUInt
options' CUInt
show_' Ptr CString
maybePathspec
    Text -> Ptr StatusOptions -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"statusOptionsNew" Ptr StatusOptions
result
    StatusOptions
result' <- ((ManagedPtr StatusOptions -> StatusOptions)
-> Ptr StatusOptions -> IO StatusOptions
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr StatusOptions -> StatusOptions
StatusOptions) Ptr StatusOptions
result
    (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
    StatusOptions -> IO StatusOptions
forall (m :: * -> *) a. Monad m => a -> m a
return StatusOptions
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "ggit_status_options_copy" ggit_status_options_copy :: 
    Ptr StatusOptions ->                    -- status_options : TInterface (Name {namespace = "Ggit", name = "StatusOptions"})
    IO (Ptr StatusOptions)

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

#if defined(ENABLE_OVERLOADING)
data StatusOptionsCopyMethodInfo
instance (signature ~ (m (Maybe StatusOptions)), MonadIO m) => O.MethodInfo StatusOptionsCopyMethodInfo StatusOptions signature where
    overloadedMethod = statusOptionsCopy

#endif

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

foreign import ccall "ggit_status_options_free" ggit_status_options_free :: 
    Ptr StatusOptions ->                    -- status_options : TInterface (Name {namespace = "Ggit", name = "StatusOptions"})
    IO ()

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

#if defined(ENABLE_OVERLOADING)
data StatusOptionsFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo StatusOptionsFreeMethodInfo StatusOptions signature where
    overloadedMethod = statusOptionsFree

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveStatusOptionsMethod (t :: Symbol) (o :: *) :: * where
    ResolveStatusOptionsMethod "copy" o = StatusOptionsCopyMethodInfo
    ResolveStatusOptionsMethod "free" o = StatusOptionsFreeMethodInfo
    ResolveStatusOptionsMethod l o = O.MethodResolutionFailed l o

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

#endif