-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria

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

module GI.Poppler.Callbacks
    ( 

 -- * Signals


-- ** AttachmentSaveFunc #signal:AttachmentSaveFunc#

    AttachmentSaveFunc                      ,
    AttachmentSaveFunc_WithClosures         ,
    C_AttachmentSaveFunc                    ,
    drop_closures_AttachmentSaveFunc        ,
    dynamic_AttachmentSaveFunc              ,
    mk_AttachmentSaveFunc                   ,
    noAttachmentSaveFunc                    ,
    noAttachmentSaveFunc_WithClosures       ,


-- ** MediaSaveFunc #signal:MediaSaveFunc#

    C_MediaSaveFunc                         ,
    MediaSaveFunc                           ,
    MediaSaveFunc_WithClosures              ,
    drop_closures_MediaSaveFunc             ,
    dynamic_MediaSaveFunc                   ,
    mk_MediaSaveFunc                        ,
    noMediaSaveFunc                         ,
    noMediaSaveFunc_WithClosures            ,




    ) 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.GHashTable as B.GHT
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.Kind as DK
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


-- callback MediaSaveFunc
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just "%TRUE if successful, %FALSE (with @error set) if failed."
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "buf"
          , argType = TCArray False (-1) 1 (TBasicType TUInt8)
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "buffer containing\n  bytes to be written."
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "count"
          , argType = TBasicType TUInt64
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "number of bytes in @buf."
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just "user data passed to poppler_media_save_to_callback()"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 2
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = True
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Specifies the type of the function passed to\npoppler_media_save_to_callback().  It is called once for each block of\nbytes that is \"written\" by poppler_media_save_to_callback().  If\nsuccessful it should return %TRUE.  If an error occurs it should set\n@error and return %FALSE, in which case poppler_media_save_to_callback()\nwill fail with the same error."
        , sinceVersion = Just "0.14"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_MediaSaveFunc =
    Ptr Word8 ->
    Word64 ->
    Ptr () ->
    Ptr (Ptr GError) ->
    IO CInt

-- Args: [ Arg
--           { argCName = "buf"
--           , argType = TCArray False (-1) 1 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "buffer containing\n  bytes to be written."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "count"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bytes in @buf."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "user data passed to poppler_media_save_to_callback()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "count"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of bytes in @buf."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_MediaSaveFunc :: FunPtr C_MediaSaveFunc -> C_MediaSaveFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_MediaSaveFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_MediaSaveFunc
    -> ByteString
    -- ^ /@buf@/: buffer containing
    --   bytes to be written.
    -> Ptr ()
    -- ^ /@data@/: user data passed to 'GI.Poppler.Objects.Media.mediaSaveToCallback'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
dynamic_MediaSaveFunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_MediaSaveFunc -> ByteString -> Ptr () -> m ()
dynamic_MediaSaveFunc FunPtr C_MediaSaveFunc
__funPtr ByteString
buf Ptr ()
data_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let count :: Word64
count = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
buf
    Ptr Word8
buf' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
buf
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ (FunPtr C_MediaSaveFunc -> C_MediaSaveFunc
__dynamic_C_MediaSaveFunc FunPtr C_MediaSaveFunc
__funPtr) Ptr Word8
buf' Word64
count Ptr ()
data_
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
buf'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
buf'
     )

-- | Generate a function pointer callable from C code, from a `C_MediaSaveFunc`.
foreign import ccall "wrapper"
    mk_MediaSaveFunc :: C_MediaSaveFunc -> IO (FunPtr C_MediaSaveFunc)

-- | Specifies the type of the function passed to
-- 'GI.Poppler.Objects.Media.mediaSaveToCallback'.  It is called once for each block of
-- bytes that is \"written\" by 'GI.Poppler.Objects.Media.mediaSaveToCallback'.  If
-- successful it should return 'P.True'.  If an error occurs it should set
-- /@error@/ and return 'P.False', in which case 'GI.Poppler.Objects.Media.mediaSaveToCallback'
-- will fail with the same error.
-- 
-- /Since: 0.14/
type MediaSaveFunc =
    ByteString
    -- ^ /@buf@/: buffer containing
    --   bytes to be written.
    -> IO ()
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' (with /@error@/ set) if failed. /(Can throw 'Data.GI.Base.GError.GError')/

-- | A convenience synonym for @`Nothing` :: `Maybe` `MediaSaveFunc`@.
noMediaSaveFunc :: Maybe MediaSaveFunc
noMediaSaveFunc :: Maybe MediaSaveFunc
noMediaSaveFunc = Maybe MediaSaveFunc
forall a. Maybe a
Nothing

-- | Specifies the type of the function passed to
-- 'GI.Poppler.Objects.Media.mediaSaveToCallback'.  It is called once for each block of
-- bytes that is \"written\" by 'GI.Poppler.Objects.Media.mediaSaveToCallback'.  If
-- successful it should return 'P.True'.  If an error occurs it should set
-- /@error@/ and return 'P.False', in which case 'GI.Poppler.Objects.Media.mediaSaveToCallback'
-- will fail with the same error.
-- 
-- /Since: 0.14/
type MediaSaveFunc_WithClosures =
    ByteString
    -- ^ /@buf@/: buffer containing
    --   bytes to be written.
    -> Ptr ()
    -- ^ /@data@/: user data passed to 'GI.Poppler.Objects.Media.mediaSaveToCallback'
    -> IO ()
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' (with /@error@/ set) if failed. /(Can throw 'Data.GI.Base.GError.GError')/

-- | A convenience synonym for @`Nothing` :: `Maybe` `MediaSaveFunc_WithClosures`@.
noMediaSaveFunc_WithClosures :: Maybe MediaSaveFunc_WithClosures
noMediaSaveFunc_WithClosures :: Maybe MediaSaveFunc_WithClosures
noMediaSaveFunc_WithClosures = Maybe MediaSaveFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_MediaSaveFunc :: MediaSaveFunc -> MediaSaveFunc_WithClosures
drop_closures_MediaSaveFunc :: MediaSaveFunc -> MediaSaveFunc_WithClosures
drop_closures_MediaSaveFunc MediaSaveFunc
_f ByteString
buf Ptr ()
_ = MediaSaveFunc
_f ByteString
buf

-- No Haskell->C wrapper generated since the function throws.

-- callback AttachmentSaveFunc
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just "%TRUE if successful, %FALSE (with @error set) if failed."
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "buf"
          , argType = TCArray False (-1) 1 (TBasicType TUInt8)
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "buffer containing\n  bytes to be written."
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "count"
          , argType = TBasicType TUInt64
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "number of bytes in @buf."
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just "user data passed to poppler_attachment_save_to_callback()"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 2
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = True
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Specifies the type of the function passed to\npoppler_attachment_save_to_callback().  It is called once for each block of\nbytes that is \"written\" by poppler_attachment_save_to_callback().  If\nsuccessful it should return %TRUE.  If an error occurs it should set\n@error and return %FALSE, in which case poppler_attachment_save_to_callback()\nwill fail with the same error."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_AttachmentSaveFunc =
    Ptr Word8 ->
    Word64 ->
    Ptr () ->
    Ptr (Ptr GError) ->
    IO CInt

-- Args: [ Arg
--           { argCName = "buf"
--           , argType = TCArray False (-1) 1 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "buffer containing\n  bytes to be written."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "count"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bytes in @buf."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "user data passed to poppler_attachment_save_to_callback()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "count"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of bytes in @buf."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_AttachmentSaveFunc :: FunPtr C_AttachmentSaveFunc -> C_AttachmentSaveFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_AttachmentSaveFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_AttachmentSaveFunc
    -> ByteString
    -- ^ /@buf@/: buffer containing
    --   bytes to be written.
    -> Ptr ()
    -- ^ /@data@/: user data passed to 'GI.Poppler.Objects.Attachment.attachmentSaveToCallback'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
dynamic_AttachmentSaveFunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_MediaSaveFunc -> ByteString -> Ptr () -> m ()
dynamic_AttachmentSaveFunc FunPtr C_MediaSaveFunc
__funPtr ByteString
buf Ptr ()
data_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let count :: Word64
count = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
buf
    Ptr Word8
buf' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
buf
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ (FunPtr C_MediaSaveFunc -> C_MediaSaveFunc
__dynamic_C_AttachmentSaveFunc FunPtr C_MediaSaveFunc
__funPtr) Ptr Word8
buf' Word64
count Ptr ()
data_
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
buf'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
buf'
     )

-- | Generate a function pointer callable from C code, from a `C_AttachmentSaveFunc`.
foreign import ccall "wrapper"
    mk_AttachmentSaveFunc :: C_AttachmentSaveFunc -> IO (FunPtr C_AttachmentSaveFunc)

-- | Specifies the type of the function passed to
-- 'GI.Poppler.Objects.Attachment.attachmentSaveToCallback'.  It is called once for each block of
-- bytes that is \"written\" by 'GI.Poppler.Objects.Attachment.attachmentSaveToCallback'.  If
-- successful it should return 'P.True'.  If an error occurs it should set
-- /@error@/ and return 'P.False', in which case 'GI.Poppler.Objects.Attachment.attachmentSaveToCallback'
-- will fail with the same error.
type AttachmentSaveFunc =
    ByteString
    -- ^ /@buf@/: buffer containing
    --   bytes to be written.
    -> IO ()
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' (with /@error@/ set) if failed. /(Can throw 'Data.GI.Base.GError.GError')/

-- | A convenience synonym for @`Nothing` :: `Maybe` `AttachmentSaveFunc`@.
noAttachmentSaveFunc :: Maybe AttachmentSaveFunc
noAttachmentSaveFunc :: Maybe MediaSaveFunc
noAttachmentSaveFunc = Maybe MediaSaveFunc
forall a. Maybe a
Nothing

-- | Specifies the type of the function passed to
-- 'GI.Poppler.Objects.Attachment.attachmentSaveToCallback'.  It is called once for each block of
-- bytes that is \"written\" by 'GI.Poppler.Objects.Attachment.attachmentSaveToCallback'.  If
-- successful it should return 'P.True'.  If an error occurs it should set
-- /@error@/ and return 'P.False', in which case 'GI.Poppler.Objects.Attachment.attachmentSaveToCallback'
-- will fail with the same error.
type AttachmentSaveFunc_WithClosures =
    ByteString
    -- ^ /@buf@/: buffer containing
    --   bytes to be written.
    -> Ptr ()
    -- ^ /@data@/: user data passed to 'GI.Poppler.Objects.Attachment.attachmentSaveToCallback'
    -> IO ()
    -- ^ __Returns:__ 'P.True' if successful, 'P.False' (with /@error@/ set) if failed. /(Can throw 'Data.GI.Base.GError.GError')/

-- | A convenience synonym for @`Nothing` :: `Maybe` `AttachmentSaveFunc_WithClosures`@.
noAttachmentSaveFunc_WithClosures :: Maybe AttachmentSaveFunc_WithClosures
noAttachmentSaveFunc_WithClosures :: Maybe MediaSaveFunc_WithClosures
noAttachmentSaveFunc_WithClosures = Maybe MediaSaveFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_AttachmentSaveFunc :: AttachmentSaveFunc -> AttachmentSaveFunc_WithClosures
drop_closures_AttachmentSaveFunc :: MediaSaveFunc -> MediaSaveFunc_WithClosures
drop_closures_AttachmentSaveFunc MediaSaveFunc
_f ByteString
buf Ptr ()
_ = MediaSaveFunc
_f ByteString
buf

-- No Haskell->C wrapper generated since the function throws.