{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Vips.Objects.Foreign
    ( 
#if defined(ENABLE_OVERLOADING)
    ForeignGetSuffixesMethodInfo            ,
#endif

-- * Exported types
    Foreign(..)                             ,
    IsForeign                               ,
    toForeign                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [argumentIsset]("GI.Vips.Objects.Object#g:method:argumentIsset"), [argumentNeedsstring]("GI.Vips.Objects.Object#g:method:argumentNeedsstring"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [build]("GI.Vips.Objects.Object#g:method:build"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [invalidate]("GI.Vips.Objects.Operation#g:method:invalidate"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [localCb]("GI.Vips.Objects.Object#g:method:localCb"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [preclose]("GI.Vips.Objects.Object#g:method:preclose"), [printDump]("GI.Vips.Objects.Object#g:method:printDump"), [printName]("GI.Vips.Objects.Object#g:method:printName"), [printSummary]("GI.Vips.Objects.Object#g:method:printSummary"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [rewind]("GI.Vips.Objects.Object#g:method:rewind"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [sanity]("GI.Vips.Objects.Object#g:method:sanity"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [toString]("GI.Vips.Objects.Object#g:method:toString"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [unrefOutputs]("GI.Vips.Objects.Object#g:method:unrefOutputs"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getArgumentFlags]("GI.Vips.Objects.Object#g:method:getArgumentFlags"), [getArgumentPriority]("GI.Vips.Objects.Object#g:method:getArgumentPriority"), [getArgumentToString]("GI.Vips.Objects.Object#g:method:getArgumentToString"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDescription]("GI.Vips.Objects.Object#g:method:getDescription"), [getFlags]("GI.Vips.Objects.Operation#g:method:getFlags"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setArgumentFromString]("GI.Vips.Objects.Object#g:method:setArgumentFromString"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFromString]("GI.Vips.Objects.Object#g:method:setFromString"), [setRequired]("GI.Vips.Objects.Object#g:method:setRequired"), [setStatic]("GI.Vips.Objects.Object#g:method:setStatic").

#if defined(ENABLE_OVERLOADING)
    ResolveForeignMethod                    ,
#endif

-- ** findLoad #method:findLoad#

    foreignFindLoad                         ,


-- ** findLoadBuffer #method:findLoadBuffer#

    foreignFindLoadBuffer                   ,


-- ** findLoadSource #method:findLoadSource#

    foreignFindLoadSource                   ,


-- ** findSave #method:findSave#

    foreignFindSave                         ,


-- ** findSaveBuffer #method:findSaveBuffer#

    foreignFindSaveBuffer                   ,


-- ** findSaveTarget #method:findSaveTarget#

    foreignFindSaveTarget                   ,


-- ** isA #method:isA#

    foreignIsA                              ,


-- ** isABuffer #method:isABuffer#

    foreignIsABuffer                        ,


-- ** isASource #method:isASource#

    foreignIsASource                        ,


-- ** map #method:map#

    foreignMap                              ,




    ) 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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Vips.Callbacks as Vips.Callbacks
import {-# SOURCE #-} qualified GI.Vips.Objects.Object as Vips.Object
import {-# SOURCE #-} qualified GI.Vips.Objects.Operation as Vips.Operation
import {-# SOURCE #-} qualified GI.Vips.Structs.Source as Vips.Source

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

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

foreign import ccall "vips_foreign_get_type"
    c_vips_foreign_get_type :: IO B.Types.GType

instance B.Types.TypedObject Foreign where
    glibType :: IO GType
glibType = IO GType
c_vips_foreign_get_type

instance B.Types.GObject Foreign

-- | Type class for types which can be safely cast to `Foreign`, for instance with `toForeign`.
class (SP.GObject o, O.IsDescendantOf Foreign o) => IsForeign o
instance (SP.GObject o, O.IsDescendantOf Foreign o) => IsForeign o

instance O.HasParentTypes Foreign
type instance O.ParentTypes Foreign = '[Vips.Operation.Operation, Vips.Object.Object, GObject.Object.Object]

-- | Cast to `Foreign`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toForeign :: (MIO.MonadIO m, IsForeign o) => o -> m Foreign
toForeign :: forall (m :: * -> *) o. (MonadIO m, IsForeign o) => o -> m Foreign
toForeign = IO Foreign -> m Foreign
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Foreign -> m Foreign) -> (o -> IO Foreign) -> o -> m Foreign
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Foreign -> Foreign) -> o -> IO Foreign
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Foreign -> Foreign
Foreign

-- | Convert 'Foreign' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Foreign) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_vips_foreign_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Foreign -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Foreign
P.Nothing = Ptr GValue -> Ptr Foreign -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Foreign
forall a. Ptr a
FP.nullPtr :: FP.Ptr Foreign)
    gvalueSet_ Ptr GValue
gv (P.Just Foreign
obj) = Foreign -> (Ptr Foreign -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Foreign
obj (Ptr GValue -> Ptr Foreign -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Foreign)
gvalueGet_ Ptr GValue
gv = do
        Ptr Foreign
ptr <- Ptr GValue -> IO (Ptr Foreign)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Foreign)
        if Ptr Foreign
ptr Ptr Foreign -> Ptr Foreign -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Foreign
forall a. Ptr a
FP.nullPtr
        then Foreign -> Maybe Foreign
forall a. a -> Maybe a
P.Just (Foreign -> Maybe Foreign) -> IO Foreign -> IO (Maybe Foreign)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Foreign -> Foreign) -> Ptr Foreign -> IO Foreign
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Foreign -> Foreign
Foreign Ptr Foreign
ptr
        else Maybe Foreign -> IO (Maybe Foreign)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Foreign
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveForeignMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveForeignMethod "argumentIsset" o = Vips.Object.ObjectArgumentIssetMethodInfo
    ResolveForeignMethod "argumentNeedsstring" o = Vips.Object.ObjectArgumentNeedsstringMethodInfo
    ResolveForeignMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveForeignMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveForeignMethod "build" o = Vips.Object.ObjectBuildMethodInfo
    ResolveForeignMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveForeignMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveForeignMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveForeignMethod "invalidate" o = Vips.Operation.OperationInvalidateMethodInfo
    ResolveForeignMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveForeignMethod "localCb" o = Vips.Object.ObjectLocalCbMethodInfo
    ResolveForeignMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveForeignMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveForeignMethod "preclose" o = Vips.Object.ObjectPrecloseMethodInfo
    ResolveForeignMethod "printDump" o = Vips.Object.ObjectPrintDumpMethodInfo
    ResolveForeignMethod "printName" o = Vips.Object.ObjectPrintNameMethodInfo
    ResolveForeignMethod "printSummary" o = Vips.Object.ObjectPrintSummaryMethodInfo
    ResolveForeignMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveForeignMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveForeignMethod "rewind" o = Vips.Object.ObjectRewindMethodInfo
    ResolveForeignMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveForeignMethod "sanity" o = Vips.Object.ObjectSanityMethodInfo
    ResolveForeignMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveForeignMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveForeignMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveForeignMethod "toString" o = Vips.Object.ObjectToStringMethodInfo
    ResolveForeignMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveForeignMethod "unrefOutputs" o = Vips.Object.ObjectUnrefOutputsMethodInfo
    ResolveForeignMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveForeignMethod "getArgumentFlags" o = Vips.Object.ObjectGetArgumentFlagsMethodInfo
    ResolveForeignMethod "getArgumentPriority" o = Vips.Object.ObjectGetArgumentPriorityMethodInfo
    ResolveForeignMethod "getArgumentToString" o = Vips.Object.ObjectGetArgumentToStringMethodInfo
    ResolveForeignMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveForeignMethod "getDescription" o = Vips.Object.ObjectGetDescriptionMethodInfo
    ResolveForeignMethod "getFlags" o = Vips.Operation.OperationGetFlagsMethodInfo
    ResolveForeignMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveForeignMethod "setArgumentFromString" o = Vips.Object.ObjectSetArgumentFromStringMethodInfo
    ResolveForeignMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveForeignMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveForeignMethod "setFromString" o = Vips.Object.ObjectSetFromStringMethodInfo
    ResolveForeignMethod "setRequired" o = Vips.Object.ObjectSetRequiredMethodInfo
    ResolveForeignMethod "setStatic" o = Vips.Object.ObjectSetStaticMethodInfo
    ResolveForeignMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveForeignMethod t Foreign, O.OverloadedMethod info Foreign p) => OL.IsLabel t (Foreign -> 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 ~ ResolveForeignMethod t Foreign, O.OverloadedMethod info Foreign p, R.HasField t Foreign p) => R.HasField t Foreign p where
    getField = O.overloadedMethod @info

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Foreign
type instance O.AttributeList Foreign = ForeignAttributeList
type ForeignAttributeList = ('[ '("description", Vips.Object.ObjectDescriptionPropertyInfo), '("nickname", Vips.Object.ObjectNicknamePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Foreign = ForeignSignalList
type ForeignSignalList = ('[ '("close", Vips.Object.ObjectCloseSignalInfo), '("invalidate", Vips.Operation.OperationInvalidateSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("postbuild", Vips.Object.ObjectPostbuildSignalInfo), '("postclose", Vips.Object.ObjectPostcloseSignalInfo), '("preclose", Vips.Object.ObjectPrecloseSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Foreign::find_load
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "file to find a loader for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "vips_foreign_find_load" vips_foreign_find_load :: 
    CString ->                              -- filename : TBasicType TUTF8
    IO CString

-- | Searches for an operation you could use to load /@filename@/. Any trailing
-- options on /@filename@/ are stripped and ignored.
-- 
-- See also: 'GI.Vips.Objects.Foreign.foreignFindLoadBuffer', @/vips_image_new_from_file()/@.
foreignFindLoad ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@filename@/: file to find a loader for
    -> m T.Text
    -- ^ __Returns:__ the name of an operation on success, 'P.Nothing' on error
foreignFindLoad :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m Text
foreignFindLoad Text
filename = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    CString
result <- CString -> IO CString
vips_foreign_find_load CString
filename'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"foreignFindLoad" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Foreign::find_load_buffer
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 1 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start of\nmemory buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of bytes in @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "size"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of bytes in @data"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "vips_foreign_find_load_buffer" vips_foreign_find_load_buffer :: 
    Ptr Word8 ->                            -- data : TCArray False (-1) 1 (TBasicType TUInt8)
    Word64 ->                               -- size : TBasicType TUInt64
    IO CString

-- | Searches for an operation you could use to load a memory buffer. To see the
-- range of buffer loaders supported by your vips, try something like:
-- 
-- 	vips -l | grep load_buffer
-- 
-- See also: @/vips_image_new_from_buffer()/@.
foreignFindLoadBuffer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@data@/: start of
    -- memory buffer
    -> m T.Text
    -- ^ __Returns:__ the name of an operation on success, 'P.Nothing' on
    -- error.
foreignFindLoadBuffer :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> m Text
foreignFindLoadBuffer ByteString
data_ = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    let size :: Word64
size = 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
data_
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    CString
result <- Ptr Word8 -> Word64 -> IO CString
vips_foreign_find_load_buffer Ptr Word8
data_' Word64
size
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"foreignFindLoadBuffer" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Foreign::find_load_source
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Source" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "source to load from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "vips_foreign_find_load_source" vips_foreign_find_load_source :: 
    Ptr Vips.Source.Source ->               -- source : TInterface (Name {namespace = "Vips", name = "Source"})
    IO CString

-- | Searches for an operation you could use to load a source. To see the
-- range of source loaders supported by your vips, try something like:
-- 
-- 	vips -l | grep load_source
-- 
-- See also: @/vips_image_new_from_source()/@.
foreignFindLoadSource ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vips.Source.Source
    -- ^ /@source@/: source to load from
    -> m T.Text
    -- ^ __Returns:__ the name of an operation on success, 'P.Nothing' on
    -- error.
foreignFindLoadSource :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Source -> m Text
foreignFindLoadSource Source
source = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Source
source' <- Source -> IO (Ptr Source)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Source
source
    CString
result <- Ptr Source -> IO CString
vips_foreign_find_load_source Ptr Source
source'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"foreignFindLoadSource" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Source -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Source
source
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Foreign::find_save
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name to find a saver for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "vips_foreign_find_save" vips_foreign_find_save :: 
    CString ->                              -- filename : TBasicType TUTF8
    IO CString

-- | Searches for an operation you could use to write to /@filename@/.
-- Any trailing options on /@filename@/ are stripped and ignored.
-- 
-- See also: 'GI.Vips.Objects.Foreign.foreignFindSaveBuffer', @/vips_image_write_to_file()/@.
foreignFindSave ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@filename@/: name to find a saver for
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the name of an operation on success, 'P.Nothing' on error
foreignFindSave :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe Text)
foreignFindSave Text
filename = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    CString
result <- CString -> IO CString
vips_foreign_find_save CString
filename'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Foreign::find_save_buffer
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "suffix"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name to find a saver for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "vips_foreign_find_save_buffer" vips_foreign_find_save_buffer :: 
    CString ->                              -- suffix : TBasicType TUTF8
    IO CString

-- | Searches for an operation you could use to write to a buffer in /@suffix@/
-- format.
-- 
-- See also: @/vips_image_write_to_buffer()/@.
foreignFindSaveBuffer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@suffix@/: name to find a saver for
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the name of an operation on success, 'P.Nothing' on error
foreignFindSaveBuffer :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe Text)
foreignFindSaveBuffer Text
suffix = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    CString
suffix' <- Text -> IO CString
textToCString Text
suffix
    CString
result <- CString -> IO CString
vips_foreign_find_save_buffer CString
suffix'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
suffix'
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Foreign::find_save_target
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "suffix"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "format to find a saver for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "vips_foreign_find_save_target" vips_foreign_find_save_target :: 
    CString ->                              -- suffix : TBasicType TUTF8
    IO CString

-- | Searches for an operation you could use to write to a target in /@suffix@/
-- format.
-- 
-- See also: @/vips_image_write_to_buffer()/@.
foreignFindSaveTarget ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@suffix@/: format to find a saver for
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the name of an operation on success, 'P.Nothing' on error
foreignFindSaveTarget :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe Text)
foreignFindSaveTarget Text
suffix = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    CString
suffix' <- Text -> IO CString
textToCString Text
suffix
    CString
result <- CString -> IO CString
vips_foreign_find_save_target CString
suffix'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
suffix'
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- XXX Could not generate method Foreign::get_suffixes
{-  Bad introspection data: `TCArray False (-1) (-1) (TBasicType TUTF8)' is an array type, but contains no length information,
    so it cannot be unpacked.
-}
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data ForeignGetSuffixesMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "getSuffixes" Foreign) => O.OverloadedMethod ForeignGetSuffixesMethodInfo o p where
    overloadedMethod = undefined

instance (o ~ O.UnsupportedMethodError "getSuffixes" Foreign) => O.OverloadedMethodInfo ForeignGetSuffixesMethodInfo o where
    overloadedMethodInfo = undefined

#endif

-- method Foreign::is_a
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "loader"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of loader to use for test"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "file to test" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "vips_foreign_is_a" vips_foreign_is_a :: 
    CString ->                              -- loader : TBasicType TUTF8
    CString ->                              -- filename : TBasicType TUTF8
    IO CInt

-- | Return 'P.True' if /@filename@/ can be loaded by /@loader@/. /@loader@/ is something
-- like \"tiffload\" or \"VipsForeignLoadTiff\".
foreignIsA ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@loader@/: name of loader to use for test
    -> T.Text
    -- ^ /@filename@/: file to test
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@filename@/ can be loaded by /@loader@/.
foreignIsA :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Text -> m Bool
foreignIsA Text
loader Text
filename = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CString
loader' <- Text -> IO CString
textToCString Text
loader
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    CInt
result <- CString -> CString -> IO CInt
vips_foreign_is_a CString
loader' CString
filename'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
loader'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Foreign::is_a_buffer
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "loader"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of loader to use for test"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to the buffer to test"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "size of the buffer to test"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "size"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "size of the buffer to test"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "vips_foreign_is_a_buffer" vips_foreign_is_a_buffer :: 
    CString ->                              -- loader : TBasicType TUTF8
    Ptr Word8 ->                            -- data : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- size : TBasicType TUInt64
    IO CInt

-- | Return 'P.True' if /@data@/ can be loaded by /@loader@/. /@loader@/ is something
-- like \"tiffload_buffer\" or \"VipsForeignLoadTiffBuffer\".
foreignIsABuffer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@loader@/: name of loader to use for test
    -> ByteString
    -- ^ /@data@/: pointer to the buffer to test
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@data@/ can be loaded by /@loader@/.
foreignIsABuffer :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> ByteString -> m Bool
foreignIsABuffer Text
loader ByteString
data_ = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    let size :: Word64
size = 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
data_
    CString
loader' <- Text -> IO CString
textToCString Text
loader
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    CInt
result <- CString -> Ptr Word8 -> Word64 -> IO CInt
vips_foreign_is_a_buffer CString
loader' Ptr Word8
data_' Word64
size
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
loader'
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Foreign::is_a_source
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "loader"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of loader to use for test"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Source" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "source to test" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "vips_foreign_is_a_source" vips_foreign_is_a_source :: 
    CString ->                              -- loader : TBasicType TUTF8
    Ptr Vips.Source.Source ->               -- source : TInterface (Name {namespace = "Vips", name = "Source"})
    IO CInt

-- | Return 'P.True' if /@source@/ can be loaded by /@loader@/. /@loader@/ is something
-- like \"tiffload_source\" or \"VipsForeignLoadTiffSource\".
foreignIsASource ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@loader@/: name of loader to use for test
    -> Vips.Source.Source
    -- ^ /@source@/: source to test
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@data@/ can be loaded by /@source@/.
foreignIsASource :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Source -> m Bool
foreignIsASource Text
loader Source
source = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CString
loader' <- Text -> IO CString
textToCString Text
loader
    Ptr Source
source' <- Source -> IO (Ptr Source)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Source
source
    CInt
result <- CString -> Ptr Source -> IO CInt
vips_foreign_is_a_source CString
loader' Ptr Source
source'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Source -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Source
source
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
loader'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Foreign::map
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "base"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "base class to search below (eg. \"VipsForeignLoad\")"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fn"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "SListMap2Fn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "function to apply to each #VipsForeignClass"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "a"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "vips_foreign_map" vips_foreign_map :: 
    CString ->                              -- base : TBasicType TUTF8
    FunPtr Vips.Callbacks.C_SListMap2Fn ->  -- fn : TInterface (Name {namespace = "Vips", name = "SListMap2Fn"})
    Ptr () ->                               -- a : TBasicType TPtr
    Ptr () ->                               -- b : TBasicType TPtr
    IO (Ptr ())

-- | Apply a function to every t'GI.Vips.Structs.ForeignClass.ForeignClass' that VIPS knows about. Foreigns
-- are presented to the function in priority order.
-- 
-- Like all VIPS map functions, if /@fn@/ returns 'P.Nothing', iteration continues. If
-- it returns non-'P.Nothing', iteration terminates and that value is returned. The
-- map function returns 'P.Nothing' if all calls return 'P.Nothing'.
-- 
-- See also: @/vips_slist_map()/@.
foreignMap ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@base@/: base class to search below (eg. \"VipsForeignLoad\")
    -> Vips.Callbacks.SListMap2Fn
    -- ^ /@fn@/: function to apply to each t'GI.Vips.Structs.ForeignClass.ForeignClass'
    -> Ptr ()
    -- ^ /@a@/: user data
    -> Ptr ()
    -- ^ /@b@/: user data
    -> m (Ptr ())
    -- ^ __Returns:__ the result of iteration
foreignMap :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> SListMap2Fn -> Ptr () -> Ptr () -> m (Ptr ())
foreignMap Text
base SListMap2Fn
fn Ptr ()
a Ptr ()
b = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    CString
base' <- Text -> IO CString
textToCString Text
base
    FunPtr SListMap2Fn
fn' <- SListMap2Fn -> IO (FunPtr SListMap2Fn)
Vips.Callbacks.mk_SListMap2Fn (Maybe (Ptr (FunPtr SListMap2Fn)) -> SListMap2Fn -> SListMap2Fn
Vips.Callbacks.wrap_SListMap2Fn Maybe (Ptr (FunPtr SListMap2Fn))
forall a. Maybe a
Nothing SListMap2Fn
fn)
    Ptr ()
result <- CString -> FunPtr SListMap2Fn -> Ptr () -> Ptr () -> IO (Ptr ())
vips_foreign_map CString
base' FunPtr SListMap2Fn
fn' Ptr ()
a Ptr ()
b
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr SListMap2Fn -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr SListMap2Fn
fn'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
base'
    Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
#endif