{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A structure available to eval callbacks giving information on evaluation
-- progress. See [Image::eval]("GI.Vips.Objects.Image#g:signal:eval").

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

module GI.Vips.Structs.Progress
    ( 

-- * Exported types
    Progress(..)                            ,
    newZeroProgress                         ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveProgressMethod                   ,
#endif

-- ** set #method:set#

    progressSet                             ,




 -- * Properties


-- ** eta #attr:eta#
-- | Estimated seconds of computation left

    getProgressEta                          ,
#if defined(ENABLE_OVERLOADING)
    progress_eta                            ,
#endif
    setProgressEta                          ,


-- ** npels #attr:npels#
-- | Number of pels calculated so far

    getProgressNpels                        ,
#if defined(ENABLE_OVERLOADING)
    progress_npels                          ,
#endif
    setProgressNpels                        ,


-- ** percent #attr:percent#
-- | Percent complete

    getProgressPercent                      ,
#if defined(ENABLE_OVERLOADING)
    progress_percent                        ,
#endif
    setProgressPercent                      ,


-- ** run #attr:run#
-- | Time we have been running

    getProgressRun                          ,
#if defined(ENABLE_OVERLOADING)
    progress_run                            ,
#endif
    setProgressRun                          ,


-- ** start #attr:start#
-- | Start time

    clearProgressStart                      ,
    getProgressStart                        ,
#if defined(ENABLE_OVERLOADING)
    progress_start                          ,
#endif
    setProgressStart                        ,


-- ** tpels #attr:tpels#
-- | Number of pels we expect to calculate

    getProgressTpels                        ,
#if defined(ENABLE_OVERLOADING)
    progress_tpels                          ,
#endif
    setProgressTpels                        ,




    ) 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.GArray as B.GArray
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.Coerce as Coerce
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 GHC.Records as R

import qualified GI.GLib.Structs.Timer as GLib.Timer

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

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

instance BoxedPtr Progress where
    boxedPtrCopy :: Progress -> IO Progress
boxedPtrCopy = \Progress
p -> Progress -> (Ptr Progress -> IO Progress) -> IO Progress
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Progress
p (Int -> Ptr Progress -> IO (Ptr Progress)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
48 (Ptr Progress -> IO (Ptr Progress))
-> (Ptr Progress -> IO Progress) -> Ptr Progress -> IO Progress
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr Progress -> Progress) -> Ptr Progress -> IO Progress
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr Progress -> Progress
Progress)
    boxedPtrFree :: Progress -> IO ()
boxedPtrFree = \Progress
x -> Progress -> (Ptr Progress -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr Progress
x Ptr Progress -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr Progress where
    boxedPtrCalloc :: IO (Ptr Progress)
boxedPtrCalloc = Int -> IO (Ptr Progress)
forall a. Int -> IO (Ptr a)
callocBytes Int
48


-- | Construct a `Progress` struct initialized to zero.
newZeroProgress :: MonadIO m => m Progress
newZeroProgress :: forall (m :: * -> *). MonadIO m => m Progress
newZeroProgress = IO Progress -> m Progress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Progress -> m Progress) -> IO Progress -> m Progress
forall a b. (a -> b) -> a -> b
$ IO (Ptr Progress)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr Progress) -> (Ptr Progress -> IO Progress) -> IO Progress
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Progress -> Progress) -> Ptr Progress -> IO Progress
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Progress -> Progress
Progress

instance tag ~ 'AttrSet => Constructible Progress tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr Progress -> Progress)
-> [AttrOp Progress tag] -> m Progress
new ManagedPtr Progress -> Progress
_ [AttrOp Progress tag]
attrs = do
        Progress
o <- m Progress
forall (m :: * -> *). MonadIO m => m Progress
newZeroProgress
        Progress -> [AttrOp Progress 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set Progress
o [AttrOp Progress tag]
[AttrOp Progress 'AttrSet]
attrs
        Progress -> m Progress
forall (m :: * -> *) a. Monad m => a -> m a
return Progress
o


-- | Get the value of the “@run@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' progress #run
-- @
getProgressRun :: MonadIO m => Progress -> m Int32
getProgressRun :: forall (m :: * -> *). MonadIO m => Progress -> m Int32
getProgressRun Progress
s = 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
$ Progress -> (Ptr Progress -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Progress
s ((Ptr Progress -> IO Int32) -> IO Int32)
-> (Ptr Progress -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Progress
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Progress
ptr Ptr Progress -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@run@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' progress [ #run 'Data.GI.Base.Attributes.:=' value ]
-- @
setProgressRun :: MonadIO m => Progress -> Int32 -> m ()
setProgressRun :: forall (m :: * -> *). MonadIO m => Progress -> Int32 -> m ()
setProgressRun Progress
s 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
$ Progress -> (Ptr Progress -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Progress
s ((Ptr Progress -> IO ()) -> IO ())
-> (Ptr Progress -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Progress
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Progress
ptr Ptr Progress -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data ProgressRunFieldInfo
instance AttrInfo ProgressRunFieldInfo where
    type AttrBaseTypeConstraint ProgressRunFieldInfo = (~) Progress
    type AttrAllowedOps ProgressRunFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ProgressRunFieldInfo = (~) Int32
    type AttrTransferTypeConstraint ProgressRunFieldInfo = (~)Int32
    type AttrTransferType ProgressRunFieldInfo = Int32
    type AttrGetType ProgressRunFieldInfo = Int32
    type AttrLabel ProgressRunFieldInfo = "run"
    type AttrOrigin ProgressRunFieldInfo = Progress
    attrGet = getProgressRun
    attrSet = setProgressRun
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Progress.run"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Progress.html#g:attr:run"
        })

progress_run :: AttrLabelProxy "run"
progress_run = AttrLabelProxy

#endif


-- | Get the value of the “@eta@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' progress #eta
-- @
getProgressEta :: MonadIO m => Progress -> m Int32
getProgressEta :: forall (m :: * -> *). MonadIO m => Progress -> m Int32
getProgressEta Progress
s = 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
$ Progress -> (Ptr Progress -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Progress
s ((Ptr Progress -> IO Int32) -> IO Int32)
-> (Ptr Progress -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Progress
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Progress
ptr Ptr Progress -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@eta@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' progress [ #eta 'Data.GI.Base.Attributes.:=' value ]
-- @
setProgressEta :: MonadIO m => Progress -> Int32 -> m ()
setProgressEta :: forall (m :: * -> *). MonadIO m => Progress -> Int32 -> m ()
setProgressEta Progress
s 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
$ Progress -> (Ptr Progress -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Progress
s ((Ptr Progress -> IO ()) -> IO ())
-> (Ptr Progress -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Progress
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Progress
ptr Ptr Progress -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data ProgressEtaFieldInfo
instance AttrInfo ProgressEtaFieldInfo where
    type AttrBaseTypeConstraint ProgressEtaFieldInfo = (~) Progress
    type AttrAllowedOps ProgressEtaFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ProgressEtaFieldInfo = (~) Int32
    type AttrTransferTypeConstraint ProgressEtaFieldInfo = (~)Int32
    type AttrTransferType ProgressEtaFieldInfo = Int32
    type AttrGetType ProgressEtaFieldInfo = Int32
    type AttrLabel ProgressEtaFieldInfo = "eta"
    type AttrOrigin ProgressEtaFieldInfo = Progress
    attrGet = getProgressEta
    attrSet = setProgressEta
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Progress.eta"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Progress.html#g:attr:eta"
        })

progress_eta :: AttrLabelProxy "eta"
progress_eta = AttrLabelProxy

#endif


-- | Get the value of the “@tpels@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' progress #tpels
-- @
getProgressTpels :: MonadIO m => Progress -> m Int64
getProgressTpels :: forall (m :: * -> *). MonadIO m => Progress -> m Int64
getProgressTpels Progress
s = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ Progress -> (Ptr Progress -> IO Int64) -> IO Int64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Progress
s ((Ptr Progress -> IO Int64) -> IO Int64)
-> (Ptr Progress -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \Ptr Progress
ptr -> do
    Int64
val <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Progress
ptr Ptr Progress -> Int -> Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO Int64
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
val

-- | Set the value of the “@tpels@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' progress [ #tpels 'Data.GI.Base.Attributes.:=' value ]
-- @
setProgressTpels :: MonadIO m => Progress -> Int64 -> m ()
setProgressTpels :: forall (m :: * -> *). MonadIO m => Progress -> Int64 -> m ()
setProgressTpels Progress
s Int64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Progress -> (Ptr Progress -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Progress
s ((Ptr Progress -> IO ()) -> IO ())
-> (Ptr Progress -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Progress
ptr -> do
    Ptr Int64 -> Int64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Progress
ptr Ptr Progress -> Int -> Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Int64
val :: Int64)

#if defined(ENABLE_OVERLOADING)
data ProgressTpelsFieldInfo
instance AttrInfo ProgressTpelsFieldInfo where
    type AttrBaseTypeConstraint ProgressTpelsFieldInfo = (~) Progress
    type AttrAllowedOps ProgressTpelsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ProgressTpelsFieldInfo = (~) Int64
    type AttrTransferTypeConstraint ProgressTpelsFieldInfo = (~)Int64
    type AttrTransferType ProgressTpelsFieldInfo = Int64
    type AttrGetType ProgressTpelsFieldInfo = Int64
    type AttrLabel ProgressTpelsFieldInfo = "tpels"
    type AttrOrigin ProgressTpelsFieldInfo = Progress
    attrGet = getProgressTpels
    attrSet = setProgressTpels
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Progress.tpels"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Progress.html#g:attr:tpels"
        })

progress_tpels :: AttrLabelProxy "tpels"
progress_tpels = AttrLabelProxy

#endif


-- | Get the value of the “@npels@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' progress #npels
-- @
getProgressNpels :: MonadIO m => Progress -> m Int64
getProgressNpels :: forall (m :: * -> *). MonadIO m => Progress -> m Int64
getProgressNpels Progress
s = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ Progress -> (Ptr Progress -> IO Int64) -> IO Int64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Progress
s ((Ptr Progress -> IO Int64) -> IO Int64)
-> (Ptr Progress -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \Ptr Progress
ptr -> do
    Int64
val <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Progress
ptr Ptr Progress -> Int -> Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO Int64
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
val

-- | Set the value of the “@npels@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' progress [ #npels 'Data.GI.Base.Attributes.:=' value ]
-- @
setProgressNpels :: MonadIO m => Progress -> Int64 -> m ()
setProgressNpels :: forall (m :: * -> *). MonadIO m => Progress -> Int64 -> m ()
setProgressNpels Progress
s Int64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Progress -> (Ptr Progress -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Progress
s ((Ptr Progress -> IO ()) -> IO ())
-> (Ptr Progress -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Progress
ptr -> do
    Ptr Int64 -> Int64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Progress
ptr Ptr Progress -> Int -> Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (Int64
val :: Int64)

#if defined(ENABLE_OVERLOADING)
data ProgressNpelsFieldInfo
instance AttrInfo ProgressNpelsFieldInfo where
    type AttrBaseTypeConstraint ProgressNpelsFieldInfo = (~) Progress
    type AttrAllowedOps ProgressNpelsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ProgressNpelsFieldInfo = (~) Int64
    type AttrTransferTypeConstraint ProgressNpelsFieldInfo = (~)Int64
    type AttrTransferType ProgressNpelsFieldInfo = Int64
    type AttrGetType ProgressNpelsFieldInfo = Int64
    type AttrLabel ProgressNpelsFieldInfo = "npels"
    type AttrOrigin ProgressNpelsFieldInfo = Progress
    attrGet = getProgressNpels
    attrSet = setProgressNpels
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Progress.npels"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Progress.html#g:attr:npels"
        })

progress_npels :: AttrLabelProxy "npels"
progress_npels = AttrLabelProxy

#endif


-- | Get the value of the “@percent@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' progress #percent
-- @
getProgressPercent :: MonadIO m => Progress -> m Int32
getProgressPercent :: forall (m :: * -> *). MonadIO m => Progress -> m Int32
getProgressPercent Progress
s = 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
$ Progress -> (Ptr Progress -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Progress
s ((Ptr Progress -> IO Int32) -> IO Int32)
-> (Ptr Progress -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr Progress
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Progress
ptr Ptr Progress -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@percent@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' progress [ #percent 'Data.GI.Base.Attributes.:=' value ]
-- @
setProgressPercent :: MonadIO m => Progress -> Int32 -> m ()
setProgressPercent :: forall (m :: * -> *). MonadIO m => Progress -> Int32 -> m ()
setProgressPercent Progress
s 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
$ Progress -> (Ptr Progress -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Progress
s ((Ptr Progress -> IO ()) -> IO ())
-> (Ptr Progress -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Progress
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Progress
ptr Ptr Progress -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data ProgressPercentFieldInfo
instance AttrInfo ProgressPercentFieldInfo where
    type AttrBaseTypeConstraint ProgressPercentFieldInfo = (~) Progress
    type AttrAllowedOps ProgressPercentFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ProgressPercentFieldInfo = (~) Int32
    type AttrTransferTypeConstraint ProgressPercentFieldInfo = (~)Int32
    type AttrTransferType ProgressPercentFieldInfo = Int32
    type AttrGetType ProgressPercentFieldInfo = Int32
    type AttrLabel ProgressPercentFieldInfo = "percent"
    type AttrOrigin ProgressPercentFieldInfo = Progress
    attrGet = getProgressPercent
    attrSet = setProgressPercent
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Progress.percent"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Progress.html#g:attr:percent"
        })

progress_percent :: AttrLabelProxy "percent"
progress_percent = AttrLabelProxy

#endif


-- | Get the value of the “@start@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' progress #start
-- @
getProgressStart :: MonadIO m => Progress -> m (Maybe GLib.Timer.Timer)
getProgressStart :: forall (m :: * -> *). MonadIO m => Progress -> m (Maybe Timer)
getProgressStart Progress
s = IO (Maybe Timer) -> m (Maybe Timer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Timer) -> m (Maybe Timer))
-> IO (Maybe Timer) -> m (Maybe Timer)
forall a b. (a -> b) -> a -> b
$ Progress -> (Ptr Progress -> IO (Maybe Timer)) -> IO (Maybe Timer)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Progress
s ((Ptr Progress -> IO (Maybe Timer)) -> IO (Maybe Timer))
-> (Ptr Progress -> IO (Maybe Timer)) -> IO (Maybe Timer)
forall a b. (a -> b) -> a -> b
$ \Ptr Progress
ptr -> do
    Ptr Timer
val <- Ptr (Ptr Timer) -> IO (Ptr Timer)
forall a. Storable a => Ptr a -> IO a
peek (Ptr Progress
ptr Ptr Progress -> Int -> Ptr (Ptr Timer)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) :: IO (Ptr GLib.Timer.Timer)
    Maybe Timer
result <- Ptr Timer -> (Ptr Timer -> IO Timer) -> IO (Maybe Timer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Timer
val ((Ptr Timer -> IO Timer) -> IO (Maybe Timer))
-> (Ptr Timer -> IO Timer) -> IO (Maybe Timer)
forall a b. (a -> b) -> a -> b
$ \Ptr Timer
val' -> do
        Timer
val'' <- ((ManagedPtr Timer -> Timer) -> Ptr Timer -> IO Timer
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Timer -> Timer
GLib.Timer.Timer) Ptr Timer
val'
        Timer -> IO Timer
forall (m :: * -> *) a. Monad m => a -> m a
return Timer
val''
    Maybe Timer -> IO (Maybe Timer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Timer
result

-- | Set the value of the “@start@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' progress [ #start 'Data.GI.Base.Attributes.:=' value ]
-- @
setProgressStart :: MonadIO m => Progress -> Ptr GLib.Timer.Timer -> m ()
setProgressStart :: forall (m :: * -> *). MonadIO m => Progress -> Ptr Timer -> m ()
setProgressStart Progress
s Ptr Timer
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Progress -> (Ptr Progress -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Progress
s ((Ptr Progress -> IO ()) -> IO ())
-> (Ptr Progress -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Progress
ptr -> do
    Ptr (Ptr Timer) -> Ptr Timer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Progress
ptr Ptr Progress -> Int -> Ptr (Ptr Timer)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (Ptr Timer
val :: Ptr GLib.Timer.Timer)

-- | Set the value of the “@start@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #start
-- @
clearProgressStart :: MonadIO m => Progress -> m ()
clearProgressStart :: forall (m :: * -> *). MonadIO m => Progress -> m ()
clearProgressStart Progress
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Progress -> (Ptr Progress -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Progress
s ((Ptr Progress -> IO ()) -> IO ())
-> (Ptr Progress -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Progress
ptr -> do
    Ptr (Ptr Timer) -> Ptr Timer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Progress
ptr Ptr Progress -> Int -> Ptr (Ptr Timer)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (Ptr Timer
forall a. Ptr a
FP.nullPtr :: Ptr GLib.Timer.Timer)

#if defined(ENABLE_OVERLOADING)
data ProgressStartFieldInfo
instance AttrInfo ProgressStartFieldInfo where
    type AttrBaseTypeConstraint ProgressStartFieldInfo = (~) Progress
    type AttrAllowedOps ProgressStartFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ProgressStartFieldInfo = (~) (Ptr GLib.Timer.Timer)
    type AttrTransferTypeConstraint ProgressStartFieldInfo = (~)(Ptr GLib.Timer.Timer)
    type AttrTransferType ProgressStartFieldInfo = (Ptr GLib.Timer.Timer)
    type AttrGetType ProgressStartFieldInfo = Maybe GLib.Timer.Timer
    type AttrLabel ProgressStartFieldInfo = "start"
    type AttrOrigin ProgressStartFieldInfo = Progress
    attrGet = getProgressStart
    attrSet = setProgressStart
    attrConstruct = undefined
    attrClear = clearProgressStart
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Structs.Progress.start"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.2/docs/GI-Vips-Structs-Progress.html#g:attr:start"
        })

progress_start :: AttrLabelProxy "start"
progress_start = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Progress
type instance O.AttributeList Progress = ProgressAttributeList
type ProgressAttributeList = ('[ '("run", ProgressRunFieldInfo), '("eta", ProgressEtaFieldInfo), '("tpels", ProgressTpelsFieldInfo), '("npels", ProgressNpelsFieldInfo), '("percent", ProgressPercentFieldInfo), '("start", ProgressStartFieldInfo)] :: [(Symbol, *)])
#endif

-- method Progress::set
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "progress"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to enable progress messages"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_progress_set" vips_progress_set :: 
    CInt ->                                 -- progress : TBasicType TBoolean
    IO ()

-- | If set, vips will print messages about the progress of computation to
-- stdout. This can also be enabled with the --vips-progress option, or by
-- setting the environment variable VIPS_PROGRESS.
progressSet ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Bool
    -- ^ /@progress@/: 'P.True' to enable progress messages
    -> m ()
progressSet :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Bool -> m ()
progressSet Bool
progress = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let progress' :: CInt
progress' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
progress
    CInt -> IO ()
vips_progress_set CInt
progress'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveProgressMethod (t :: Symbol) (o :: *) :: * where
    ResolveProgressMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveProgressMethod t Progress, O.OverloadedMethod info Progress p, R.HasField t Progress p) => R.HasField t Progress p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveProgressMethod t Progress, O.OverloadedMethodInfo info Progress) => OL.IsLabel t (O.MethodProxy info Progress) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif