{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An image. These can represent an image on disc, a memory buffer, an image
-- in the process of being written to disc or a partially evaluated image
-- in memory.

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

module GI.Vips.Objects.Image
    ( 
#if defined(ENABLE_OVERLOADING)
    ImageMapMethodInfo                      ,
#endif

-- * Exported types
    Image(..)                               ,
    IsImage                                 ,
    toImage                                 ,


 -- * 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"), [autorotRemoveAngle]("GI.Vips.Objects.Image#g:method:autorotRemoveAngle"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [build]("GI.Vips.Objects.Object#g:method:build"), [colourspaceIssupported]("GI.Vips.Objects.Image#g:method:colourspaceIssupported"), [copyMemory]("GI.Vips.Objects.Image#g:method:copyMemory"), [decode]("GI.Vips.Objects.Image#g:method:decode"), [decodePredict]("GI.Vips.Objects.Image#g:method:decodePredict"), [encode]("GI.Vips.Objects.Image#g:method:encode"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [foreignLoadInvalidate]("GI.Vips.Objects.Image#g:method:foreignLoadInvalidate"), [freeBuffer]("GI.Vips.Objects.Image#g:method:freeBuffer"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [get]("GI.Vips.Objects.Image#g:method:get"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [guessFormat]("GI.Vips.Objects.Image#g:method:guessFormat"), [guessInterpretation]("GI.Vips.Objects.Image#g:method:guessInterpretation"), [hasalpha]("GI.Vips.Objects.Image#g:method:hasalpha"), [historyArgs]("GI.Vips.Objects.Image#g:method:historyArgs"), [iccAc2rc]("GI.Vips.Objects.Image#g:method:iccAc2rc"), [initFields]("GI.Vips.Objects.Image#g:method:initFields"), [inplace]("GI.Vips.Objects.Image#g:method:inplace"), [invalidateAll]("GI.Vips.Objects.Image#g:method:invalidateAll"), [isMSBfirst]("GI.Vips.Objects.Image#g:method:isMSBfirst"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isSequential]("GI.Vips.Objects.Image#g:method:isSequential"), [isfile]("GI.Vips.Objects.Image#g:method:isfile"), [iskilled]("GI.Vips.Objects.Image#g:method:iskilled"), [ispartial]("GI.Vips.Objects.Image#g:method:ispartial"), [localCb]("GI.Vips.Objects.Object#g:method:localCb"), [map]("GI.Vips.Objects.Image#g:method:map"), [minimiseAll]("GI.Vips.Objects.Image#g:method:minimiseAll"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [pioInput]("GI.Vips.Objects.Image#g:method:pioInput"), [pioOutput]("GI.Vips.Objects.Image#g:method:pioOutput"), [preclose]("GI.Vips.Objects.Object#g:method:preclose"), [printDump]("GI.Vips.Objects.Object#g:method:printDump"), [printField]("GI.Vips.Objects.Image#g:method:printField"), [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"), [remove]("GI.Vips.Objects.Image#g:method:remove"), [reorderMarginHint]("GI.Vips.Objects.Image#g:method:reorderMarginHint"), [reorderPrepareMany]("GI.Vips.Objects.Image#g:method:reorderPrepareMany"), [rewind]("GI.Vips.Objects.Object#g:method:rewind"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [sanity]("GI.Vips.Objects.Object#g:method:sanity"), [set]("GI.Vips.Objects.Image#g:method:set"), [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"), [wioInput]("GI.Vips.Objects.Image#g:method:wioInput"), [write]("GI.Vips.Objects.Image#g:method:write"), [writeLine]("GI.Vips.Objects.Image#g:method:writeLine"), [writePrepare]("GI.Vips.Objects.Image#g:method:writePrepare"), [writeToMemory]("GI.Vips.Objects.Image#g:method:writeToMemory").
-- 
-- ==== Getters
-- [getArea]("GI.Vips.Objects.Image#g:method:getArea"), [getArgumentFlags]("GI.Vips.Objects.Object#g:method:getArgumentFlags"), [getArgumentPriority]("GI.Vips.Objects.Object#g:method:getArgumentPriority"), [getArgumentToString]("GI.Vips.Objects.Object#g:method:getArgumentToString"), [getArrayDouble]("GI.Vips.Objects.Image#g:method:getArrayDouble"), [getArrayInt]("GI.Vips.Objects.Image#g:method:getArrayInt"), [getAsString]("GI.Vips.Objects.Image#g:method:getAsString"), [getBands]("GI.Vips.Objects.Image#g:method:getBands"), [getBlob]("GI.Vips.Objects.Image#g:method:getBlob"), [getCoding]("GI.Vips.Objects.Image#g:method:getCoding"), [getData]("GI.Vips.Objects.Image#g:method:getData"), [getDescription]("GI.Vips.Objects.Object#g:method:getDescription"), [getDouble]("GI.Vips.Objects.Image#g:method:getDouble"), [getFields]("GI.Vips.Objects.Image#g:method:getFields"), [getFilename]("GI.Vips.Objects.Image#g:method:getFilename"), [getFormat]("GI.Vips.Objects.Image#g:method:getFormat"), [getHeight]("GI.Vips.Objects.Image#g:method:getHeight"), [getHistory]("GI.Vips.Objects.Image#g:method:getHistory"), [getImage]("GI.Vips.Objects.Image#g:method:getImage"), [getInt]("GI.Vips.Objects.Image#g:method:getInt"), [getInterpretation]("GI.Vips.Objects.Image#g:method:getInterpretation"), [getMode]("GI.Vips.Objects.Image#g:method:getMode"), [getNPages]("GI.Vips.Objects.Image#g:method:getNPages"), [getNSubifds]("GI.Vips.Objects.Image#g:method:getNSubifds"), [getOffset]("GI.Vips.Objects.Image#g:method:getOffset"), [getOrientation]("GI.Vips.Objects.Image#g:method:getOrientation"), [getOrientationSwap]("GI.Vips.Objects.Image#g:method:getOrientationSwap"), [getPageHeight]("GI.Vips.Objects.Image#g:method:getPageHeight"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getScale]("GI.Vips.Objects.Image#g:method:getScale"), [getString]("GI.Vips.Objects.Image#g:method:getString"), [getTypeof]("GI.Vips.Objects.Image#g:method:getTypeof"), [getWidth]("GI.Vips.Objects.Image#g:method:getWidth"), [getXoffset]("GI.Vips.Objects.Image#g:method:getXoffset"), [getXres]("GI.Vips.Objects.Image#g:method:getXres"), [getYoffset]("GI.Vips.Objects.Image#g:method:getYoffset"), [getYres]("GI.Vips.Objects.Image#g:method:getYres").
-- 
-- ==== Setters
-- [setArea]("GI.Vips.Objects.Image#g:method:setArea"), [setArgumentFromString]("GI.Vips.Objects.Object#g:method:setArgumentFromString"), [setArrayDouble]("GI.Vips.Objects.Image#g:method:setArrayDouble"), [setArrayInt]("GI.Vips.Objects.Image#g:method:setArrayInt"), [setBlob]("GI.Vips.Objects.Image#g:method:setBlob"), [setBlobCopy]("GI.Vips.Objects.Image#g:method:setBlobCopy"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDeleteOnClose]("GI.Vips.Objects.Image#g:method:setDeleteOnClose"), [setDouble]("GI.Vips.Objects.Image#g:method:setDouble"), [setFromString]("GI.Vips.Objects.Object#g:method:setFromString"), [setImage]("GI.Vips.Objects.Image#g:method:setImage"), [setInt]("GI.Vips.Objects.Image#g:method:setInt"), [setKill]("GI.Vips.Objects.Image#g:method:setKill"), [setProgress]("GI.Vips.Objects.Image#g:method:setProgress"), [setRequired]("GI.Vips.Objects.Object#g:method:setRequired"), [setStatic]("GI.Vips.Objects.Object#g:method:setStatic"), [setString]("GI.Vips.Objects.Image#g:method:setString").

#if defined(ENABLE_OVERLOADING)
    ResolveImageMethod                      ,
#endif

-- ** autorotRemoveAngle #method:autorotRemoveAngle#

#if defined(ENABLE_OVERLOADING)
    ImageAutorotRemoveAngleMethodInfo       ,
#endif
    imageAutorotRemoveAngle                 ,


-- ** colourspaceIssupported #method:colourspaceIssupported#

#if defined(ENABLE_OVERLOADING)
    ImageColourspaceIssupportedMethodInfo   ,
#endif
    imageColourspaceIssupported             ,


-- ** copyMemory #method:copyMemory#

#if defined(ENABLE_OVERLOADING)
    ImageCopyMemoryMethodInfo               ,
#endif
    imageCopyMemory                         ,


-- ** decode #method:decode#

#if defined(ENABLE_OVERLOADING)
    ImageDecodeMethodInfo                   ,
#endif
    imageDecode                             ,


-- ** decodePredict #method:decodePredict#

#if defined(ENABLE_OVERLOADING)
    ImageDecodePredictMethodInfo            ,
#endif
    imageDecodePredict                      ,


-- ** encode #method:encode#

#if defined(ENABLE_OVERLOADING)
    ImageEncodeMethodInfo                   ,
#endif
    imageEncode                             ,


-- ** foreignLoadInvalidate #method:foreignLoadInvalidate#

#if defined(ENABLE_OVERLOADING)
    ImageForeignLoadInvalidateMethodInfo    ,
#endif
    imageForeignLoadInvalidate              ,


-- ** freeBuffer #method:freeBuffer#

#if defined(ENABLE_OVERLOADING)
    ImageFreeBufferMethodInfo               ,
#endif
    imageFreeBuffer                         ,


-- ** get #method:get#

#if defined(ENABLE_OVERLOADING)
    ImageGetMethodInfo                      ,
#endif
    imageGet                                ,


-- ** getArea #method:getArea#

#if defined(ENABLE_OVERLOADING)
    ImageGetAreaMethodInfo                  ,
#endif
    imageGetArea                            ,


-- ** getArrayDouble #method:getArrayDouble#

#if defined(ENABLE_OVERLOADING)
    ImageGetArrayDoubleMethodInfo           ,
#endif
    imageGetArrayDouble                     ,


-- ** getArrayInt #method:getArrayInt#

#if defined(ENABLE_OVERLOADING)
    ImageGetArrayIntMethodInfo              ,
#endif
    imageGetArrayInt                        ,


-- ** getAsString #method:getAsString#

#if defined(ENABLE_OVERLOADING)
    ImageGetAsStringMethodInfo              ,
#endif
    imageGetAsString                        ,


-- ** getBands #method:getBands#

#if defined(ENABLE_OVERLOADING)
    ImageGetBandsMethodInfo                 ,
#endif
    imageGetBands                           ,


-- ** getBlob #method:getBlob#

#if defined(ENABLE_OVERLOADING)
    ImageGetBlobMethodInfo                  ,
#endif
    imageGetBlob                            ,


-- ** getCoding #method:getCoding#

#if defined(ENABLE_OVERLOADING)
    ImageGetCodingMethodInfo                ,
#endif
    imageGetCoding                          ,


-- ** getData #method:getData#

#if defined(ENABLE_OVERLOADING)
    ImageGetDataMethodInfo                  ,
#endif
    imageGetData                            ,


-- ** getDouble #method:getDouble#

#if defined(ENABLE_OVERLOADING)
    ImageGetDoubleMethodInfo                ,
#endif
    imageGetDouble                          ,


-- ** getFields #method:getFields#

#if defined(ENABLE_OVERLOADING)
    ImageGetFieldsMethodInfo                ,
#endif
    imageGetFields                          ,


-- ** getFilename #method:getFilename#

#if defined(ENABLE_OVERLOADING)
    ImageGetFilenameMethodInfo              ,
#endif
    imageGetFilename                        ,


-- ** getFormat #method:getFormat#

#if defined(ENABLE_OVERLOADING)
    ImageGetFormatMethodInfo                ,
#endif
    imageGetFormat                          ,


-- ** getFormatMax #method:getFormatMax#

    imageGetFormatMax                       ,


-- ** getHeight #method:getHeight#

#if defined(ENABLE_OVERLOADING)
    ImageGetHeightMethodInfo                ,
#endif
    imageGetHeight                          ,


-- ** getHistory #method:getHistory#

#if defined(ENABLE_OVERLOADING)
    ImageGetHistoryMethodInfo               ,
#endif
    imageGetHistory                         ,


-- ** getImage #method:getImage#

#if defined(ENABLE_OVERLOADING)
    ImageGetImageMethodInfo                 ,
#endif
    imageGetImage                           ,


-- ** getInt #method:getInt#

#if defined(ENABLE_OVERLOADING)
    ImageGetIntMethodInfo                   ,
#endif
    imageGetInt                             ,


-- ** getInterpretation #method:getInterpretation#

#if defined(ENABLE_OVERLOADING)
    ImageGetInterpretationMethodInfo        ,
#endif
    imageGetInterpretation                  ,


-- ** getMode #method:getMode#

#if defined(ENABLE_OVERLOADING)
    ImageGetModeMethodInfo                  ,
#endif
    imageGetMode                            ,


-- ** getNPages #method:getNPages#

#if defined(ENABLE_OVERLOADING)
    ImageGetNPagesMethodInfo                ,
#endif
    imageGetNPages                          ,


-- ** getNSubifds #method:getNSubifds#

#if defined(ENABLE_OVERLOADING)
    ImageGetNSubifdsMethodInfo              ,
#endif
    imageGetNSubifds                        ,


-- ** getOffset #method:getOffset#

#if defined(ENABLE_OVERLOADING)
    ImageGetOffsetMethodInfo                ,
#endif
    imageGetOffset                          ,


-- ** getOrientation #method:getOrientation#

#if defined(ENABLE_OVERLOADING)
    ImageGetOrientationMethodInfo           ,
#endif
    imageGetOrientation                     ,


-- ** getOrientationSwap #method:getOrientationSwap#

#if defined(ENABLE_OVERLOADING)
    ImageGetOrientationSwapMethodInfo       ,
#endif
    imageGetOrientationSwap                 ,


-- ** getPageHeight #method:getPageHeight#

#if defined(ENABLE_OVERLOADING)
    ImageGetPageHeightMethodInfo            ,
#endif
    imageGetPageHeight                      ,


-- ** getScale #method:getScale#

#if defined(ENABLE_OVERLOADING)
    ImageGetScaleMethodInfo                 ,
#endif
    imageGetScale                           ,


-- ** getString #method:getString#

#if defined(ENABLE_OVERLOADING)
    ImageGetStringMethodInfo                ,
#endif
    imageGetString                          ,


-- ** getTypeof #method:getTypeof#

#if defined(ENABLE_OVERLOADING)
    ImageGetTypeofMethodInfo                ,
#endif
    imageGetTypeof                          ,


-- ** getWidth #method:getWidth#

#if defined(ENABLE_OVERLOADING)
    ImageGetWidthMethodInfo                 ,
#endif
    imageGetWidth                           ,


-- ** getXoffset #method:getXoffset#

#if defined(ENABLE_OVERLOADING)
    ImageGetXoffsetMethodInfo               ,
#endif
    imageGetXoffset                         ,


-- ** getXres #method:getXres#

#if defined(ENABLE_OVERLOADING)
    ImageGetXresMethodInfo                  ,
#endif
    imageGetXres                            ,


-- ** getYoffset #method:getYoffset#

#if defined(ENABLE_OVERLOADING)
    ImageGetYoffsetMethodInfo               ,
#endif
    imageGetYoffset                         ,


-- ** getYres #method:getYres#

#if defined(ENABLE_OVERLOADING)
    ImageGetYresMethodInfo                  ,
#endif
    imageGetYres                            ,


-- ** guessFormat #method:guessFormat#

#if defined(ENABLE_OVERLOADING)
    ImageGuessFormatMethodInfo              ,
#endif
    imageGuessFormat                        ,


-- ** guessInterpretation #method:guessInterpretation#

#if defined(ENABLE_OVERLOADING)
    ImageGuessInterpretationMethodInfo      ,
#endif
    imageGuessInterpretation                ,


-- ** hasalpha #method:hasalpha#

#if defined(ENABLE_OVERLOADING)
    ImageHasalphaMethodInfo                 ,
#endif
    imageHasalpha                           ,


-- ** historyArgs #method:historyArgs#

#if defined(ENABLE_OVERLOADING)
    ImageHistoryArgsMethodInfo              ,
#endif
    imageHistoryArgs                        ,


-- ** iccAc2rc #method:iccAc2rc#

#if defined(ENABLE_OVERLOADING)
    ImageIccAc2rcMethodInfo                 ,
#endif
    imageIccAc2rc                           ,


-- ** initFields #method:initFields#

#if defined(ENABLE_OVERLOADING)
    ImageInitFieldsMethodInfo               ,
#endif
    imageInitFields                         ,


-- ** inplace #method:inplace#

#if defined(ENABLE_OVERLOADING)
    ImageInplaceMethodInfo                  ,
#endif
    imageInplace                            ,


-- ** invalidateAll #method:invalidateAll#

#if defined(ENABLE_OVERLOADING)
    ImageInvalidateAllMethodInfo            ,
#endif
    imageInvalidateAll                      ,


-- ** isMSBfirst #method:isMSBfirst#

#if defined(ENABLE_OVERLOADING)
    ImageIsMSBfirstMethodInfo               ,
#endif
    imageIsMSBfirst                         ,


-- ** isSequential #method:isSequential#

#if defined(ENABLE_OVERLOADING)
    ImageIsSequentialMethodInfo             ,
#endif
    imageIsSequential                       ,


-- ** isfile #method:isfile#

#if defined(ENABLE_OVERLOADING)
    ImageIsfileMethodInfo                   ,
#endif
    imageIsfile                             ,


-- ** iskilled #method:iskilled#

#if defined(ENABLE_OVERLOADING)
    ImageIskilledMethodInfo                 ,
#endif
    imageIskilled                           ,


-- ** ispartial #method:ispartial#

#if defined(ENABLE_OVERLOADING)
    ImageIspartialMethodInfo                ,
#endif
    imageIspartial                          ,


-- ** memory #method:memory#

    imageMemory                             ,


-- ** minimiseAll #method:minimiseAll#

#if defined(ENABLE_OVERLOADING)
    ImageMinimiseAllMethodInfo              ,
#endif
    imageMinimiseAll                        ,


-- ** new #method:new#

    imageNew                                ,


-- ** newFromFileRW #method:newFromFileRW#

    imageNewFromFileRW                      ,


-- ** newFromFileRaw #method:newFromFileRaw#

    imageNewFromFileRaw                     ,


-- ** newFromImage #method:newFromImage#

    imageNewFromImage                       ,


-- ** newFromImage1 #method:newFromImage1#

    imageNewFromImage1                      ,


-- ** newFromMemory #method:newFromMemory#

    imageNewFromMemory                      ,


-- ** newFromMemoryCopy #method:newFromMemoryCopy#

    imageNewFromMemoryCopy                  ,


-- ** newMatrix #method:newMatrix#

    imageNewMatrix                          ,


-- ** newMatrixFromArray #method:newMatrixFromArray#

    imageNewMatrixFromArray                 ,


-- ** newTempFile #method:newTempFile#

    imageNewTempFile                        ,


-- ** pioInput #method:pioInput#

#if defined(ENABLE_OVERLOADING)
    ImagePioInputMethodInfo                 ,
#endif
    imagePioInput                           ,


-- ** pioOutput #method:pioOutput#

#if defined(ENABLE_OVERLOADING)
    ImagePioOutputMethodInfo                ,
#endif
    imagePioOutput                          ,


-- ** printField #method:printField#

#if defined(ENABLE_OVERLOADING)
    ImagePrintFieldMethodInfo               ,
#endif
    imagePrintField                         ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    ImageRemoveMethodInfo                   ,
#endif
    imageRemove                             ,


-- ** reorderMarginHint #method:reorderMarginHint#

#if defined(ENABLE_OVERLOADING)
    ImageReorderMarginHintMethodInfo        ,
#endif
    imageReorderMarginHint                  ,


-- ** reorderPrepareMany #method:reorderPrepareMany#

#if defined(ENABLE_OVERLOADING)
    ImageReorderPrepareManyMethodInfo       ,
#endif
    imageReorderPrepareMany                 ,


-- ** set #method:set#

#if defined(ENABLE_OVERLOADING)
    ImageSetMethodInfo                      ,
#endif
    imageSet                                ,


-- ** setArea #method:setArea#

#if defined(ENABLE_OVERLOADING)
    ImageSetAreaMethodInfo                  ,
#endif
    imageSetArea                            ,


-- ** setArrayDouble #method:setArrayDouble#

#if defined(ENABLE_OVERLOADING)
    ImageSetArrayDoubleMethodInfo           ,
#endif
    imageSetArrayDouble                     ,


-- ** setArrayInt #method:setArrayInt#

#if defined(ENABLE_OVERLOADING)
    ImageSetArrayIntMethodInfo              ,
#endif
    imageSetArrayInt                        ,


-- ** setBlob #method:setBlob#

#if defined(ENABLE_OVERLOADING)
    ImageSetBlobMethodInfo                  ,
#endif
    imageSetBlob                            ,


-- ** setBlobCopy #method:setBlobCopy#

#if defined(ENABLE_OVERLOADING)
    ImageSetBlobCopyMethodInfo              ,
#endif
    imageSetBlobCopy                        ,


-- ** setDeleteOnClose #method:setDeleteOnClose#

#if defined(ENABLE_OVERLOADING)
    ImageSetDeleteOnCloseMethodInfo         ,
#endif
    imageSetDeleteOnClose                   ,


-- ** setDouble #method:setDouble#

#if defined(ENABLE_OVERLOADING)
    ImageSetDoubleMethodInfo                ,
#endif
    imageSetDouble                          ,


-- ** setImage #method:setImage#

#if defined(ENABLE_OVERLOADING)
    ImageSetImageMethodInfo                 ,
#endif
    imageSetImage                           ,


-- ** setInt #method:setInt#

#if defined(ENABLE_OVERLOADING)
    ImageSetIntMethodInfo                   ,
#endif
    imageSetInt                             ,


-- ** setKill #method:setKill#

#if defined(ENABLE_OVERLOADING)
    ImageSetKillMethodInfo                  ,
#endif
    imageSetKill                            ,


-- ** setProgress #method:setProgress#

#if defined(ENABLE_OVERLOADING)
    ImageSetProgressMethodInfo              ,
#endif
    imageSetProgress                        ,


-- ** setString #method:setString#

#if defined(ENABLE_OVERLOADING)
    ImageSetStringMethodInfo                ,
#endif
    imageSetString                          ,


-- ** wioInput #method:wioInput#

#if defined(ENABLE_OVERLOADING)
    ImageWioInputMethodInfo                 ,
#endif
    imageWioInput                           ,


-- ** write #method:write#

#if defined(ENABLE_OVERLOADING)
    ImageWriteMethodInfo                    ,
#endif
    imageWrite                              ,


-- ** writeLine #method:writeLine#

#if defined(ENABLE_OVERLOADING)
    ImageWriteLineMethodInfo                ,
#endif
    imageWriteLine                          ,


-- ** writePrepare #method:writePrepare#

#if defined(ENABLE_OVERLOADING)
    ImageWritePrepareMethodInfo             ,
#endif
    imageWritePrepare                       ,


-- ** writeToMemory #method:writeToMemory#

#if defined(ENABLE_OVERLOADING)
    ImageWriteToMemoryMethodInfo            ,
#endif
    imageWriteToMemory                      ,




 -- * Properties


-- ** bands #attr:bands#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageBandsPropertyInfo                  ,
#endif
    constructImageBands                     ,
    getImageBands                           ,
#if defined(ENABLE_OVERLOADING)
    imageBands                              ,
#endif
    setImageBands                           ,


-- ** coding #attr:coding#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageCodingPropertyInfo                 ,
#endif
    constructImageCoding                    ,
    getImageCoding                          ,
#if defined(ENABLE_OVERLOADING)
    imageCoding                             ,
#endif
    setImageCoding                          ,


-- ** demand #attr:demand#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageDemandPropertyInfo                 ,
#endif
    constructImageDemand                    ,
    getImageDemand                          ,
#if defined(ENABLE_OVERLOADING)
    imageDemand                             ,
#endif
    setImageDemand                          ,


-- ** filename #attr:filename#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageFilenamePropertyInfo               ,
#endif
    clearImageFilename                      ,
    constructImageFilename                  ,
    getImageFilename                        ,
#if defined(ENABLE_OVERLOADING)
    imageFilename                           ,
#endif
    setImageFilename                        ,


-- ** foreignBuffer #attr:foreignBuffer#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageForeignBufferPropertyInfo          ,
#endif
    constructImageForeignBuffer             ,
    getImageForeignBuffer                   ,
#if defined(ENABLE_OVERLOADING)
    imageForeignBuffer                      ,
#endif
    setImageForeignBuffer                   ,


-- ** format #attr:format#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageFormatPropertyInfo                 ,
#endif
    constructImageFormat                    ,
    getImageFormat                          ,
#if defined(ENABLE_OVERLOADING)
    imageFormat                             ,
#endif
    setImageFormat                          ,


-- ** height #attr:height#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageHeightPropertyInfo                 ,
#endif
    constructImageHeight                    ,
    getImageHeight                          ,
#if defined(ENABLE_OVERLOADING)
    imageHeight                             ,
#endif
    setImageHeight                          ,


-- ** interpretation #attr:interpretation#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageInterpretationPropertyInfo         ,
#endif
    constructImageInterpretation            ,
    getImageInterpretation                  ,
#if defined(ENABLE_OVERLOADING)
    imageInterpretation                     ,
#endif
    setImageInterpretation                  ,


-- ** kill #attr:kill#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageKillPropertyInfo                   ,
#endif
    constructImageKill                      ,
    getImageKill                            ,
#if defined(ENABLE_OVERLOADING)
    imageKill                               ,
#endif
    setImageKill                            ,


-- ** mode #attr:mode#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageModePropertyInfo                   ,
#endif
    clearImageMode                          ,
    constructImageMode                      ,
    getImageMode                            ,
#if defined(ENABLE_OVERLOADING)
    imageMode                               ,
#endif
    setImageMode                            ,


-- ** sizeofHeader #attr:sizeofHeader#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageSizeofHeaderPropertyInfo           ,
#endif
    constructImageSizeofHeader              ,
    getImageSizeofHeader                    ,
#if defined(ENABLE_OVERLOADING)
    imageSizeofHeader                       ,
#endif
    setImageSizeofHeader                    ,


-- ** width #attr:width#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageWidthPropertyInfo                  ,
#endif
    constructImageWidth                     ,
    getImageWidth                           ,
#if defined(ENABLE_OVERLOADING)
    imageWidth                              ,
#endif
    setImageWidth                           ,


-- ** xoffset #attr:xoffset#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageXoffsetPropertyInfo                ,
#endif
    constructImageXoffset                   ,
    getImageXoffset                         ,
#if defined(ENABLE_OVERLOADING)
    imageXoffset                            ,
#endif
    setImageXoffset                         ,


-- ** xres #attr:xres#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageXresPropertyInfo                   ,
#endif
    constructImageXres                      ,
    getImageXres                            ,
#if defined(ENABLE_OVERLOADING)
    imageXres                               ,
#endif
    setImageXres                            ,


-- ** yoffset #attr:yoffset#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageYoffsetPropertyInfo                ,
#endif
    constructImageYoffset                   ,
    getImageYoffset                         ,
#if defined(ENABLE_OVERLOADING)
    imageYoffset                            ,
#endif
    setImageYoffset                         ,


-- ** yres #attr:yres#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ImageYresPropertyInfo                   ,
#endif
    constructImageYres                      ,
    getImageYres                            ,
#if defined(ENABLE_OVERLOADING)
    imageYres                               ,
#endif
    setImageYres                            ,




 -- * Signals


-- ** eval #signal:eval#

    ImageEvalCallback                       ,
#if defined(ENABLE_OVERLOADING)
    ImageEvalSignalInfo                     ,
#endif
    afterImageEval                          ,
    onImageEval                             ,


-- ** invalidate #signal:invalidate#

    ImageInvalidateCallback                 ,
#if defined(ENABLE_OVERLOADING)
    ImageInvalidateSignalInfo               ,
#endif
    afterImageInvalidate                    ,
    onImageInvalidate                       ,


-- ** minimise #signal:minimise#

    ImageMinimiseCallback                   ,
#if defined(ENABLE_OVERLOADING)
    ImageMinimiseSignalInfo                 ,
#endif
    afterImageMinimise                      ,
    onImageMinimise                         ,


-- ** posteval #signal:posteval#

    ImagePostevalCallback                   ,
#if defined(ENABLE_OVERLOADING)
    ImagePostevalSignalInfo                 ,
#endif
    afterImagePosteval                      ,
    onImagePosteval                         ,


-- ** preeval #signal:preeval#

    ImagePreevalCallback                    ,
#if defined(ENABLE_OVERLOADING)
    ImagePreevalSignalInfo                  ,
#endif
    afterImagePreeval                       ,
    onImagePreeval                          ,


-- ** written #signal:written#

    ImageWrittenCallback                    ,
#if defined(ENABLE_OVERLOADING)
    ImageWrittenSignalInfo                  ,
#endif
    afterImageWritten                       ,
    onImageWritten                          ,




    ) 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.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.Enums as Vips.Enums
import {-# SOURCE #-} qualified GI.Vips.Objects.Object as Vips.Object
import {-# SOURCE #-} qualified GI.Vips.Objects.Region as Vips.Region
import {-# SOURCE #-} qualified GI.Vips.Structs.Progress as Vips.Progress
import {-# SOURCE #-} qualified GI.Vips.Structs.Rect as Vips.Rect

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

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

foreign import ccall "vips_image_get_type"
    c_vips_image_get_type :: IO B.Types.GType

instance B.Types.TypedObject Image where
    glibType :: IO GType
glibType = IO GType
c_vips_image_get_type

instance B.Types.GObject Image

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

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

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

-- | Convert 'Image' 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 Image) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_vips_image_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Image -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Image
P.Nothing = Ptr GValue -> Ptr Image -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Image
forall a. Ptr a
FP.nullPtr :: FP.Ptr Image)
    gvalueSet_ Ptr GValue
gv (P.Just Image
obj) = Image -> (Ptr Image -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Image
obj (Ptr GValue -> Ptr Image -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Image)
gvalueGet_ Ptr GValue
gv = do
        Ptr Image
ptr <- Ptr GValue -> IO (Ptr Image)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Image)
        if Ptr Image
ptr Ptr Image -> Ptr Image -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Image
forall a. Ptr a
FP.nullPtr
        then Image -> Maybe Image
forall a. a -> Maybe a
P.Just (Image -> Maybe Image) -> IO Image -> IO (Maybe Image)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Image -> Image
Image Ptr Image
ptr
        else Maybe Image -> IO (Maybe Image)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Image
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveImageMethod (t :: Symbol) (o :: *) :: * where
    ResolveImageMethod "argumentIsset" o = Vips.Object.ObjectArgumentIssetMethodInfo
    ResolveImageMethod "argumentNeedsstring" o = Vips.Object.ObjectArgumentNeedsstringMethodInfo
    ResolveImageMethod "autorotRemoveAngle" o = ImageAutorotRemoveAngleMethodInfo
    ResolveImageMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveImageMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveImageMethod "build" o = Vips.Object.ObjectBuildMethodInfo
    ResolveImageMethod "colourspaceIssupported" o = ImageColourspaceIssupportedMethodInfo
    ResolveImageMethod "copyMemory" o = ImageCopyMemoryMethodInfo
    ResolveImageMethod "decode" o = ImageDecodeMethodInfo
    ResolveImageMethod "decodePredict" o = ImageDecodePredictMethodInfo
    ResolveImageMethod "encode" o = ImageEncodeMethodInfo
    ResolveImageMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveImageMethod "foreignLoadInvalidate" o = ImageForeignLoadInvalidateMethodInfo
    ResolveImageMethod "freeBuffer" o = ImageFreeBufferMethodInfo
    ResolveImageMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveImageMethod "get" o = ImageGetMethodInfo
    ResolveImageMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveImageMethod "guessFormat" o = ImageGuessFormatMethodInfo
    ResolveImageMethod "guessInterpretation" o = ImageGuessInterpretationMethodInfo
    ResolveImageMethod "hasalpha" o = ImageHasalphaMethodInfo
    ResolveImageMethod "historyArgs" o = ImageHistoryArgsMethodInfo
    ResolveImageMethod "iccAc2rc" o = ImageIccAc2rcMethodInfo
    ResolveImageMethod "initFields" o = ImageInitFieldsMethodInfo
    ResolveImageMethod "inplace" o = ImageInplaceMethodInfo
    ResolveImageMethod "invalidateAll" o = ImageInvalidateAllMethodInfo
    ResolveImageMethod "isMSBfirst" o = ImageIsMSBfirstMethodInfo
    ResolveImageMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveImageMethod "isSequential" o = ImageIsSequentialMethodInfo
    ResolveImageMethod "isfile" o = ImageIsfileMethodInfo
    ResolveImageMethod "iskilled" o = ImageIskilledMethodInfo
    ResolveImageMethod "ispartial" o = ImageIspartialMethodInfo
    ResolveImageMethod "localCb" o = Vips.Object.ObjectLocalCbMethodInfo
    ResolveImageMethod "map" o = ImageMapMethodInfo
    ResolveImageMethod "minimiseAll" o = ImageMinimiseAllMethodInfo
    ResolveImageMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveImageMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveImageMethod "pioInput" o = ImagePioInputMethodInfo
    ResolveImageMethod "pioOutput" o = ImagePioOutputMethodInfo
    ResolveImageMethod "preclose" o = Vips.Object.ObjectPrecloseMethodInfo
    ResolveImageMethod "printDump" o = Vips.Object.ObjectPrintDumpMethodInfo
    ResolveImageMethod "printField" o = ImagePrintFieldMethodInfo
    ResolveImageMethod "printName" o = Vips.Object.ObjectPrintNameMethodInfo
    ResolveImageMethod "printSummary" o = Vips.Object.ObjectPrintSummaryMethodInfo
    ResolveImageMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveImageMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveImageMethod "remove" o = ImageRemoveMethodInfo
    ResolveImageMethod "reorderMarginHint" o = ImageReorderMarginHintMethodInfo
    ResolveImageMethod "reorderPrepareMany" o = ImageReorderPrepareManyMethodInfo
    ResolveImageMethod "rewind" o = Vips.Object.ObjectRewindMethodInfo
    ResolveImageMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveImageMethod "sanity" o = Vips.Object.ObjectSanityMethodInfo
    ResolveImageMethod "set" o = ImageSetMethodInfo
    ResolveImageMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveImageMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveImageMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveImageMethod "toString" o = Vips.Object.ObjectToStringMethodInfo
    ResolveImageMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveImageMethod "unrefOutputs" o = Vips.Object.ObjectUnrefOutputsMethodInfo
    ResolveImageMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveImageMethod "wioInput" o = ImageWioInputMethodInfo
    ResolveImageMethod "write" o = ImageWriteMethodInfo
    ResolveImageMethod "writeLine" o = ImageWriteLineMethodInfo
    ResolveImageMethod "writePrepare" o = ImageWritePrepareMethodInfo
    ResolveImageMethod "writeToMemory" o = ImageWriteToMemoryMethodInfo
    ResolveImageMethod "getArea" o = ImageGetAreaMethodInfo
    ResolveImageMethod "getArgumentFlags" o = Vips.Object.ObjectGetArgumentFlagsMethodInfo
    ResolveImageMethod "getArgumentPriority" o = Vips.Object.ObjectGetArgumentPriorityMethodInfo
    ResolveImageMethod "getArgumentToString" o = Vips.Object.ObjectGetArgumentToStringMethodInfo
    ResolveImageMethod "getArrayDouble" o = ImageGetArrayDoubleMethodInfo
    ResolveImageMethod "getArrayInt" o = ImageGetArrayIntMethodInfo
    ResolveImageMethod "getAsString" o = ImageGetAsStringMethodInfo
    ResolveImageMethod "getBands" o = ImageGetBandsMethodInfo
    ResolveImageMethod "getBlob" o = ImageGetBlobMethodInfo
    ResolveImageMethod "getCoding" o = ImageGetCodingMethodInfo
    ResolveImageMethod "getData" o = ImageGetDataMethodInfo
    ResolveImageMethod "getDescription" o = Vips.Object.ObjectGetDescriptionMethodInfo
    ResolveImageMethod "getDouble" o = ImageGetDoubleMethodInfo
    ResolveImageMethod "getFields" o = ImageGetFieldsMethodInfo
    ResolveImageMethod "getFilename" o = ImageGetFilenameMethodInfo
    ResolveImageMethod "getFormat" o = ImageGetFormatMethodInfo
    ResolveImageMethod "getHeight" o = ImageGetHeightMethodInfo
    ResolveImageMethod "getHistory" o = ImageGetHistoryMethodInfo
    ResolveImageMethod "getImage" o = ImageGetImageMethodInfo
    ResolveImageMethod "getInt" o = ImageGetIntMethodInfo
    ResolveImageMethod "getInterpretation" o = ImageGetInterpretationMethodInfo
    ResolveImageMethod "getMode" o = ImageGetModeMethodInfo
    ResolveImageMethod "getNPages" o = ImageGetNPagesMethodInfo
    ResolveImageMethod "getNSubifds" o = ImageGetNSubifdsMethodInfo
    ResolveImageMethod "getOffset" o = ImageGetOffsetMethodInfo
    ResolveImageMethod "getOrientation" o = ImageGetOrientationMethodInfo
    ResolveImageMethod "getOrientationSwap" o = ImageGetOrientationSwapMethodInfo
    ResolveImageMethod "getPageHeight" o = ImageGetPageHeightMethodInfo
    ResolveImageMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveImageMethod "getScale" o = ImageGetScaleMethodInfo
    ResolveImageMethod "getString" o = ImageGetStringMethodInfo
    ResolveImageMethod "getTypeof" o = ImageGetTypeofMethodInfo
    ResolveImageMethod "getWidth" o = ImageGetWidthMethodInfo
    ResolveImageMethod "getXoffset" o = ImageGetXoffsetMethodInfo
    ResolveImageMethod "getXres" o = ImageGetXresMethodInfo
    ResolveImageMethod "getYoffset" o = ImageGetYoffsetMethodInfo
    ResolveImageMethod "getYres" o = ImageGetYresMethodInfo
    ResolveImageMethod "setArea" o = ImageSetAreaMethodInfo
    ResolveImageMethod "setArgumentFromString" o = Vips.Object.ObjectSetArgumentFromStringMethodInfo
    ResolveImageMethod "setArrayDouble" o = ImageSetArrayDoubleMethodInfo
    ResolveImageMethod "setArrayInt" o = ImageSetArrayIntMethodInfo
    ResolveImageMethod "setBlob" o = ImageSetBlobMethodInfo
    ResolveImageMethod "setBlobCopy" o = ImageSetBlobCopyMethodInfo
    ResolveImageMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveImageMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveImageMethod "setDeleteOnClose" o = ImageSetDeleteOnCloseMethodInfo
    ResolveImageMethod "setDouble" o = ImageSetDoubleMethodInfo
    ResolveImageMethod "setFromString" o = Vips.Object.ObjectSetFromStringMethodInfo
    ResolveImageMethod "setImage" o = ImageSetImageMethodInfo
    ResolveImageMethod "setInt" o = ImageSetIntMethodInfo
    ResolveImageMethod "setKill" o = ImageSetKillMethodInfo
    ResolveImageMethod "setProgress" o = ImageSetProgressMethodInfo
    ResolveImageMethod "setRequired" o = Vips.Object.ObjectSetRequiredMethodInfo
    ResolveImageMethod "setStatic" o = Vips.Object.ObjectSetStaticMethodInfo
    ResolveImageMethod "setString" o = ImageSetStringMethodInfo
    ResolveImageMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Image::eval
-- | The [eval](#g:signal:eval) signal is emitted once per work unit (typically a 128 x
-- 128 area of pixels) during image computation.
-- 
-- You can use this signal to update user-interfaces with progress
-- feedback. Beware of updating too frequently: you will usually
-- need some throttling mechanism.
-- 
-- Use 'GI.Vips.Objects.Image.imageSetProgress' to turn on progress reporting for an
-- image.
type ImageEvalCallback =
    Vips.Progress.Progress
    -- ^ /@progress@/: t'GI.Vips.Structs.Progress.Progress' for this image
    -> IO ()

type C_ImageEvalCallback =
    Ptr Image ->                            -- object
    Ptr Vips.Progress.Progress ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ImageEvalCallback :: 
    GObject a => (a -> ImageEvalCallback) ->
    C_ImageEvalCallback
wrap_ImageEvalCallback :: forall a.
GObject a =>
(a -> ImageEvalCallback) -> C_ImageEvalCallback
wrap_ImageEvalCallback a -> ImageEvalCallback
gi'cb Ptr Image
gi'selfPtr Ptr Progress
progress Ptr ()
_ = do
    Progress
progress' <- ((ManagedPtr Progress -> Progress) -> Ptr Progress -> IO Progress
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Progress -> Progress
Vips.Progress.Progress) Ptr Progress
progress
    Ptr Image -> (Image -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Image
gi'selfPtr ((Image -> IO ()) -> IO ()) -> (Image -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Image
gi'self -> a -> ImageEvalCallback
gi'cb (Image -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Image
gi'self)  Progress
progress'


-- | Connect a signal handler for the [eval](#signal:eval) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' image #eval callback
-- @
-- 
-- 
onImageEval :: (IsImage a, MonadIO m) => a -> ((?self :: a) => ImageEvalCallback) -> m SignalHandlerId
onImageEval :: forall a (m :: * -> *).
(IsImage a, MonadIO m) =>
a -> ((?self::a) => ImageEvalCallback) -> m SignalHandlerId
onImageEval a
obj (?self::a) => ImageEvalCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ImageEvalCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ImageEvalCallback
ImageEvalCallback
cb
    let wrapped' :: C_ImageEvalCallback
wrapped' = (a -> ImageEvalCallback) -> C_ImageEvalCallback
forall a.
GObject a =>
(a -> ImageEvalCallback) -> C_ImageEvalCallback
wrap_ImageEvalCallback a -> ImageEvalCallback
wrapped
    FunPtr C_ImageEvalCallback
wrapped'' <- C_ImageEvalCallback -> IO (FunPtr C_ImageEvalCallback)
mk_ImageEvalCallback C_ImageEvalCallback
wrapped'
    a
-> Text
-> FunPtr C_ImageEvalCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"eval" FunPtr C_ImageEvalCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [eval](#signal:eval) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' image #eval callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterImageEval :: (IsImage a, MonadIO m) => a -> ((?self :: a) => ImageEvalCallback) -> m SignalHandlerId
afterImageEval :: forall a (m :: * -> *).
(IsImage a, MonadIO m) =>
a -> ((?self::a) => ImageEvalCallback) -> m SignalHandlerId
afterImageEval a
obj (?self::a) => ImageEvalCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ImageEvalCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ImageEvalCallback
ImageEvalCallback
cb
    let wrapped' :: C_ImageEvalCallback
wrapped' = (a -> ImageEvalCallback) -> C_ImageEvalCallback
forall a.
GObject a =>
(a -> ImageEvalCallback) -> C_ImageEvalCallback
wrap_ImageEvalCallback a -> ImageEvalCallback
wrapped
    FunPtr C_ImageEvalCallback
wrapped'' <- C_ImageEvalCallback -> IO (FunPtr C_ImageEvalCallback)
mk_ImageEvalCallback C_ImageEvalCallback
wrapped'
    a
-> Text
-> FunPtr C_ImageEvalCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"eval" FunPtr C_ImageEvalCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ImageEvalSignalInfo
instance SignalInfo ImageEvalSignalInfo where
    type HaskellCallbackType ImageEvalSignalInfo = ImageEvalCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ImageEvalCallback cb
        cb'' <- mk_ImageEvalCallback cb'
        connectSignalFunPtr obj "eval" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image::eval"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:signal:eval"})

#endif

-- signal Image::invalidate
-- | The [invalidate](#g:signal:invalidate) signal is emitted when an image or one of it\'s
-- upstream data sources has been destructively modified. See
-- 'GI.Vips.Objects.Image.imageInvalidateAll'.
type ImageInvalidateCallback =
    IO ()

type C_ImageInvalidateCallback =
    Ptr Image ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ImageInvalidateCallback :: 
    GObject a => (a -> ImageInvalidateCallback) ->
    C_ImageInvalidateCallback
wrap_ImageInvalidateCallback :: forall a. GObject a => (a -> IO ()) -> C_ImageInvalidateCallback
wrap_ImageInvalidateCallback a -> IO ()
gi'cb Ptr Image
gi'selfPtr Ptr ()
_ = do
    Ptr Image -> (Image -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Image
gi'selfPtr ((Image -> IO ()) -> IO ()) -> (Image -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Image
gi'self -> a -> IO ()
gi'cb (Image -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Image
gi'self) 


-- | Connect a signal handler for the [invalidate](#signal:invalidate) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' image #invalidate callback
-- @
-- 
-- 
onImageInvalidate :: (IsImage a, MonadIO m) => a -> ((?self :: a) => ImageInvalidateCallback) -> m SignalHandlerId
onImageInvalidate :: forall a (m :: * -> *).
(IsImage a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onImageInvalidate a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ImageInvalidateCallback
wrapped' = (a -> IO ()) -> C_ImageInvalidateCallback
forall a. GObject a => (a -> IO ()) -> C_ImageInvalidateCallback
wrap_ImageInvalidateCallback a -> IO ()
wrapped
    FunPtr C_ImageInvalidateCallback
wrapped'' <- C_ImageInvalidateCallback -> IO (FunPtr C_ImageInvalidateCallback)
mk_ImageInvalidateCallback C_ImageInvalidateCallback
wrapped'
    a
-> Text
-> FunPtr C_ImageInvalidateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"invalidate" FunPtr C_ImageInvalidateCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [invalidate](#signal:invalidate) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' image #invalidate callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterImageInvalidate :: (IsImage a, MonadIO m) => a -> ((?self :: a) => ImageInvalidateCallback) -> m SignalHandlerId
afterImageInvalidate :: forall a (m :: * -> *).
(IsImage a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterImageInvalidate a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ImageInvalidateCallback
wrapped' = (a -> IO ()) -> C_ImageInvalidateCallback
forall a. GObject a => (a -> IO ()) -> C_ImageInvalidateCallback
wrap_ImageInvalidateCallback a -> IO ()
wrapped
    FunPtr C_ImageInvalidateCallback
wrapped'' <- C_ImageInvalidateCallback -> IO (FunPtr C_ImageInvalidateCallback)
mk_ImageInvalidateCallback C_ImageInvalidateCallback
wrapped'
    a
-> Text
-> FunPtr C_ImageInvalidateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"invalidate" FunPtr C_ImageInvalidateCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ImageInvalidateSignalInfo
instance SignalInfo ImageInvalidateSignalInfo where
    type HaskellCallbackType ImageInvalidateSignalInfo = ImageInvalidateCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ImageInvalidateCallback cb
        cb'' <- mk_ImageInvalidateCallback cb'
        connectSignalFunPtr obj "invalidate" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image::invalidate"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:signal:invalidate"})

#endif

-- signal Image::minimise
-- | The [minimise](#g:signal:minimise) signal is emitted when an image has been asked to
-- minimise memory usage. All non-essential caches are dropped.
-- See 'GI.Vips.Objects.Image.imageMinimiseAll'.
type ImageMinimiseCallback =
    IO ()

type C_ImageMinimiseCallback =
    Ptr Image ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ImageMinimiseCallback :: 
    GObject a => (a -> ImageMinimiseCallback) ->
    C_ImageMinimiseCallback
wrap_ImageMinimiseCallback :: forall a. GObject a => (a -> IO ()) -> C_ImageInvalidateCallback
wrap_ImageMinimiseCallback a -> IO ()
gi'cb Ptr Image
gi'selfPtr Ptr ()
_ = do
    Ptr Image -> (Image -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Image
gi'selfPtr ((Image -> IO ()) -> IO ()) -> (Image -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Image
gi'self -> a -> IO ()
gi'cb (Image -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Image
gi'self) 


-- | Connect a signal handler for the [minimise](#signal:minimise) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' image #minimise callback
-- @
-- 
-- 
onImageMinimise :: (IsImage a, MonadIO m) => a -> ((?self :: a) => ImageMinimiseCallback) -> m SignalHandlerId
onImageMinimise :: forall a (m :: * -> *).
(IsImage a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onImageMinimise a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ImageInvalidateCallback
wrapped' = (a -> IO ()) -> C_ImageInvalidateCallback
forall a. GObject a => (a -> IO ()) -> C_ImageInvalidateCallback
wrap_ImageMinimiseCallback a -> IO ()
wrapped
    FunPtr C_ImageInvalidateCallback
wrapped'' <- C_ImageInvalidateCallback -> IO (FunPtr C_ImageInvalidateCallback)
mk_ImageMinimiseCallback C_ImageInvalidateCallback
wrapped'
    a
-> Text
-> FunPtr C_ImageInvalidateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"minimise" FunPtr C_ImageInvalidateCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [minimise](#signal:minimise) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' image #minimise callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterImageMinimise :: (IsImage a, MonadIO m) => a -> ((?self :: a) => ImageMinimiseCallback) -> m SignalHandlerId
afterImageMinimise :: forall a (m :: * -> *).
(IsImage a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterImageMinimise a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ImageInvalidateCallback
wrapped' = (a -> IO ()) -> C_ImageInvalidateCallback
forall a. GObject a => (a -> IO ()) -> C_ImageInvalidateCallback
wrap_ImageMinimiseCallback a -> IO ()
wrapped
    FunPtr C_ImageInvalidateCallback
wrapped'' <- C_ImageInvalidateCallback -> IO (FunPtr C_ImageInvalidateCallback)
mk_ImageMinimiseCallback C_ImageInvalidateCallback
wrapped'
    a
-> Text
-> FunPtr C_ImageInvalidateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"minimise" FunPtr C_ImageInvalidateCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ImageMinimiseSignalInfo
instance SignalInfo ImageMinimiseSignalInfo where
    type HaskellCallbackType ImageMinimiseSignalInfo = ImageMinimiseCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ImageMinimiseCallback cb
        cb'' <- mk_ImageMinimiseCallback cb'
        connectSignalFunPtr obj "minimise" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image::minimise"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:signal:minimise"})

#endif

-- signal Image::posteval
-- | The [posteval](#g:signal:posteval) signal is emitted once at the end of the computation
-- of /@image@/. It\'s a good place to shut down evaluation feedback.
-- 
-- Use 'GI.Vips.Objects.Image.imageSetProgress' to turn on progress reporting for an
-- image.
type ImagePostevalCallback =
    Vips.Progress.Progress
    -- ^ /@progress@/: t'GI.Vips.Structs.Progress.Progress' for this image
    -> IO ()

type C_ImagePostevalCallback =
    Ptr Image ->                            -- object
    Ptr Vips.Progress.Progress ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ImagePostevalCallback :: 
    GObject a => (a -> ImagePostevalCallback) ->
    C_ImagePostevalCallback
wrap_ImagePostevalCallback :: forall a.
GObject a =>
(a -> ImageEvalCallback) -> C_ImageEvalCallback
wrap_ImagePostevalCallback a -> ImageEvalCallback
gi'cb Ptr Image
gi'selfPtr Ptr Progress
progress Ptr ()
_ = do
    Progress
progress' <- ((ManagedPtr Progress -> Progress) -> Ptr Progress -> IO Progress
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Progress -> Progress
Vips.Progress.Progress) Ptr Progress
progress
    Ptr Image -> (Image -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Image
gi'selfPtr ((Image -> IO ()) -> IO ()) -> (Image -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Image
gi'self -> a -> ImageEvalCallback
gi'cb (Image -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Image
gi'self)  Progress
progress'


-- | Connect a signal handler for the [posteval](#signal:posteval) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' image #posteval callback
-- @
-- 
-- 
onImagePosteval :: (IsImage a, MonadIO m) => a -> ((?self :: a) => ImagePostevalCallback) -> m SignalHandlerId
onImagePosteval :: forall a (m :: * -> *).
(IsImage a, MonadIO m) =>
a -> ((?self::a) => ImageEvalCallback) -> m SignalHandlerId
onImagePosteval a
obj (?self::a) => ImageEvalCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ImageEvalCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ImageEvalCallback
ImageEvalCallback
cb
    let wrapped' :: C_ImageEvalCallback
wrapped' = (a -> ImageEvalCallback) -> C_ImageEvalCallback
forall a.
GObject a =>
(a -> ImageEvalCallback) -> C_ImageEvalCallback
wrap_ImagePostevalCallback a -> ImageEvalCallback
wrapped
    FunPtr C_ImageEvalCallback
wrapped'' <- C_ImageEvalCallback -> IO (FunPtr C_ImageEvalCallback)
mk_ImagePostevalCallback C_ImageEvalCallback
wrapped'
    a
-> Text
-> FunPtr C_ImageEvalCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"posteval" FunPtr C_ImageEvalCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [posteval](#signal:posteval) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' image #posteval callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterImagePosteval :: (IsImage a, MonadIO m) => a -> ((?self :: a) => ImagePostevalCallback) -> m SignalHandlerId
afterImagePosteval :: forall a (m :: * -> *).
(IsImage a, MonadIO m) =>
a -> ((?self::a) => ImageEvalCallback) -> m SignalHandlerId
afterImagePosteval a
obj (?self::a) => ImageEvalCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ImageEvalCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ImageEvalCallback
ImageEvalCallback
cb
    let wrapped' :: C_ImageEvalCallback
wrapped' = (a -> ImageEvalCallback) -> C_ImageEvalCallback
forall a.
GObject a =>
(a -> ImageEvalCallback) -> C_ImageEvalCallback
wrap_ImagePostevalCallback a -> ImageEvalCallback
wrapped
    FunPtr C_ImageEvalCallback
wrapped'' <- C_ImageEvalCallback -> IO (FunPtr C_ImageEvalCallback)
mk_ImagePostevalCallback C_ImageEvalCallback
wrapped'
    a
-> Text
-> FunPtr C_ImageEvalCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"posteval" FunPtr C_ImageEvalCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ImagePostevalSignalInfo
instance SignalInfo ImagePostevalSignalInfo where
    type HaskellCallbackType ImagePostevalSignalInfo = ImagePostevalCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ImagePostevalCallback cb
        cb'' <- mk_ImagePostevalCallback cb'
        connectSignalFunPtr obj "posteval" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image::posteval"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:signal:posteval"})

#endif

-- signal Image::preeval
-- | The [preeval](#g:signal:preeval) signal is emitted once before computation of /@image@/
-- starts. It\'s a good place to set up evaluation feedback.
-- 
-- Use 'GI.Vips.Objects.Image.imageSetProgress' to turn on progress reporting for an
-- image.
type ImagePreevalCallback =
    Vips.Progress.Progress
    -- ^ /@progress@/: t'GI.Vips.Structs.Progress.Progress' for this image
    -> IO ()

type C_ImagePreevalCallback =
    Ptr Image ->                            -- object
    Ptr Vips.Progress.Progress ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ImagePreevalCallback :: 
    GObject a => (a -> ImagePreevalCallback) ->
    C_ImagePreevalCallback
wrap_ImagePreevalCallback :: forall a.
GObject a =>
(a -> ImageEvalCallback) -> C_ImageEvalCallback
wrap_ImagePreevalCallback a -> ImageEvalCallback
gi'cb Ptr Image
gi'selfPtr Ptr Progress
progress Ptr ()
_ = do
    Progress
progress' <- ((ManagedPtr Progress -> Progress) -> Ptr Progress -> IO Progress
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Progress -> Progress
Vips.Progress.Progress) Ptr Progress
progress
    Ptr Image -> (Image -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Image
gi'selfPtr ((Image -> IO ()) -> IO ()) -> (Image -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Image
gi'self -> a -> ImageEvalCallback
gi'cb (Image -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Image
gi'self)  Progress
progress'


-- | Connect a signal handler for the [preeval](#signal:preeval) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' image #preeval callback
-- @
-- 
-- 
onImagePreeval :: (IsImage a, MonadIO m) => a -> ((?self :: a) => ImagePreevalCallback) -> m SignalHandlerId
onImagePreeval :: forall a (m :: * -> *).
(IsImage a, MonadIO m) =>
a -> ((?self::a) => ImageEvalCallback) -> m SignalHandlerId
onImagePreeval a
obj (?self::a) => ImageEvalCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ImageEvalCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ImageEvalCallback
ImageEvalCallback
cb
    let wrapped' :: C_ImageEvalCallback
wrapped' = (a -> ImageEvalCallback) -> C_ImageEvalCallback
forall a.
GObject a =>
(a -> ImageEvalCallback) -> C_ImageEvalCallback
wrap_ImagePreevalCallback a -> ImageEvalCallback
wrapped
    FunPtr C_ImageEvalCallback
wrapped'' <- C_ImageEvalCallback -> IO (FunPtr C_ImageEvalCallback)
mk_ImagePreevalCallback C_ImageEvalCallback
wrapped'
    a
-> Text
-> FunPtr C_ImageEvalCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"preeval" FunPtr C_ImageEvalCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [preeval](#signal:preeval) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' image #preeval callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterImagePreeval :: (IsImage a, MonadIO m) => a -> ((?self :: a) => ImagePreevalCallback) -> m SignalHandlerId
afterImagePreeval :: forall a (m :: * -> *).
(IsImage a, MonadIO m) =>
a -> ((?self::a) => ImageEvalCallback) -> m SignalHandlerId
afterImagePreeval a
obj (?self::a) => ImageEvalCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ImageEvalCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ImageEvalCallback
ImageEvalCallback
cb
    let wrapped' :: C_ImageEvalCallback
wrapped' = (a -> ImageEvalCallback) -> C_ImageEvalCallback
forall a.
GObject a =>
(a -> ImageEvalCallback) -> C_ImageEvalCallback
wrap_ImagePreevalCallback a -> ImageEvalCallback
wrapped
    FunPtr C_ImageEvalCallback
wrapped'' <- C_ImageEvalCallback -> IO (FunPtr C_ImageEvalCallback)
mk_ImagePreevalCallback C_ImageEvalCallback
wrapped'
    a
-> Text
-> FunPtr C_ImageEvalCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"preeval" FunPtr C_ImageEvalCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ImagePreevalSignalInfo
instance SignalInfo ImagePreevalSignalInfo where
    type HaskellCallbackType ImagePreevalSignalInfo = ImagePreevalCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ImagePreevalCallback cb
        cb'' <- mk_ImagePreevalCallback cb'
        connectSignalFunPtr obj "preeval" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image::preeval"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:signal:preeval"})

#endif

-- signal Image::written
-- | The [written](#g:signal:written) signal is emitted just after an image has been
-- written to. It is
-- used by vips to implement things like write to foreign file
-- formats.
type ImageWrittenCallback =
    IO (Int32)

type C_ImageWrittenCallback =
    Ptr Image ->                            -- object
    Ptr Int32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ImageWrittenCallback :: 
    GObject a => (a -> ImageWrittenCallback) ->
    C_ImageWrittenCallback
wrap_ImageWrittenCallback :: forall a.
GObject a =>
(a -> ImageWrittenCallback) -> C_ImageWrittenCallback
wrap_ImageWrittenCallback a -> ImageWrittenCallback
gi'cb Ptr Image
gi'selfPtr Ptr Int32
result_ Ptr ()
_ = do
    Int32
outresult_ <- Ptr Image
-> (Image -> ImageWrittenCallback) -> ImageWrittenCallback
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Image
gi'selfPtr ((Image -> ImageWrittenCallback) -> ImageWrittenCallback)
-> (Image -> ImageWrittenCallback) -> ImageWrittenCallback
forall a b. (a -> b) -> a -> b
$ \Image
gi'self -> a -> ImageWrittenCallback
gi'cb (Image -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Image
gi'self) 
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int32
result_ Int32
outresult_


-- | Connect a signal handler for the [written](#signal:written) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' image #written callback
-- @
-- 
-- 
onImageWritten :: (IsImage a, MonadIO m) => a -> ((?self :: a) => ImageWrittenCallback) -> m SignalHandlerId
onImageWritten :: forall a (m :: * -> *).
(IsImage a, MonadIO m) =>
a -> ((?self::a) => ImageWrittenCallback) -> m SignalHandlerId
onImageWritten a
obj (?self::a) => ImageWrittenCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ImageWrittenCallback
wrapped a
self = let ?self = a
?self::a
self in ImageWrittenCallback
(?self::a) => ImageWrittenCallback
cb
    let wrapped' :: C_ImageWrittenCallback
wrapped' = (a -> ImageWrittenCallback) -> C_ImageWrittenCallback
forall a.
GObject a =>
(a -> ImageWrittenCallback) -> C_ImageWrittenCallback
wrap_ImageWrittenCallback a -> ImageWrittenCallback
wrapped
    FunPtr C_ImageWrittenCallback
wrapped'' <- C_ImageWrittenCallback -> IO (FunPtr C_ImageWrittenCallback)
mk_ImageWrittenCallback C_ImageWrittenCallback
wrapped'
    a
-> Text
-> FunPtr C_ImageWrittenCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"written" FunPtr C_ImageWrittenCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [written](#signal:written) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' image #written callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterImageWritten :: (IsImage a, MonadIO m) => a -> ((?self :: a) => ImageWrittenCallback) -> m SignalHandlerId
afterImageWritten :: forall a (m :: * -> *).
(IsImage a, MonadIO m) =>
a -> ((?self::a) => ImageWrittenCallback) -> m SignalHandlerId
afterImageWritten a
obj (?self::a) => ImageWrittenCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ImageWrittenCallback
wrapped a
self = let ?self = a
?self::a
self in ImageWrittenCallback
(?self::a) => ImageWrittenCallback
cb
    let wrapped' :: C_ImageWrittenCallback
wrapped' = (a -> ImageWrittenCallback) -> C_ImageWrittenCallback
forall a.
GObject a =>
(a -> ImageWrittenCallback) -> C_ImageWrittenCallback
wrap_ImageWrittenCallback a -> ImageWrittenCallback
wrapped
    FunPtr C_ImageWrittenCallback
wrapped'' <- C_ImageWrittenCallback -> IO (FunPtr C_ImageWrittenCallback)
mk_ImageWrittenCallback C_ImageWrittenCallback
wrapped'
    a
-> Text
-> FunPtr C_ImageWrittenCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"written" FunPtr C_ImageWrittenCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ImageWrittenSignalInfo
instance SignalInfo ImageWrittenSignalInfo where
    type HaskellCallbackType ImageWrittenSignalInfo = ImageWrittenCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ImageWrittenCallback cb
        cb'' <- mk_ImageWrittenCallback cb'
        connectSignalFunPtr obj "written" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image::written"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:signal:written"})

#endif

-- VVV Prop "bands"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@bands@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #bands
-- @
getImageBands :: (MonadIO m, IsImage o) => o -> m Int32
getImageBands :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m Int32
getImageBands o
obj = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> ImageWrittenCallback
forall a. GObject a => a -> String -> ImageWrittenCallback
B.Properties.getObjectPropertyInt32 o
obj String
"bands"

-- | Set the value of the “@bands@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #bands 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageBands :: (MonadIO m, IsImage o) => o -> Int32 -> m ()
setImageBands :: forall (m :: * -> *) o.
(MonadIO m, IsImage o) =>
o -> Int32 -> m ()
setImageBands o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"bands" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@bands@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageBands :: (IsImage o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructImageBands :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructImageBands Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"bands" Int32
val

#if defined(ENABLE_OVERLOADING)
data ImageBandsPropertyInfo
instance AttrInfo ImageBandsPropertyInfo where
    type AttrAllowedOps ImageBandsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ImageBandsPropertyInfo = IsImage
    type AttrSetTypeConstraint ImageBandsPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint ImageBandsPropertyInfo = (~) Int32
    type AttrTransferType ImageBandsPropertyInfo = Int32
    type AttrGetType ImageBandsPropertyInfo = Int32
    type AttrLabel ImageBandsPropertyInfo = "bands"
    type AttrOrigin ImageBandsPropertyInfo = Image
    attrGet = getImageBands
    attrSet = setImageBands
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageBands
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.bands"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:bands"
        })
#endif

-- VVV Prop "coding"
   -- Type: TInterface (Name {namespace = "Vips", name = "Coding"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@coding@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #coding
-- @
getImageCoding :: (MonadIO m, IsImage o) => o -> m Vips.Enums.Coding
getImageCoding :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m Coding
getImageCoding o
obj = IO Coding -> m Coding
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Coding -> m Coding) -> IO Coding -> m Coding
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Coding
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"coding"

-- | Set the value of the “@coding@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #coding 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageCoding :: (MonadIO m, IsImage o) => o -> Vips.Enums.Coding -> m ()
setImageCoding :: forall (m :: * -> *) o.
(MonadIO m, IsImage o) =>
o -> Coding -> m ()
setImageCoding o
obj Coding
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Coding -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"coding" Coding
val

-- | Construct a `GValueConstruct` with valid value for the “@coding@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageCoding :: (IsImage o, MIO.MonadIO m) => Vips.Enums.Coding -> m (GValueConstruct o)
constructImageCoding :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
Coding -> m (GValueConstruct o)
constructImageCoding Coding
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Coding -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"coding" Coding
val

#if defined(ENABLE_OVERLOADING)
data ImageCodingPropertyInfo
instance AttrInfo ImageCodingPropertyInfo where
    type AttrAllowedOps ImageCodingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ImageCodingPropertyInfo = IsImage
    type AttrSetTypeConstraint ImageCodingPropertyInfo = (~) Vips.Enums.Coding
    type AttrTransferTypeConstraint ImageCodingPropertyInfo = (~) Vips.Enums.Coding
    type AttrTransferType ImageCodingPropertyInfo = Vips.Enums.Coding
    type AttrGetType ImageCodingPropertyInfo = Vips.Enums.Coding
    type AttrLabel ImageCodingPropertyInfo = "coding"
    type AttrOrigin ImageCodingPropertyInfo = Image
    attrGet = getImageCoding
    attrSet = setImageCoding
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageCoding
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.coding"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:coding"
        })
#endif

-- VVV Prop "demand"
   -- Type: TInterface (Name {namespace = "Vips", name = "DemandStyle"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@demand@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #demand
-- @
getImageDemand :: (MonadIO m, IsImage o) => o -> m Vips.Enums.DemandStyle
getImageDemand :: forall (m :: * -> *) o.
(MonadIO m, IsImage o) =>
o -> m DemandStyle
getImageDemand o
obj = IO DemandStyle -> m DemandStyle
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO DemandStyle -> m DemandStyle)
-> IO DemandStyle -> m DemandStyle
forall a b. (a -> b) -> a -> b
$ o -> String -> IO DemandStyle
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"demand"

-- | Set the value of the “@demand@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #demand 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageDemand :: (MonadIO m, IsImage o) => o -> Vips.Enums.DemandStyle -> m ()
setImageDemand :: forall (m :: * -> *) o.
(MonadIO m, IsImage o) =>
o -> DemandStyle -> m ()
setImageDemand o
obj DemandStyle
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> DemandStyle -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"demand" DemandStyle
val

-- | Construct a `GValueConstruct` with valid value for the “@demand@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageDemand :: (IsImage o, MIO.MonadIO m) => Vips.Enums.DemandStyle -> m (GValueConstruct o)
constructImageDemand :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
DemandStyle -> m (GValueConstruct o)
constructImageDemand DemandStyle
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> DemandStyle -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"demand" DemandStyle
val

#if defined(ENABLE_OVERLOADING)
data ImageDemandPropertyInfo
instance AttrInfo ImageDemandPropertyInfo where
    type AttrAllowedOps ImageDemandPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ImageDemandPropertyInfo = IsImage
    type AttrSetTypeConstraint ImageDemandPropertyInfo = (~) Vips.Enums.DemandStyle
    type AttrTransferTypeConstraint ImageDemandPropertyInfo = (~) Vips.Enums.DemandStyle
    type AttrTransferType ImageDemandPropertyInfo = Vips.Enums.DemandStyle
    type AttrGetType ImageDemandPropertyInfo = Vips.Enums.DemandStyle
    type AttrLabel ImageDemandPropertyInfo = "demand"
    type AttrOrigin ImageDemandPropertyInfo = Image
    attrGet = getImageDemand
    attrSet = setImageDemand
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageDemand
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.demand"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:demand"
        })
#endif

-- VVV Prop "filename"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@filename@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #filename
-- @
getImageFilename :: (MonadIO m, IsImage o) => o -> m T.Text
getImageFilename :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m Text
getImageFilename o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getImageFilename" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"filename"

-- | Set the value of the “@filename@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #filename 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageFilename :: (MonadIO m, IsImage o) => o -> T.Text -> m ()
setImageFilename :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> Text -> m ()
setImageFilename o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"filename" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@filename@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageFilename :: (IsImage o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructImageFilename :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructImageFilename Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"filename" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@filename@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #filename
-- @
clearImageFilename :: (MonadIO m, IsImage o) => o -> m ()
clearImageFilename :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m ()
clearImageFilename o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"filename" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data ImageFilenamePropertyInfo
instance AttrInfo ImageFilenamePropertyInfo where
    type AttrAllowedOps ImageFilenamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ImageFilenamePropertyInfo = IsImage
    type AttrSetTypeConstraint ImageFilenamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ImageFilenamePropertyInfo = (~) T.Text
    type AttrTransferType ImageFilenamePropertyInfo = T.Text
    type AttrGetType ImageFilenamePropertyInfo = T.Text
    type AttrLabel ImageFilenamePropertyInfo = "filename"
    type AttrOrigin ImageFilenamePropertyInfo = Image
    attrGet = getImageFilename
    attrSet = setImageFilename
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageFilename
    attrClear = clearImageFilename
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.filename"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:filename"
        })
#endif

-- VVV Prop "foreign-buffer"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@foreign-buffer@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #foreignBuffer
-- @
getImageForeignBuffer :: (MonadIO m, IsImage o) => o -> m (Ptr ())
getImageForeignBuffer :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m (Ptr ())
getImageForeignBuffer o
obj = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Ptr ())
forall a b. GObject a => a -> String -> IO (Ptr b)
B.Properties.getObjectPropertyPtr o
obj String
"foreign-buffer"

-- | Set the value of the “@foreign-buffer@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #foreignBuffer 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageForeignBuffer :: (MonadIO m, IsImage o) => o -> Ptr () -> m ()
setImageForeignBuffer :: forall (m :: * -> *) o.
(MonadIO m, IsImage o) =>
o -> Ptr () -> m ()
setImageForeignBuffer o
obj Ptr ()
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Ptr () -> IO ()
forall a b. GObject a => a -> String -> Ptr b -> IO ()
B.Properties.setObjectPropertyPtr o
obj String
"foreign-buffer" Ptr ()
val

-- | Construct a `GValueConstruct` with valid value for the “@foreign-buffer@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageForeignBuffer :: (IsImage o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructImageForeignBuffer :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructImageForeignBuffer Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"foreign-buffer" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data ImageForeignBufferPropertyInfo
instance AttrInfo ImageForeignBufferPropertyInfo where
    type AttrAllowedOps ImageForeignBufferPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ImageForeignBufferPropertyInfo = IsImage
    type AttrSetTypeConstraint ImageForeignBufferPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint ImageForeignBufferPropertyInfo = (~) (Ptr ())
    type AttrTransferType ImageForeignBufferPropertyInfo = Ptr ()
    type AttrGetType ImageForeignBufferPropertyInfo = (Ptr ())
    type AttrLabel ImageForeignBufferPropertyInfo = "foreign-buffer"
    type AttrOrigin ImageForeignBufferPropertyInfo = Image
    attrGet = getImageForeignBuffer
    attrSet = setImageForeignBuffer
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageForeignBuffer
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.foreignBuffer"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:foreignBuffer"
        })
#endif

-- VVV Prop "format"
   -- Type: TInterface (Name {namespace = "Vips", name = "BandFormat"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@format@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #format
-- @
getImageFormat :: (MonadIO m, IsImage o) => o -> m Vips.Enums.BandFormat
getImageFormat :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m BandFormat
getImageFormat o
obj = IO BandFormat -> m BandFormat
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO BandFormat -> m BandFormat) -> IO BandFormat -> m BandFormat
forall a b. (a -> b) -> a -> b
$ o -> String -> IO BandFormat
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"format"

-- | Set the value of the “@format@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #format 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageFormat :: (MonadIO m, IsImage o) => o -> Vips.Enums.BandFormat -> m ()
setImageFormat :: forall (m :: * -> *) o.
(MonadIO m, IsImage o) =>
o -> BandFormat -> m ()
setImageFormat o
obj BandFormat
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> BandFormat -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"format" BandFormat
val

-- | Construct a `GValueConstruct` with valid value for the “@format@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageFormat :: (IsImage o, MIO.MonadIO m) => Vips.Enums.BandFormat -> m (GValueConstruct o)
constructImageFormat :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
BandFormat -> m (GValueConstruct o)
constructImageFormat BandFormat
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> BandFormat -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"format" BandFormat
val

#if defined(ENABLE_OVERLOADING)
data ImageFormatPropertyInfo
instance AttrInfo ImageFormatPropertyInfo where
    type AttrAllowedOps ImageFormatPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ImageFormatPropertyInfo = IsImage
    type AttrSetTypeConstraint ImageFormatPropertyInfo = (~) Vips.Enums.BandFormat
    type AttrTransferTypeConstraint ImageFormatPropertyInfo = (~) Vips.Enums.BandFormat
    type AttrTransferType ImageFormatPropertyInfo = Vips.Enums.BandFormat
    type AttrGetType ImageFormatPropertyInfo = Vips.Enums.BandFormat
    type AttrLabel ImageFormatPropertyInfo = "format"
    type AttrOrigin ImageFormatPropertyInfo = Image
    attrGet = getImageFormat
    attrSet = setImageFormat
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageFormat
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.format"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:format"
        })
#endif

-- VVV Prop "height"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@height@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #height
-- @
getImageHeight :: (MonadIO m, IsImage o) => o -> m Int32
getImageHeight :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m Int32
getImageHeight o
obj = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> ImageWrittenCallback
forall a. GObject a => a -> String -> ImageWrittenCallback
B.Properties.getObjectPropertyInt32 o
obj String
"height"

-- | Set the value of the “@height@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #height 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageHeight :: (MonadIO m, IsImage o) => o -> Int32 -> m ()
setImageHeight :: forall (m :: * -> *) o.
(MonadIO m, IsImage o) =>
o -> Int32 -> m ()
setImageHeight o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"height" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@height@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageHeight :: (IsImage o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructImageHeight :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructImageHeight Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"height" Int32
val

#if defined(ENABLE_OVERLOADING)
data ImageHeightPropertyInfo
instance AttrInfo ImageHeightPropertyInfo where
    type AttrAllowedOps ImageHeightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ImageHeightPropertyInfo = IsImage
    type AttrSetTypeConstraint ImageHeightPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint ImageHeightPropertyInfo = (~) Int32
    type AttrTransferType ImageHeightPropertyInfo = Int32
    type AttrGetType ImageHeightPropertyInfo = Int32
    type AttrLabel ImageHeightPropertyInfo = "height"
    type AttrOrigin ImageHeightPropertyInfo = Image
    attrGet = getImageHeight
    attrSet = setImageHeight
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageHeight
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.height"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:height"
        })
#endif

-- VVV Prop "interpretation"
   -- Type: TInterface (Name {namespace = "Vips", name = "Interpretation"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@interpretation@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #interpretation
-- @
getImageInterpretation :: (MonadIO m, IsImage o) => o -> m Vips.Enums.Interpretation
getImageInterpretation :: forall (m :: * -> *) o.
(MonadIO m, IsImage o) =>
o -> m Interpretation
getImageInterpretation o
obj = IO Interpretation -> m Interpretation
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Interpretation -> m Interpretation)
-> IO Interpretation -> m Interpretation
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Interpretation
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"interpretation"

-- | Set the value of the “@interpretation@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #interpretation 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageInterpretation :: (MonadIO m, IsImage o) => o -> Vips.Enums.Interpretation -> m ()
setImageInterpretation :: forall (m :: * -> *) o.
(MonadIO m, IsImage o) =>
o -> Interpretation -> m ()
setImageInterpretation o
obj Interpretation
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Interpretation -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"interpretation" Interpretation
val

-- | Construct a `GValueConstruct` with valid value for the “@interpretation@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageInterpretation :: (IsImage o, MIO.MonadIO m) => Vips.Enums.Interpretation -> m (GValueConstruct o)
constructImageInterpretation :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
Interpretation -> m (GValueConstruct o)
constructImageInterpretation Interpretation
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Interpretation -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"interpretation" Interpretation
val

#if defined(ENABLE_OVERLOADING)
data ImageInterpretationPropertyInfo
instance AttrInfo ImageInterpretationPropertyInfo where
    type AttrAllowedOps ImageInterpretationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ImageInterpretationPropertyInfo = IsImage
    type AttrSetTypeConstraint ImageInterpretationPropertyInfo = (~) Vips.Enums.Interpretation
    type AttrTransferTypeConstraint ImageInterpretationPropertyInfo = (~) Vips.Enums.Interpretation
    type AttrTransferType ImageInterpretationPropertyInfo = Vips.Enums.Interpretation
    type AttrGetType ImageInterpretationPropertyInfo = Vips.Enums.Interpretation
    type AttrLabel ImageInterpretationPropertyInfo = "interpretation"
    type AttrOrigin ImageInterpretationPropertyInfo = Image
    attrGet = getImageInterpretation
    attrSet = setImageInterpretation
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageInterpretation
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.interpretation"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:interpretation"
        })
#endif

-- VVV Prop "kill"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just False)

-- | Get the value of the “@kill@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #kill
-- @
getImageKill :: (MonadIO m, IsImage o) => o -> m Bool
getImageKill :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m Bool
getImageKill o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"kill"

-- | Set the value of the “@kill@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #kill 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageKill :: (MonadIO m, IsImage o) => o -> Bool -> m ()
setImageKill :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> Bool -> m ()
setImageKill o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"kill" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@kill@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageKill :: (IsImage o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructImageKill :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructImageKill Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"kill" Bool
val

#if defined(ENABLE_OVERLOADING)
data ImageKillPropertyInfo
instance AttrInfo ImageKillPropertyInfo where
    type AttrAllowedOps ImageKillPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ImageKillPropertyInfo = IsImage
    type AttrSetTypeConstraint ImageKillPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ImageKillPropertyInfo = (~) Bool
    type AttrTransferType ImageKillPropertyInfo = Bool
    type AttrGetType ImageKillPropertyInfo = Bool
    type AttrLabel ImageKillPropertyInfo = "kill"
    type AttrOrigin ImageKillPropertyInfo = Image
    attrGet = getImageKill
    attrSet = setImageKill
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageKill
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.kill"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:kill"
        })
#endif

-- VVV Prop "mode"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #mode
-- @
getImageMode :: (MonadIO m, IsImage o) => o -> m T.Text
getImageMode :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m Text
getImageMode o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getImageMode" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"mode"

-- | Set the value of the “@mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #mode 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageMode :: (MonadIO m, IsImage o) => o -> T.Text -> m ()
setImageMode :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> Text -> m ()
setImageMode o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"mode" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@mode@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageMode :: (IsImage o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructImageMode :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructImageMode Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"mode" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@mode@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #mode
-- @
clearImageMode :: (MonadIO m, IsImage o) => o -> m ()
clearImageMode :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m ()
clearImageMode o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"mode" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data ImageModePropertyInfo
instance AttrInfo ImageModePropertyInfo where
    type AttrAllowedOps ImageModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ImageModePropertyInfo = IsImage
    type AttrSetTypeConstraint ImageModePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ImageModePropertyInfo = (~) T.Text
    type AttrTransferType ImageModePropertyInfo = T.Text
    type AttrGetType ImageModePropertyInfo = T.Text
    type AttrLabel ImageModePropertyInfo = "mode"
    type AttrOrigin ImageModePropertyInfo = Image
    attrGet = getImageMode
    attrSet = setImageMode
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageMode
    attrClear = clearImageMode
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.mode"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:mode"
        })
#endif

-- VVV Prop "sizeof-header"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@sizeof-header@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #sizeofHeader
-- @
getImageSizeofHeader :: (MonadIO m, IsImage o) => o -> m Word64
getImageSizeofHeader :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m Word64
getImageSizeofHeader o
obj = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"sizeof-header"

-- | Set the value of the “@sizeof-header@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #sizeofHeader 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageSizeofHeader :: (MonadIO m, IsImage o) => o -> Word64 -> m ()
setImageSizeofHeader :: forall (m :: * -> *) o.
(MonadIO m, IsImage o) =>
o -> Word64 -> m ()
setImageSizeofHeader o
obj Word64
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"sizeof-header" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@sizeof-header@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageSizeofHeader :: (IsImage o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructImageSizeofHeader :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructImageSizeofHeader Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"sizeof-header" Word64
val

#if defined(ENABLE_OVERLOADING)
data ImageSizeofHeaderPropertyInfo
instance AttrInfo ImageSizeofHeaderPropertyInfo where
    type AttrAllowedOps ImageSizeofHeaderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ImageSizeofHeaderPropertyInfo = IsImage
    type AttrSetTypeConstraint ImageSizeofHeaderPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint ImageSizeofHeaderPropertyInfo = (~) Word64
    type AttrTransferType ImageSizeofHeaderPropertyInfo = Word64
    type AttrGetType ImageSizeofHeaderPropertyInfo = Word64
    type AttrLabel ImageSizeofHeaderPropertyInfo = "sizeof-header"
    type AttrOrigin ImageSizeofHeaderPropertyInfo = Image
    attrGet = getImageSizeofHeader
    attrSet = setImageSizeofHeader
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageSizeofHeader
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.sizeofHeader"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:sizeofHeader"
        })
#endif

-- VVV Prop "width"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@width@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #width
-- @
getImageWidth :: (MonadIO m, IsImage o) => o -> m Int32
getImageWidth :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m Int32
getImageWidth o
obj = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> ImageWrittenCallback
forall a. GObject a => a -> String -> ImageWrittenCallback
B.Properties.getObjectPropertyInt32 o
obj String
"width"

-- | Set the value of the “@width@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #width 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageWidth :: (MonadIO m, IsImage o) => o -> Int32 -> m ()
setImageWidth :: forall (m :: * -> *) o.
(MonadIO m, IsImage o) =>
o -> Int32 -> m ()
setImageWidth o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"width" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@width@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageWidth :: (IsImage o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructImageWidth :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructImageWidth Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"width" Int32
val

#if defined(ENABLE_OVERLOADING)
data ImageWidthPropertyInfo
instance AttrInfo ImageWidthPropertyInfo where
    type AttrAllowedOps ImageWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ImageWidthPropertyInfo = IsImage
    type AttrSetTypeConstraint ImageWidthPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint ImageWidthPropertyInfo = (~) Int32
    type AttrTransferType ImageWidthPropertyInfo = Int32
    type AttrGetType ImageWidthPropertyInfo = Int32
    type AttrLabel ImageWidthPropertyInfo = "width"
    type AttrOrigin ImageWidthPropertyInfo = Image
    attrGet = getImageWidth
    attrSet = setImageWidth
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageWidth
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.width"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:width"
        })
#endif

-- VVV Prop "xoffset"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@xoffset@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #xoffset
-- @
getImageXoffset :: (MonadIO m, IsImage o) => o -> m Int32
getImageXoffset :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m Int32
getImageXoffset o
obj = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> ImageWrittenCallback
forall a. GObject a => a -> String -> ImageWrittenCallback
B.Properties.getObjectPropertyInt32 o
obj String
"xoffset"

-- | Set the value of the “@xoffset@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #xoffset 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageXoffset :: (MonadIO m, IsImage o) => o -> Int32 -> m ()
setImageXoffset :: forall (m :: * -> *) o.
(MonadIO m, IsImage o) =>
o -> Int32 -> m ()
setImageXoffset o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"xoffset" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@xoffset@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageXoffset :: (IsImage o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructImageXoffset :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructImageXoffset Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"xoffset" Int32
val

#if defined(ENABLE_OVERLOADING)
data ImageXoffsetPropertyInfo
instance AttrInfo ImageXoffsetPropertyInfo where
    type AttrAllowedOps ImageXoffsetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ImageXoffsetPropertyInfo = IsImage
    type AttrSetTypeConstraint ImageXoffsetPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint ImageXoffsetPropertyInfo = (~) Int32
    type AttrTransferType ImageXoffsetPropertyInfo = Int32
    type AttrGetType ImageXoffsetPropertyInfo = Int32
    type AttrLabel ImageXoffsetPropertyInfo = "xoffset"
    type AttrOrigin ImageXoffsetPropertyInfo = Image
    attrGet = getImageXoffset
    attrSet = setImageXoffset
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageXoffset
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.xoffset"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:xoffset"
        })
#endif

-- VVV Prop "xres"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@xres@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #xres
-- @
getImageXres :: (MonadIO m, IsImage o) => o -> m Double
getImageXres :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m Double
getImageXres o
obj = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Double
forall a. GObject a => a -> String -> IO Double
B.Properties.getObjectPropertyDouble o
obj String
"xres"

-- | Set the value of the “@xres@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #xres 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageXres :: (MonadIO m, IsImage o) => o -> Double -> m ()
setImageXres :: forall (m :: * -> *) o.
(MonadIO m, IsImage o) =>
o -> Double -> m ()
setImageXres o
obj Double
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"xres" Double
val

-- | Construct a `GValueConstruct` with valid value for the “@xres@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageXres :: (IsImage o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructImageXres :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
Double -> m (GValueConstruct o)
constructImageXres Double
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Double -> IO (GValueConstruct o)
forall o. String -> Double -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyDouble String
"xres" Double
val

#if defined(ENABLE_OVERLOADING)
data ImageXresPropertyInfo
instance AttrInfo ImageXresPropertyInfo where
    type AttrAllowedOps ImageXresPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ImageXresPropertyInfo = IsImage
    type AttrSetTypeConstraint ImageXresPropertyInfo = (~) Double
    type AttrTransferTypeConstraint ImageXresPropertyInfo = (~) Double
    type AttrTransferType ImageXresPropertyInfo = Double
    type AttrGetType ImageXresPropertyInfo = Double
    type AttrLabel ImageXresPropertyInfo = "xres"
    type AttrOrigin ImageXresPropertyInfo = Image
    attrGet = getImageXres
    attrSet = setImageXres
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageXres
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.xres"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:xres"
        })
#endif

-- VVV Prop "yoffset"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@yoffset@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #yoffset
-- @
getImageYoffset :: (MonadIO m, IsImage o) => o -> m Int32
getImageYoffset :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m Int32
getImageYoffset o
obj = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> ImageWrittenCallback
forall a. GObject a => a -> String -> ImageWrittenCallback
B.Properties.getObjectPropertyInt32 o
obj String
"yoffset"

-- | Set the value of the “@yoffset@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #yoffset 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageYoffset :: (MonadIO m, IsImage o) => o -> Int32 -> m ()
setImageYoffset :: forall (m :: * -> *) o.
(MonadIO m, IsImage o) =>
o -> Int32 -> m ()
setImageYoffset o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"yoffset" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@yoffset@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageYoffset :: (IsImage o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructImageYoffset :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructImageYoffset Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"yoffset" Int32
val

#if defined(ENABLE_OVERLOADING)
data ImageYoffsetPropertyInfo
instance AttrInfo ImageYoffsetPropertyInfo where
    type AttrAllowedOps ImageYoffsetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ImageYoffsetPropertyInfo = IsImage
    type AttrSetTypeConstraint ImageYoffsetPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint ImageYoffsetPropertyInfo = (~) Int32
    type AttrTransferType ImageYoffsetPropertyInfo = Int32
    type AttrGetType ImageYoffsetPropertyInfo = Int32
    type AttrLabel ImageYoffsetPropertyInfo = "yoffset"
    type AttrOrigin ImageYoffsetPropertyInfo = Image
    attrGet = getImageYoffset
    attrSet = setImageYoffset
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageYoffset
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.yoffset"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:yoffset"
        })
#endif

-- VVV Prop "yres"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@yres@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' image #yres
-- @
getImageYres :: (MonadIO m, IsImage o) => o -> m Double
getImageYres :: forall (m :: * -> *) o. (MonadIO m, IsImage o) => o -> m Double
getImageYres o
obj = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Double
forall a. GObject a => a -> String -> IO Double
B.Properties.getObjectPropertyDouble o
obj String
"yres"

-- | Set the value of the “@yres@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' image [ #yres 'Data.GI.Base.Attributes.:=' value ]
-- @
setImageYres :: (MonadIO m, IsImage o) => o -> Double -> m ()
setImageYres :: forall (m :: * -> *) o.
(MonadIO m, IsImage o) =>
o -> Double -> m ()
setImageYres o
obj Double
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"yres" Double
val

-- | Construct a `GValueConstruct` with valid value for the “@yres@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructImageYres :: (IsImage o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructImageYres :: forall o (m :: * -> *).
(IsImage o, MonadIO m) =>
Double -> m (GValueConstruct o)
constructImageYres Double
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Double -> IO (GValueConstruct o)
forall o. String -> Double -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyDouble String
"yres" Double
val

#if defined(ENABLE_OVERLOADING)
data ImageYresPropertyInfo
instance AttrInfo ImageYresPropertyInfo where
    type AttrAllowedOps ImageYresPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ImageYresPropertyInfo = IsImage
    type AttrSetTypeConstraint ImageYresPropertyInfo = (~) Double
    type AttrTransferTypeConstraint ImageYresPropertyInfo = (~) Double
    type AttrTransferType ImageYresPropertyInfo = Double
    type AttrGetType ImageYresPropertyInfo = Double
    type AttrLabel ImageYresPropertyInfo = "yres"
    type AttrOrigin ImageYresPropertyInfo = Image
    attrGet = getImageYres
    attrSet = setImageYres
    attrTransfer _ v = do
        return v
    attrConstruct = constructImageYres
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.yres"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#g:attr:yres"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Image
type instance O.AttributeList Image = ImageAttributeList
type ImageAttributeList = ('[ '("bands", ImageBandsPropertyInfo), '("coding", ImageCodingPropertyInfo), '("demand", ImageDemandPropertyInfo), '("description", Vips.Object.ObjectDescriptionPropertyInfo), '("filename", ImageFilenamePropertyInfo), '("foreignBuffer", ImageForeignBufferPropertyInfo), '("format", ImageFormatPropertyInfo), '("height", ImageHeightPropertyInfo), '("interpretation", ImageInterpretationPropertyInfo), '("kill", ImageKillPropertyInfo), '("mode", ImageModePropertyInfo), '("nickname", Vips.Object.ObjectNicknamePropertyInfo), '("sizeofHeader", ImageSizeofHeaderPropertyInfo), '("width", ImageWidthPropertyInfo), '("xoffset", ImageXoffsetPropertyInfo), '("xres", ImageXresPropertyInfo), '("yoffset", ImageYoffsetPropertyInfo), '("yres", ImageYresPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
imageBands :: AttrLabelProxy "bands"
imageBands = AttrLabelProxy

imageCoding :: AttrLabelProxy "coding"
imageCoding = AttrLabelProxy

imageDemand :: AttrLabelProxy "demand"
imageDemand = AttrLabelProxy

imageFilename :: AttrLabelProxy "filename"
imageFilename = AttrLabelProxy

imageForeignBuffer :: AttrLabelProxy "foreignBuffer"
imageForeignBuffer = AttrLabelProxy

imageFormat :: AttrLabelProxy "format"
imageFormat = AttrLabelProxy

imageHeight :: AttrLabelProxy "height"
imageHeight = AttrLabelProxy

imageInterpretation :: AttrLabelProxy "interpretation"
imageInterpretation = AttrLabelProxy

imageKill :: AttrLabelProxy "kill"
imageKill = AttrLabelProxy

imageMode :: AttrLabelProxy "mode"
imageMode = AttrLabelProxy

imageSizeofHeader :: AttrLabelProxy "sizeofHeader"
imageSizeofHeader = AttrLabelProxy

imageWidth :: AttrLabelProxy "width"
imageWidth = AttrLabelProxy

imageXoffset :: AttrLabelProxy "xoffset"
imageXoffset = AttrLabelProxy

imageXres :: AttrLabelProxy "xres"
imageXres = AttrLabelProxy

imageYoffset :: AttrLabelProxy "yoffset"
imageYoffset = AttrLabelProxy

imageYres :: AttrLabelProxy "yres"
imageYres = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Image = ImageSignalList
type ImageSignalList = ('[ '("close", Vips.Object.ObjectCloseSignalInfo), '("eval", ImageEvalSignalInfo), '("invalidate", ImageInvalidateSignalInfo), '("minimise", ImageMinimiseSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("postbuild", Vips.Object.ObjectPostbuildSignalInfo), '("postclose", Vips.Object.ObjectPostcloseSignalInfo), '("posteval", ImagePostevalSignalInfo), '("preclose", Vips.Object.ObjectPrecloseSignalInfo), '("preeval", ImagePreevalSignalInfo), '("written", ImageWrittenSignalInfo)] :: [(Symbol, *)])

#endif

-- method Image::memory
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Image" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_memory" vips_image_memory :: 
    IO (Ptr Image)

-- | A renamed @/vips_image_new_memory()/@ ... Some gobject binding systems do not
-- like more than one @/_new()/@ method.
-- 
-- See also: @/vips_image_new_memory()/@.
imageMemory ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Image
    -- ^ __Returns:__ the new t'GI.Vips.Objects.Image.Image', or 'P.Nothing' on error.
imageMemory :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Image
imageMemory  = IO Image -> m Image
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Image -> m Image) -> IO Image -> m Image
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
result <- IO (Ptr Image)
vips_image_memory
    Text -> Ptr Image -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageMemory" Ptr Image
result
    Image
result' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
result
    Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Image::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Image" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_new" vips_image_new :: 
    IO (Ptr Image)

-- | 'GI.Vips.Objects.Image.imageNew' creates a new, empty t'GI.Vips.Objects.Image.Image'.
-- If you write to one of these images, vips will just attach some callbacks,
-- no pixels will be generated.
-- 
-- Write pixels to an image with @/vips_image_generate()/@ or
-- 'GI.Vips.Objects.Image.imageWriteLine'. Write a whole image to another image with
-- 'GI.Vips.Objects.Image.imageWrite'.
imageNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Image
    -- ^ __Returns:__ the new t'GI.Vips.Objects.Image.Image', or 'P.Nothing' on error.
imageNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Image
imageNew  = IO Image -> m Image
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Image -> m Image) -> IO Image -> m Image
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
result <- IO (Ptr Image)
vips_image_new
    Text -> Ptr Image -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageNew" Ptr Image
result
    Image
result' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
result
    Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "vips_image_new_from_file_RW" vips_image_new_from_file_RW :: 
    CString ->                              -- filename : TBasicType TUTF8
    IO (Ptr Image)

-- | Opens the named file for simultaneous reading and writing. This will only
-- work for VIPS files in a format native to your machine. It is only for
-- paintbox-type applications.
-- 
-- See also: @/vips_draw_circle()/@.
imageNewFromFileRW ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@filename@/: filename to open
    -> m Image
    -- ^ __Returns:__ the new t'GI.Vips.Objects.Image.Image', or 'P.Nothing' on error.
imageNewFromFileRW :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m Image
imageNewFromFileRW Text
filename = IO Image -> m Image
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Image -> m Image) -> IO Image -> m Image
forall a b. (a -> b) -> a -> b
$ do
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    Ptr Image
result <- CString -> IO (Ptr Image)
vips_image_new_from_file_RW CString
filename'
    Text -> Ptr Image -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageNewFromFileRW" Ptr Image
result
    Image
result' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Image::new_from_file_raw
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "filename to open" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "xsize"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image width" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ysize"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image height" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bands"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image bands (or bytes per pixel)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "bytes to skip at start of file"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Image" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_new_from_file_raw" vips_image_new_from_file_raw :: 
    CString ->                              -- filename : TBasicType TUTF8
    Int32 ->                                -- xsize : TBasicType TInt
    Int32 ->                                -- ysize : TBasicType TInt
    Int32 ->                                -- bands : TBasicType TInt
    Word64 ->                               -- offset : TBasicType TUInt64
    IO (Ptr Image)

-- | This function maps the named file and returns a t'GI.Vips.Objects.Image.Image' you can use to
-- read it.
-- 
-- It returns an 8-bit image with /@bands@/ bands. If the image is not 8-bit, use
-- @/vips_copy()/@ to transform the descriptor after loading it.
-- 
-- See also: @/vips_copy()/@, @/vips_rawload()/@, @/vips_image_new_from_file()/@.
imageNewFromFileRaw ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@filename@/: filename to open
    -> Int32
    -- ^ /@xsize@/: image width
    -> Int32
    -- ^ /@ysize@/: image height
    -> Int32
    -- ^ /@bands@/: image bands (or bytes per pixel)
    -> Word64
    -- ^ /@offset@/: bytes to skip at start of file
    -> m Image
    -- ^ __Returns:__ the new t'GI.Vips.Objects.Image.Image', or 'P.Nothing' on error.
imageNewFromFileRaw :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Int32 -> Int32 -> Int32 -> Word64 -> m Image
imageNewFromFileRaw Text
filename Int32
xsize Int32
ysize Int32
bands Word64
offset = IO Image -> m Image
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Image -> m Image) -> IO Image -> m Image
forall a b. (a -> b) -> a -> b
$ do
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    Ptr Image
result <- CString -> Int32 -> Int32 -> Int32 -> Word64 -> IO (Ptr Image)
vips_image_new_from_file_raw CString
filename' Int32
xsize Int32
ysize Int32
bands Word64
offset
    Text -> Ptr Image -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageNewFromFileRaw" Ptr Image
result
    Image
result' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Image::new_from_image
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to copy" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "c"
--           , argType = TCArray False (-1) 2 (TBasicType TDouble)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "array of constants" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of constants"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of constants"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Image" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_new_from_image" vips_image_new_from_image :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    Ptr CDouble ->                          -- c : TCArray False (-1) 2 (TBasicType TDouble)
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr Image)

-- | Creates a new image with width, height, format, interpretation, resolution
-- and offset taken from /@image@/, but with number of bands taken from /@n@/ and the
-- value of each band element set from /@c@/.
-- 
-- See also: 'GI.Vips.Objects.Image.imageNewFromImage1'
imageNewFromImage ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to copy
    -> [Double]
    -- ^ /@c@/: array of constants
    -> m Image
    -- ^ __Returns:__ the new t'GI.Vips.Objects.Image.Image', or 'P.Nothing' on error.
imageNewFromImage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> [Double] -> m Image
imageNewFromImage a
image [Double]
c = IO Image -> m Image
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Image -> m Image) -> IO Image -> m Image
forall a b. (a -> b) -> a -> b
$ do
    let n :: Int32
n = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Double]
c
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Ptr CDouble
c' <- ((Double -> CDouble) -> [Double] -> IO (Ptr CDouble)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac) [Double]
c
    Ptr Image
result <- Ptr Image -> Ptr CDouble -> Int32 -> IO (Ptr Image)
vips_image_new_from_image Ptr Image
image' Ptr CDouble
c' Int32
n
    Text -> Ptr Image -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageNewFromImage" Ptr Image
result
    Image
result' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
c'
    Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Image::new_from_image1
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to copy" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "c"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "constants" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Image" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_new_from_image1" vips_image_new_from_image1 :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CDouble ->                              -- c : TBasicType TDouble
    IO (Ptr Image)

-- | Creates a new image with width, height, format, interpretation, resolution
-- and offset taken from /@image@/, but with one band and each pixel having the
-- value /@c@/.
-- 
-- See also: 'GI.Vips.Objects.Image.imageNewFromImage'
imageNewFromImage1 ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to copy
    -> Double
    -- ^ /@c@/: constants
    -> m Image
    -- ^ __Returns:__ the new t'GI.Vips.Objects.Image.Image', or 'P.Nothing' on error.
imageNewFromImage1 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Double -> m Image
imageNewFromImage1 a
image Double
c = IO Image -> m Image
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Image -> m Image) -> IO Image -> m Image
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    let c' :: CDouble
c' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
c
    Ptr Image
result <- Ptr Image -> CDouble -> IO (Ptr Image)
vips_image_new_from_image1 Ptr Image
image' CDouble
c'
    Text -> Ptr Image -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageNewFromImage1" Ptr Image
result
    Image
result' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Image::new_from_memory
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 1 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start of memory area"
--                 , 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 "length of memory area"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image width" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image height" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bands"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image bands (or bytes per pixel)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "BandFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image format" , 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 "length of memory area"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Image" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_new_from_memory" vips_image_new_from_memory :: 
    Ptr Word8 ->                            -- data : TCArray False (-1) 1 (TBasicType TUInt8)
    Word64 ->                               -- size : TBasicType TUInt64
    Int32 ->                                -- width : TBasicType TInt
    Int32 ->                                -- height : TBasicType TInt
    Int32 ->                                -- bands : TBasicType TInt
    CInt ->                                 -- format : TInterface (Name {namespace = "Vips", name = "BandFormat"})
    IO (Ptr Image)

-- | This function wraps a t'GI.Vips.Objects.Image.Image' around a memory area. The memory area
-- must be a simple array, for example RGBRGBRGB, left-to-right,
-- top-to-bottom. Use @/vips_image_new_from_buffer()/@ to load an area of memory
-- containing an image in a format.
-- 
-- VIPS does not take
-- responsibility for the area of memory, it\'s up to you to make sure it\'s
-- freed when the image is closed. See for example [Object::close]("GI.Vips.Objects.Object#g:signal:close").
-- 
-- Because VIPS is \"borrowing\" /@data@/ from the caller, this function is
-- extremely dangerous. Unless you are very careful, you will get crashes or
-- memory corruption. Use 'GI.Vips.Objects.Image.imageNewFromMemoryCopy' instead if you are
-- at all unsure.
-- 
-- Use @/vips_copy()/@ to set other image properties.
-- 
-- See also: 'GI.Vips.Objects.Image.imageNew', 'GI.Vips.Objects.Image.imageWriteToMemory',
-- 'GI.Vips.Objects.Image.imageNewFromMemoryCopy'.
imageNewFromMemory ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@data@/: start of memory area
    -> Int32
    -- ^ /@width@/: image width
    -> Int32
    -- ^ /@height@/: image height
    -> Int32
    -- ^ /@bands@/: image bands (or bytes per pixel)
    -> Vips.Enums.BandFormat
    -- ^ /@format@/: image format
    -> m Image
    -- ^ __Returns:__ the new t'GI.Vips.Objects.Image.Image', or 'P.Nothing' on error.
imageNewFromMemory :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> Int32 -> Int32 -> Int32 -> BandFormat -> m Image
imageNewFromMemory ByteString
data_ Int32
width Int32
height Int32
bands BandFormat
format = IO Image -> m Image
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Image -> m Image) -> IO Image -> m Image
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_
    let format' :: CInt
format' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (BandFormat -> Int) -> BandFormat -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BandFormat -> Int
forall a. Enum a => a -> Int
fromEnum) BandFormat
format
    Ptr Image
result <- Ptr Word8
-> Word64 -> Int32 -> Int32 -> Int32 -> CInt -> IO (Ptr Image)
vips_image_new_from_memory Ptr Word8
data_' Word64
size Int32
width Int32
height Int32
bands CInt
format'
    Text -> Ptr Image -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageNewFromMemory" Ptr Image
result
    Image
result' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
result
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Image::new_from_memory_copy
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 1 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "start of memory area"
--                 , 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 "length of memory area"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image width" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image height" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bands"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image bands (or bytes per pixel)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "BandFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image format" , 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 "length of memory area"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Image" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_new_from_memory_copy" vips_image_new_from_memory_copy :: 
    Ptr Word8 ->                            -- data : TCArray False (-1) 1 (TBasicType TUInt8)
    Word64 ->                               -- size : TBasicType TUInt64
    Int32 ->                                -- width : TBasicType TInt
    Int32 ->                                -- height : TBasicType TInt
    Int32 ->                                -- bands : TBasicType TInt
    CInt ->                                 -- format : TInterface (Name {namespace = "Vips", name = "BandFormat"})
    IO (Ptr Image)

-- | Like 'GI.Vips.Objects.Image.imageNewFromMemory', but VIPS will make a copy of the memory
-- area. This means more memory use and an extra copy operation, but is much
-- simpler and safer.
-- 
-- See also: 'GI.Vips.Objects.Image.imageNewFromMemory'.
imageNewFromMemoryCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@data@/: start of memory area
    -> Int32
    -- ^ /@width@/: image width
    -> Int32
    -- ^ /@height@/: image height
    -> Int32
    -- ^ /@bands@/: image bands (or bytes per pixel)
    -> Vips.Enums.BandFormat
    -- ^ /@format@/: image format
    -> m Image
    -- ^ __Returns:__ the new t'GI.Vips.Objects.Image.Image', or 'P.Nothing' on error.
imageNewFromMemoryCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> Int32 -> Int32 -> Int32 -> BandFormat -> m Image
imageNewFromMemoryCopy ByteString
data_ Int32
width Int32
height Int32
bands BandFormat
format = IO Image -> m Image
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Image -> m Image) -> IO Image -> m Image
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_
    let format' :: CInt
format' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (BandFormat -> Int) -> BandFormat -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BandFormat -> Int
forall a. Enum a => a -> Int
fromEnum) BandFormat
format
    Ptr Image
result <- Ptr Word8
-> Word64 -> Int32 -> Int32 -> Int32 -> CInt -> IO (Ptr Image)
vips_image_new_from_memory_copy Ptr Word8
data_' Word64
size Int32
width Int32
height Int32
bands CInt
format'
    Text -> Ptr Image -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageNewFromMemoryCopy" Ptr Image
result
    Image
result' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
result
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Image::new_matrix
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image width" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image height" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Image" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_new_matrix" vips_image_new_matrix :: 
    Int32 ->                                -- width : TBasicType TInt
    Int32 ->                                -- height : TBasicType TInt
    IO (Ptr Image)

-- | This convenience function makes an image which is a matrix: a one-band
-- @/VIPS_FORMAT_DOUBLE/@ image held in memory.
-- 
-- Use @/VIPS_IMAGE_ADDR()/@, or @/VIPS_MATRIX()/@ to address pixels in the image.
-- 
-- Use 'GI.Vips.Objects.Image.imageSetDouble' to set \"scale\" and \"offset\", if required.
-- 
-- See also: @/vips_image_new_matrixv()/@
imageNewMatrix ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@width@/: image width
    -> Int32
    -- ^ /@height@/: image height
    -> m Image
    -- ^ __Returns:__ the new t'GI.Vips.Objects.Image.Image', or 'P.Nothing' on error.
imageNewMatrix :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> Int32 -> m Image
imageNewMatrix Int32
width Int32
height = IO Image -> m Image
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Image -> m Image) -> IO Image -> m Image
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
result <- Int32 -> Int32 -> IO (Ptr Image)
vips_image_new_matrix Int32
width Int32
height
    Text -> Ptr Image -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageNewMatrix" Ptr Image
result
    Image
result' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
result
    Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Image::new_matrix_from_array
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image width" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image height" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "array"
--           , argType = TCArray False (-1) 3 (TBasicType TDouble)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "array of elements" , 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 elements" , 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 elements" , sinceVersion = Nothing }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Image" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_new_matrix_from_array" vips_image_new_matrix_from_array :: 
    Int32 ->                                -- width : TBasicType TInt
    Int32 ->                                -- height : TBasicType TInt
    Ptr CDouble ->                          -- array : TCArray False (-1) 3 (TBasicType TDouble)
    Word64 ->                               -- size : TBasicType TUInt64
    IO (Ptr Image)

-- | A binding-friendly version of @/vips_image_new_matrixv()/@.
imageNewMatrixFromArray ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@width@/: image width
    -> Int32
    -- ^ /@height@/: image height
    -> [Double]
    -- ^ /@array@/: array of elements
    -> m Image
    -- ^ __Returns:__ the new t'GI.Vips.Objects.Image.Image', or 'P.Nothing' on error.
imageNewMatrixFromArray :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> Int32 -> [Double] -> m Image
imageNewMatrixFromArray Int32
width Int32
height [Double]
array = IO Image -> m Image
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Image -> m Image) -> IO Image -> m Image
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
$ [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Double]
array
    Ptr CDouble
array' <- ((Double -> CDouble) -> [Double] -> IO (Ptr CDouble)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac) [Double]
array
    Ptr Image
result <- Int32 -> Int32 -> Ptr CDouble -> Word64 -> IO (Ptr Image)
vips_image_new_matrix_from_array Int32
width Int32
height Ptr CDouble
array' Word64
size
    Text -> Ptr Image -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageNewMatrixFromArray" Ptr Image
result
    Image
result' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
result
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
array'
    Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Image::new_temp_file
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "format"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "format of file" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Image" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_new_temp_file" vips_image_new_temp_file :: 
    CString ->                              -- format : TBasicType TUTF8
    IO (Ptr Image)

-- | Make a t'GI.Vips.Objects.Image.Image' which, when written to, will create a temporary file on
-- disc. The file will be automatically deleted when the image is destroyed.
-- /@format@/ is something like \"&percnt;s.v\" for a vips file.
-- 
-- The file is created in the temporary directory. This is set with the
-- environment variable TMPDIR. If this is not set, then on Unix systems, vips
-- will default to \/tmp. On Windows, vips uses @/GetTempPath()/@ to find the
-- temporary directory.
-- 
-- See also: 'GI.Vips.Objects.Image.imageNew'.
imageNewTempFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@format@/: format of file
    -> m Image
    -- ^ __Returns:__ the new t'GI.Vips.Objects.Image.Image', or 'P.Nothing' on error.
imageNewTempFile :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m Image
imageNewTempFile Text
format = IO Image -> m Image
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Image -> m Image) -> IO Image -> m Image
forall a b. (a -> b) -> a -> b
$ do
    CString
format' <- Text -> IO CString
textToCString Text
format
    Ptr Image
result <- CString -> IO (Ptr Image)
vips_image_new_temp_file CString
format'
    Text -> Ptr Image -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageNewTempFile" Ptr Image
result
    Image
result' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
format'
    Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Image::autorot_remove_angle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to remove orientation from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_autorot_remove_angle" vips_autorot_remove_angle :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO ()

-- | Remove the orientation tag on /@image@/. Also remove any exif orientation tags.
-- You must @/vips_copy()/@ the image before calling this function since it
-- modifies metadata.
imageAutorotRemoveAngle ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to remove orientation from
    -> m ()
imageAutorotRemoveAngle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m ()
imageAutorotRemoveAngle a
image = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Ptr Image -> IO ()
vips_autorot_remove_angle Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageAutorotRemoveAngleMethodInfo
instance (signature ~ (m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageAutorotRemoveAngleMethodInfo a signature where
    overloadedMethod = imageAutorotRemoveAngle

instance O.OverloadedMethodInfo ImageAutorotRemoveAngleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageAutorotRemoveAngle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageAutorotRemoveAngle"
        })


#endif

-- method Image::colourspace_issupported
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input image" , 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_colourspace_issupported" vips_colourspace_issupported :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CInt

-- | Test if /@image@/ is in a colourspace that @/vips_colourspace()/@ can process.
imageColourspaceIssupported ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: input image
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@image@/ is in a supported colourspace.
imageColourspaceIssupported :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Bool
imageColourspaceIssupported a
image = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CInt
result <- Ptr Image -> IO CInt
vips_colourspace_issupported Ptr Image
image'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ImageColourspaceIssupportedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsImage a) => O.OverloadedMethod ImageColourspaceIssupportedMethodInfo a signature where
    overloadedMethod = imageColourspaceIssupported

instance O.OverloadedMethodInfo ImageColourspaceIssupportedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageColourspaceIssupported",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageColourspaceIssupported"
        })


#endif

-- method Image::copy_memory
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to copy to a memory buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Image" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_copy_memory" vips_image_copy_memory :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO (Ptr Image)

-- | This function allocates memory, renders /@image@/ into it, builds a new
-- image around the memory area, and returns that.
-- 
-- If the image is already a simple area of memory, it just refs /@image@/ and
-- returns it.
-- 
-- Call this before using the draw operations to make sure you have a
-- memory image that can be modified.
-- 
-- @/vips_copy()/@ adds a null \"copy\" node to a pipeline. Use that
-- instead if you want to change metadata and not pixels.
-- 
-- This operation is thread-safe, unlike 'GI.Vips.Objects.Image.imageWioInput'.
-- 
-- If you are sure that /@image@/ is not shared with another thread (perhaps you
-- have made it yourself), use 'GI.Vips.Objects.Image.imageWioInput' instead.
-- 
-- See also: 'GI.Vips.Objects.Image.imageWioInput'.
imageCopyMemory ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to copy to a memory buffer
    -> m Image
    -- ^ __Returns:__ the new t'GI.Vips.Objects.Image.Image', or 'P.Nothing' on error.
imageCopyMemory :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Image
imageCopyMemory a
image = IO Image -> m Image
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Image -> m Image) -> IO Image -> m Image
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Ptr Image
result <- Ptr Image -> IO (Ptr Image)
vips_image_copy_memory Ptr Image
image'
    Text -> Ptr Image -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageCopyMemory" Ptr Image
result
    Image
result' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image
result'

#if defined(ENABLE_OVERLOADING)
data ImageCopyMemoryMethodInfo
instance (signature ~ (m Image), MonadIO m, IsImage a) => O.OverloadedMethod ImageCopyMemoryMethodInfo a signature where
    overloadedMethod = imageCopyMemory

instance O.OverloadedMethodInfo ImageCopyMemoryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageCopyMemory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageCopyMemory"
        })


#endif

-- method Image::decode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "in"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to decode" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "write to this image"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_decode" vips_image_decode :: 
    Ptr Image ->                            -- in : TInterface (Name {namespace = "Vips", name = "Image"})
    Ptr (Ptr Image) ->                      -- out : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | A convenience function to unpack to a format that we can compute with.
-- /@out@/.coding is always @/VIPS_CODING_NONE/@.
-- 
-- This unpacks LABQ to plain LAB. Use @/vips_LabQ2LabS()/@ for a bit more speed
-- if you need it.
-- 
-- See also: 'GI.Vips.Objects.Image.imageEncode', @/vips_LabQ2Lab()/@, @/vips_rad2float()/@.
imageDecode ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@in@/: image to decode
    -> m ((Int32, Image))
    -- ^ __Returns:__ 0 on success, or -1 on error.
imageDecode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m (Int32, Image)
imageDecode a
in_ = IO (Int32, Image) -> m (Int32, Image)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Image) -> m (Int32, Image))
-> IO (Int32, Image) -> m (Int32, Image)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
in_' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
in_
    Ptr (Ptr Image)
out <- IO (Ptr (Ptr Image))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Image))
    Int32
result <- Ptr Image -> Ptr (Ptr Image) -> ImageWrittenCallback
vips_image_decode Ptr Image
in_' Ptr (Ptr Image)
out
    Ptr Image
out' <- Ptr (Ptr Image) -> IO (Ptr Image)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Image)
out
    Image
out'' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
out'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
in_
    Ptr (Ptr Image) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Image)
out
    (Int32, Image) -> IO (Int32, Image)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Image
out'')

#if defined(ENABLE_OVERLOADING)
data ImageDecodeMethodInfo
instance (signature ~ (m ((Int32, Image))), MonadIO m, IsImage a) => O.OverloadedMethod ImageDecodeMethodInfo a signature where
    overloadedMethod = imageDecode

instance O.OverloadedMethodInfo ImageDecodeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageDecode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageDecode"
        })


#endif

-- method Image::decode_predict
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "in"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to decode" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bands"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "predict bands here" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "BandFormat" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "predict format here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_decode_predict" vips_image_decode_predict :: 
    Ptr Image ->                            -- in : TInterface (Name {namespace = "Vips", name = "Image"})
    Ptr Int32 ->                            -- bands : TBasicType TInt
    Ptr CInt ->                             -- format : TInterface (Name {namespace = "Vips", name = "BandFormat"})
    IO Int32

-- | We often need to know what an image will decode to without actually
-- decoding it, for example, in arg checking.
-- 
-- See also: 'GI.Vips.Objects.Image.imageDecode'.
imageDecodePredict ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@in@/: image to decode
    -> m ((Int32, Int32, Vips.Enums.BandFormat))
imageDecodePredict :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m (Int32, Int32, BandFormat)
imageDecodePredict a
in_ = IO (Int32, Int32, BandFormat) -> m (Int32, Int32, BandFormat)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32, BandFormat) -> m (Int32, Int32, BandFormat))
-> IO (Int32, Int32, BandFormat) -> m (Int32, Int32, BandFormat)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
in_' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
in_
    Ptr Int32
bands <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr CInt
format <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Int32
result <- Ptr Image -> Ptr Int32 -> Ptr CInt -> ImageWrittenCallback
vips_image_decode_predict Ptr Image
in_' Ptr Int32
bands Ptr CInt
format
    Int32
bands' <- Ptr Int32 -> ImageWrittenCallback
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
bands
    CInt
format' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
format
    let format'' :: BandFormat
format'' = (Int -> BandFormat
forall a. Enum a => Int -> a
toEnum (Int -> BandFormat) -> (CInt -> Int) -> CInt -> BandFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
format'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
in_
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
bands
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
format
    (Int32, Int32, BandFormat) -> IO (Int32, Int32, BandFormat)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Int32
bands', BandFormat
format'')

#if defined(ENABLE_OVERLOADING)
data ImageDecodePredictMethodInfo
instance (signature ~ (m ((Int32, Int32, Vips.Enums.BandFormat))), MonadIO m, IsImage a) => O.OverloadedMethod ImageDecodePredictMethodInfo a signature where
    overloadedMethod = imageDecodePredict

instance O.OverloadedMethodInfo ImageDecodePredictMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageDecodePredict",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageDecodePredict"
        })


#endif

-- method Image::encode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "in"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to encode" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "write to this image"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "coding"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Coding" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "coding to apply" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_encode" vips_image_encode :: 
    Ptr Image ->                            -- in : TInterface (Name {namespace = "Vips", name = "Image"})
    Ptr (Ptr Image) ->                      -- out : TInterface (Name {namespace = "Vips", name = "Image"})
    CInt ->                                 -- coding : TInterface (Name {namespace = "Vips", name = "Coding"})
    IO Int32

-- | A convenience function to pack to a coding. The inverse of
-- 'GI.Vips.Objects.Image.imageDecode'.
-- 
-- See also: 'GI.Vips.Objects.Image.imageDecode'.
imageEncode ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@in@/: image to encode
    -> Vips.Enums.Coding
    -- ^ /@coding@/: coding to apply
    -> m ((Int32, Image))
    -- ^ __Returns:__ 0 on success, or -1 on error.
imageEncode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Coding -> m (Int32, Image)
imageEncode a
in_ Coding
coding = IO (Int32, Image) -> m (Int32, Image)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Image) -> m (Int32, Image))
-> IO (Int32, Image) -> m (Int32, Image)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
in_' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
in_
    Ptr (Ptr Image)
out <- IO (Ptr (Ptr Image))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Image))
    let coding' :: CInt
coding' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Coding -> Int) -> Coding -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coding -> Int
forall a. Enum a => a -> Int
fromEnum) Coding
coding
    Int32
result <- Ptr Image -> Ptr (Ptr Image) -> CInt -> ImageWrittenCallback
vips_image_encode Ptr Image
in_' Ptr (Ptr Image)
out CInt
coding'
    Ptr Image
out' <- Ptr (Ptr Image) -> IO (Ptr Image)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Image)
out
    Image
out'' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
out'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
in_
    Ptr (Ptr Image) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Image)
out
    (Int32, Image) -> IO (Int32, Image)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Image
out'')

#if defined(ENABLE_OVERLOADING)
data ImageEncodeMethodInfo
instance (signature ~ (Vips.Enums.Coding -> m ((Int32, Image))), MonadIO m, IsImage a) => O.OverloadedMethod ImageEncodeMethodInfo a signature where
    overloadedMethod = imageEncode

instance O.OverloadedMethodInfo ImageEncodeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageEncode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageEncode"
        })


#endif

-- method Image::foreign_load_invalidate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to invalidate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_foreign_load_invalidate" vips_foreign_load_invalidate :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO ()

-- | Loaders can call this on the image they are making if they see a read error
-- from the load library. It signals \"invalidate\" on the load operation and
-- will cause it to be dropped from cache.
-- 
-- If we know a file will cause a read error, we don\'t want to cache the
-- failing operation, we want to make sure the image will really be opened
-- again if our caller tries again. For example, a broken file might be
-- replaced by a working one.
imageForeignLoadInvalidate ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to invalidate
    -> m ()
imageForeignLoadInvalidate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m ()
imageForeignLoadInvalidate a
image = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Ptr Image -> IO ()
vips_foreign_load_invalidate Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageForeignLoadInvalidateMethodInfo
instance (signature ~ (m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageForeignLoadInvalidateMethodInfo a signature where
    overloadedMethod = imageForeignLoadInvalidate

instance O.OverloadedMethodInfo ImageForeignLoadInvalidateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageForeignLoadInvalidate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageForeignLoadInvalidate"
        })


#endif

-- method Image::free_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the image that contains the buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the orignal buffer that was stolen"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_free_buffer" vips_image_free_buffer :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    Ptr () ->                               -- buffer : TBasicType TPtr
    IO ()

-- | Free the externally allocated buffer found in the input image. This function
-- is intended to be used with g_signal_connect.
imageFreeBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: the image that contains the buffer
    -> Ptr ()
    -- ^ /@buffer@/: the orignal buffer that was stolen
    -> m ()
imageFreeBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Ptr () -> m ()
imageFreeBuffer a
image Ptr ()
buffer = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    C_ImageInvalidateCallback
vips_image_free_buffer Ptr Image
image' Ptr ()
buffer
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageFreeBufferMethodInfo
instance (signature ~ (Ptr () -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageFreeBufferMethodInfo a signature where
    overloadedMethod = imageFreeBuffer

instance O.OverloadedMethodInfo ImageFreeBufferMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageFreeBuffer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageFreeBuffer"
        })


#endif

-- method Image::get
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get the field from from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name to fetch" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value_copy"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %GValue is copied into this"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : True
-- XXX return value ignored, but it is not a boolean.
--     This may be a memory leak?

foreign import ccall "vips_image_get" vips_image_get :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr GValue ->                           -- value_copy : TGValue
    IO Int32

-- | Fill /@valueCopy@/ with a copy of the header field. /@valueCopy@/ must be zeroed
-- but uninitialised.
-- 
-- This will return -1 and add a message to the error buffer if the field
-- does not exist. Use 'GI.Vips.Objects.Image.imageGetTypeof' to test for the
-- existence of a field first if you are not certain it will be there.
-- 
-- For example, to read a double from an image (though of course you would use
-- 'GI.Vips.Objects.Image.imageGetDouble' in practice):
-- 
-- >
-- >GValue value = { 0 };
-- >double d;
-- >
-- >if (vips_image_get (image, name, &value))
-- >  return -1;
-- >
-- >if (G_VALUE_TYPE (&value) != G_TYPE_DOUBLE) {
-- >  vips_error( "mydomain",
-- >    _("field \"%s\" is of type %s, not double"),
-- >    name,
-- >    g_type_name (G_VALUE_TYPE (&value)));
-- >  g_value_unset (&value);
-- >  return -1;
-- >}
-- >
-- >d = g_value_get_double (&value);
-- >g_value_unset (&value);
-- 
-- 
-- See also: 'GI.Vips.Objects.Image.imageGetTypeof', 'GI.Vips.Objects.Image.imageGetDouble'.
imageGet ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get the field from from
    -> T.Text
    -- ^ /@name@/: the name to fetch
    -> m (GValue)
imageGet :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> m GValue
imageGet a
image Text
name = IO GValue -> m GValue
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GValue -> m GValue) -> IO GValue -> m GValue
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GValue
valueCopy <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    Int32
_ <- Ptr Image -> CString -> Ptr GValue -> ImageWrittenCallback
vips_image_get Ptr Image
image' CString
name' Ptr GValue
valueCopy
    GValue
valueCopy' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
valueCopy
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    GValue -> IO GValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
valueCopy'

#if defined(ENABLE_OVERLOADING)
data ImageGetMethodInfo
instance (signature ~ (T.Text -> m (GValue)), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetMethodInfo a signature where
    overloadedMethod = imageGet

instance O.OverloadedMethodInfo ImageGetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGet",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGet"
        })


#endif

-- method Image::get_area
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get the metadata from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return metadata value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_area" vips_image_get_area :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr (Ptr ()) ->                         -- data : TBasicType TPtr
    IO Int32

-- | Gets /@data@/ from /@image@/ under the name /@name@/. A convenience
-- function over 'GI.Vips.Objects.Image.imageGet'. Use 'GI.Vips.Objects.Image.imageGetTypeof' to test for
-- the existence of a piece of metadata.
-- 
-- See also: 'GI.Vips.Objects.Image.imageSetArea', 'GI.Vips.Objects.Image.imageGet',
-- 'GI.Vips.Objects.Image.imageGetTypeof'
imageGetArea ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get the metadata from
    -> T.Text
    -- ^ /@name@/: metadata name
    -> m ((Int32, Ptr ()))
    -- ^ __Returns:__ 0 on success, -1 otherwise.
imageGetArea :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> m (Int32, Ptr ())
imageGetArea a
image Text
name = IO (Int32, Ptr ()) -> m (Int32, Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Ptr ()) -> m (Int32, Ptr ()))
-> IO (Int32, Ptr ()) -> m (Int32, Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr (Ptr ())
data_ <- IO (Ptr (Ptr ()))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr ()))
    Int32
result <- Ptr Image -> CString -> Ptr (Ptr ()) -> ImageWrittenCallback
vips_image_get_area Ptr Image
image' CString
name' Ptr (Ptr ())
data_
    Ptr ()
data_' <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
data_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr (Ptr ()) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr ())
data_
    (Int32, Ptr ()) -> IO (Int32, Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Ptr ()
data_')

#if defined(ENABLE_OVERLOADING)
data ImageGetAreaMethodInfo
instance (signature ~ (T.Text -> m ((Int32, Ptr ()))), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetAreaMethodInfo a signature where
    overloadedMethod = imageGetArea

instance O.OverloadedMethodInfo ImageGetAreaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetArea",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetArea"
        })


#endif

-- method Image::get_array_double
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get the metadata from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TCArray False (-1) 3 (TBasicType TDouble)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return pointer to array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return the number of elements here, optionally"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n"
--              , argType = TBasicType TInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just "return the number of elements here, optionally"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_array_double" vips_image_get_array_double :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr (Ptr CDouble) ->                    -- out : TCArray False (-1) 3 (TBasicType TDouble)
    Ptr Int32 ->                            -- n : TBasicType TInt
    IO Int32

-- | Gets /@out@/ from /@im@/ under the name /@name@/.
-- The field must be of type
-- @/VIPS_TYPE_ARRAY_INT/@.
-- 
-- Do not free /@out@/. /@out@/ is valid as long as /@image@/ is valid.
-- 
-- Use 'GI.Vips.Objects.Image.imageGetTypeof' to test for the
-- existence of a piece of metadata.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGet', 'GI.Vips.Objects.Image.imageSetImage'
imageGetArrayDouble ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get the metadata from
    -> T.Text
    -- ^ /@name@/: metadata name
    -> m ((Int32, [Double]))
    -- ^ __Returns:__ 0 on success, -1 otherwise.
imageGetArrayDouble :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> m (Int32, [Double])
imageGetArrayDouble a
image Text
name = IO (Int32, [Double]) -> m (Int32, [Double])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, [Double]) -> m (Int32, [Double]))
-> IO (Int32, [Double]) -> m (Int32, [Double])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr (Ptr CDouble)
out <- IO (Ptr (Ptr CDouble))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr CDouble))
    Ptr Int32
n <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Int32
result <- Ptr Image
-> CString
-> Ptr (Ptr CDouble)
-> Ptr Int32
-> ImageWrittenCallback
vips_image_get_array_double Ptr Image
image' CString
name' Ptr (Ptr CDouble)
out Ptr Int32
n
    Int32
n' <- Ptr Int32 -> ImageWrittenCallback
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
n
    Ptr CDouble
out' <- Ptr (Ptr CDouble) -> IO (Ptr CDouble)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CDouble)
out
    [Double]
out'' <- ((CDouble -> Double) -> Int32 -> Ptr CDouble -> IO [Double]
forall a b c.
(Integral a, Storable b) =>
(b -> c) -> a -> Ptr b -> IO [c]
unpackMapStorableArrayWithLength CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int32
n') Ptr CDouble
out'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr (Ptr CDouble) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CDouble)
out
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
n
    (Int32, [Double]) -> IO (Int32, [Double])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, [Double]
out'')

#if defined(ENABLE_OVERLOADING)
data ImageGetArrayDoubleMethodInfo
instance (signature ~ (T.Text -> m ((Int32, [Double]))), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetArrayDoubleMethodInfo a signature where
    overloadedMethod = imageGetArrayDouble

instance O.OverloadedMethodInfo ImageGetArrayDoubleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetArrayDouble",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetArrayDouble"
        })


#endif

-- method Image::get_array_int
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get the metadata from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TCArray False (-1) 3 (TBasicType TInt)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return pointer to array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return the number of elements here, optionally"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n"
--              , argType = TBasicType TInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just "return the number of elements here, optionally"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_array_int" vips_image_get_array_int :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr (Ptr Int32) ->                      -- out : TCArray False (-1) 3 (TBasicType TInt)
    Ptr Int32 ->                            -- n : TBasicType TInt
    IO Int32

-- | Gets /@out@/ from /@im@/ under the name /@name@/.
-- The field must be of type
-- @/VIPS_TYPE_ARRAY_INT/@.
-- 
-- Do not free /@out@/. /@out@/ is valid as long as /@image@/ is valid.
-- 
-- Use 'GI.Vips.Objects.Image.imageGetTypeof' to test for the
-- existence of a piece of metadata.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGet', 'GI.Vips.Objects.Image.imageSetImage'
imageGetArrayInt ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get the metadata from
    -> T.Text
    -- ^ /@name@/: metadata name
    -> m ((Int32, [Int32]))
    -- ^ __Returns:__ 0 on success, -1 otherwise.
imageGetArrayInt :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> m (Int32, [Int32])
imageGetArrayInt a
image Text
name = IO (Int32, [Int32]) -> m (Int32, [Int32])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, [Int32]) -> m (Int32, [Int32]))
-> IO (Int32, [Int32]) -> m (Int32, [Int32])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr (Ptr Int32)
out <- IO (Ptr (Ptr Int32))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Int32))
    Ptr Int32
n <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Int32
result <- Ptr Image
-> CString -> Ptr (Ptr Int32) -> Ptr Int32 -> ImageWrittenCallback
vips_image_get_array_int Ptr Image
image' CString
name' Ptr (Ptr Int32)
out Ptr Int32
n
    Int32
n' <- Ptr Int32 -> ImageWrittenCallback
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
n
    Ptr Int32
out' <- Ptr (Ptr Int32) -> IO (Ptr Int32)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Int32)
out
    [Int32]
out'' <- (Int32 -> Ptr Int32 -> IO [Int32]
forall a b. (Integral a, Storable b) => a -> Ptr b -> IO [b]
unpackStorableArrayWithLength Int32
n') Ptr Int32
out'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr (Ptr Int32) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Int32)
out
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
n
    (Int32, [Int32]) -> IO (Int32, [Int32])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, [Int32]
out'')

#if defined(ENABLE_OVERLOADING)
data ImageGetArrayIntMethodInfo
instance (signature ~ (T.Text -> m ((Int32, [Int32]))), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetArrayIntMethodInfo a signature where
    overloadedMethod = imageGetArrayInt

instance O.OverloadedMethodInfo ImageGetArrayIntMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetArrayInt",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetArrayInt"
        })


#endif

-- method Image::get_as_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get the header field from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "field name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return field value as string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_as_string" vips_image_get_as_string :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr CString ->                          -- out : TBasicType TUTF8
    IO Int32

-- | Returns /@name@/ from /@image@/ in /@out@/.
-- This function will read any field, returning it as a printable string.
-- You need to free the string with 'GI.GLib.Functions.free' when you are done with it.
-- 
-- This will base64-encode BLOBs, for example. Use @/vips_buf_appendgv()/@ to
-- make a string that\'s for humans.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGet', 'GI.Vips.Objects.Image.imageGetTypeof', @/vips_buf_appendgv()/@.
imageGetAsString ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get the header field from
    -> T.Text
    -- ^ /@name@/: field name
    -> m ((Int32, T.Text))
    -- ^ __Returns:__ 0 on success, -1 otherwise.
imageGetAsString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> m (Int32, Text)
imageGetAsString a
image Text
name = IO (Int32, Text) -> m (Int32, Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Text) -> m (Int32, Text))
-> IO (Int32, Text) -> m (Int32, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr CString
out <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Int32
result <- Ptr Image -> CString -> Ptr CString -> ImageWrittenCallback
vips_image_get_as_string Ptr Image
image' CString
name' Ptr CString
out
    CString
out' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
out
    Text
out'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
out'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
out'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
out
    (Int32, Text) -> IO (Int32, Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Text
out'')

#if defined(ENABLE_OVERLOADING)
data ImageGetAsStringMethodInfo
instance (signature ~ (T.Text -> m ((Int32, T.Text))), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetAsStringMethodInfo a signature where
    overloadedMethod = imageGetAsString

instance O.OverloadedMethodInfo ImageGetAsStringMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetAsString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetAsString"
        })


#endif

-- method Image::get_bands
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_bands" vips_image_get_bands :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | /No description available in the introspection data./
imageGetBands ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Int32
    -- ^ __Returns:__ the number of bands (channels) in the image.
imageGetBands :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Int32
imageGetBands a
image = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Int32
result <- Ptr Image -> ImageWrittenCallback
vips_image_get_bands Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImageGetBandsMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetBandsMethodInfo a signature where
    overloadedMethod = imageGetBands

instance O.OverloadedMethodInfo ImageGetBandsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetBands",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetBands"
        })


#endif

-- method Image::get_blob
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get the metadata from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 3 (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to area of memory"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return the blob length here, optionally"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "return the blob length here, optionally"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_blob" vips_image_get_blob :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr (Ptr Word8) ->                      -- data : TCArray False (-1) 3 (TBasicType TUInt8)
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    IO Int32

-- | Gets /@blob@/ from /@image@/ under the name /@name@/, optionally returns its length in
-- /@length@/. A convenience
-- function over 'GI.Vips.Objects.Image.imageGet'. Use 'GI.Vips.Objects.Image.imageGetTypeof' to test for the
-- existence
-- of a piece of metadata.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGet', 'GI.Vips.Objects.Image.imageGetTypeof', 'GI.Vips.Structs.Blob.blobGet',
imageGetBlob ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get the metadata from
    -> T.Text
    -- ^ /@name@/: metadata name
    -> m ((Int32, ByteString))
    -- ^ __Returns:__ 0 on success, -1 otherwise.
imageGetBlob :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> m (Int32, ByteString)
imageGetBlob a
image Text
name = IO (Int32, ByteString) -> m (Int32, ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, ByteString) -> m (Int32, ByteString))
-> IO (Int32, ByteString) -> m (Int32, ByteString)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr (Ptr Word8)
data_ <- IO (Ptr (Ptr Word8))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Word8))
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Int32
result <- Ptr Image
-> CString -> Ptr (Ptr Word8) -> Ptr Word64 -> ImageWrittenCallback
vips_image_get_blob Ptr Image
image' CString
name' Ptr (Ptr Word8)
data_ Ptr Word64
length_
    Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
    Ptr Word8
data_' <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
data_
    ByteString
data_'' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
length_') Ptr Word8
data_'
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
data_
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
    (Int32, ByteString) -> IO (Int32, ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, ByteString
data_'')

#if defined(ENABLE_OVERLOADING)
data ImageGetBlobMethodInfo
instance (signature ~ (T.Text -> m ((Int32, ByteString))), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetBlobMethodInfo a signature where
    overloadedMethod = imageGetBlob

instance O.OverloadedMethodInfo ImageGetBlobMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetBlob",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetBlob"
        })


#endif

-- method Image::get_coding
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Coding" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_coding" vips_image_get_coding :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CInt

-- | /No description available in the introspection data./
imageGetCoding ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Vips.Enums.Coding
    -- ^ __Returns:__ the image coding
imageGetCoding :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Coding
imageGetCoding a
image = IO Coding -> m Coding
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Coding -> m Coding) -> IO Coding -> m Coding
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CInt
result <- Ptr Image -> IO CInt
vips_image_get_coding Ptr Image
image'
    let result' :: Coding
result' = (Int -> Coding
forall a. Enum a => Int -> a
toEnum (Int -> Coding) -> (CInt -> Int) -> CInt -> Coding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Coding -> IO Coding
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Coding
result'

#if defined(ENABLE_OVERLOADING)
data ImageGetCodingMethodInfo
instance (signature ~ (m Vips.Enums.Coding), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetCodingMethodInfo a signature where
    overloadedMethod = imageGetCoding

instance O.OverloadedMethodInfo ImageGetCodingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetCoding",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetCoding"
        })


#endif

-- method Image::get_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get data for"
--                 , 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_image_get_data" vips_image_get_data :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO (Ptr ())

-- | Return a pointer to the image\'s pixel data, if possible. This can involve
-- allocating large amounts of memory and performing a long computation. Image
-- pixels are laid out in band-packed rows.
-- 
-- Since this function modifies /@image@/, it is not threadsafe. Only call it on
-- images which you are sure have not been shared with another thread.
-- 
-- See also: 'GI.Vips.Objects.Image.imageWioInput', 'GI.Vips.Objects.Image.imageCopyMemory'.
imageGetData ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get data for
    -> m (Ptr ())
    -- ^ __Returns:__ a pointer to pixel data, if possible.
imageGetData :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m (Ptr ())
imageGetData a
image = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Ptr ()
result <- Ptr Image -> IO (Ptr ())
vips_image_get_data Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data ImageGetDataMethodInfo
instance (signature ~ (m (Ptr ())), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetDataMethodInfo a signature where
    overloadedMethod = imageGetData

instance O.OverloadedMethodInfo ImageGetDataMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetData",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetData"
        })


#endif

-- method Image::get_double
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get the header field from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "field name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return field value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_double" vips_image_get_double :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr CDouble ->                          -- out : TBasicType TDouble
    IO Int32

-- | Gets /@out@/ from /@im@/ under the name /@name@/.
-- The value will be transformed into
-- a double, if possible.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGet', 'GI.Vips.Objects.Image.imageGetTypeof'
imageGetDouble ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get the header field from
    -> T.Text
    -- ^ /@name@/: field name
    -> m ((Int32, Double))
    -- ^ __Returns:__ 0 on success, -1 otherwise.
imageGetDouble :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> m (Int32, Double)
imageGetDouble a
image Text
name = IO (Int32, Double) -> m (Int32, Double)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Double) -> m (Int32, Double))
-> IO (Int32, Double) -> m (Int32, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr CDouble
out <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Int32
result <- Ptr Image -> CString -> Ptr CDouble -> ImageWrittenCallback
vips_image_get_double Ptr Image
image' CString
name' Ptr CDouble
out
    CDouble
out' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
out
    let out'' :: Double
out'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
out'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
out
    (Int32, Double) -> IO (Int32, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Double
out'')

#if defined(ENABLE_OVERLOADING)
data ImageGetDoubleMethodInfo
instance (signature ~ (T.Text -> m ((Int32, Double))), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetDoubleMethodInfo a signature where
    overloadedMethod = imageGetDouble

instance O.OverloadedMethodInfo ImageGetDoubleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetDouble",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetDouble"
        })


#endif

-- method Image::get_fields
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get fields from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_fields" vips_image_get_fields :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO (Ptr CString)

-- | Get a 'P.Nothing'-terminated array listing all the metadata field names on /@image@/.
-- Free the return result with 'GI.GLib.Functions.strfreev'.
-- 
-- This is handy for language bindings. From C, it\'s usually more convenient to
-- use 'GI.Vips.Objects.Image.imageMap'.
imageGetFields ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get fields from
    -> m [T.Text]
    -- ^ __Returns:__ metadata fields in image, as a 'P.Nothing'-terminated
    -- array.
imageGetFields :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m [Text]
imageGetFields a
image = 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 Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Ptr CString
result <- Ptr Image -> IO (Ptr CString)
vips_image_get_fields Ptr Image
image'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageGetFields" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data ImageGetFieldsMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetFieldsMethodInfo a signature where
    overloadedMethod = imageGetFields

instance O.OverloadedMethodInfo ImageGetFieldsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetFields",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetFields"
        })


#endif

-- method Image::get_filename
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get 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_image_get_filename" vips_image_get_filename :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CString

-- | /No description available in the introspection data./
imageGetFilename ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m T.Text
    -- ^ __Returns:__ the name of the file the image was loaded from, or NULL if there
    -- is no filename.
imageGetFilename :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Text
imageGetFilename a
image = 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 Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
result <- Ptr Image -> IO CString
vips_image_get_filename Ptr Image
image'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageGetFilename" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ImageGetFilenameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetFilenameMethodInfo a signature where
    overloadedMethod = imageGetFilename

instance O.OverloadedMethodInfo ImageGetFilenameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetFilename",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetFilename"
        })


#endif

-- method Image::get_format
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "BandFormat" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_format" vips_image_get_format :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CInt

-- | /No description available in the introspection data./
imageGetFormat ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Vips.Enums.BandFormat
    -- ^ __Returns:__ the format of each band element.
imageGetFormat :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m BandFormat
imageGetFormat a
image = IO BandFormat -> m BandFormat
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BandFormat -> m BandFormat) -> IO BandFormat -> m BandFormat
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CInt
result <- Ptr Image -> IO CInt
vips_image_get_format Ptr Image
image'
    let result' :: BandFormat
result' = (Int -> BandFormat
forall a. Enum a => Int -> a
toEnum (Int -> BandFormat) -> (CInt -> Int) -> CInt -> BandFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    BandFormat -> IO BandFormat
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BandFormat
result'

#if defined(ENABLE_OVERLOADING)
data ImageGetFormatMethodInfo
instance (signature ~ (m Vips.Enums.BandFormat), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetFormatMethodInfo a signature where
    overloadedMethod = imageGetFormat

instance O.OverloadedMethodInfo ImageGetFormatMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetFormat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetFormat"
        })


#endif

-- method Image::get_height
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_height" vips_image_get_height :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | /No description available in the introspection data./
imageGetHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Int32
    -- ^ __Returns:__ the number of pixels down the image.
imageGetHeight :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Int32
imageGetHeight a
image = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Int32
result <- Ptr Image -> ImageWrittenCallback
vips_image_get_height Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImageGetHeightMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetHeightMethodInfo a signature where
    overloadedMethod = imageGetHeight

instance O.OverloadedMethodInfo ImageGetHeightMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetHeight",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetHeight"
        })


#endif

-- method Image::get_history
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "get history from here"
--                 , 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_image_get_history" vips_image_get_history :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CString

-- | This function reads the image history as a C string. The string is owned
-- by VIPS and must not be freed.
-- 
-- VIPS tracks the history of each image, that is, the sequence of operations
-- that generated that image. Applications built on VIPS need to call
-- @/vips_image_history_printf()/@ for each action they perform, setting the
-- command-line equivalent for the action.
-- 
-- See also: @/vips_image_history_printf()/@.
imageGetHistory ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: get history from here
    -> m T.Text
    -- ^ __Returns:__ The history of /@image@/ as a C string. Do not free!
imageGetHistory :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Text
imageGetHistory a
image = 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 Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
result <- Ptr Image -> IO CString
vips_image_get_history Ptr Image
image'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageGetHistory" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ImageGetHistoryMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetHistoryMethodInfo a signature where
    overloadedMethod = imageGetHistory

instance O.OverloadedMethodInfo ImageGetHistoryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetHistory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetHistory"
        })


#endif

-- method Image::get_image
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get the metadata from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return metadata value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_image" vips_image_get_image :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr (Ptr Image) ->                      -- out : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | Gets /@out@/ from /@im@/ under the name /@name@/.
-- The field must be of type
-- @/VIPS_TYPE_IMAGE/@. You must unref /@out@/ with 'GI.GObject.Objects.Object.objectUnref'.
-- 
-- Use 'GI.Vips.Objects.Image.imageGetTypeof' to test for the
-- existence of a piece of metadata.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGet', 'GI.Vips.Objects.Image.imageSetImage'
imageGetImage ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get the metadata from
    -> T.Text
    -- ^ /@name@/: metadata name
    -> m ((Int32, Image))
    -- ^ __Returns:__ 0 on success, -1 otherwise.
imageGetImage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> m (Int32, Image)
imageGetImage a
image Text
name = IO (Int32, Image) -> m (Int32, Image)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Image) -> m (Int32, Image))
-> IO (Int32, Image) -> m (Int32, Image)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr (Ptr Image)
out <- IO (Ptr (Ptr Image))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Image))
    Int32
result <- Ptr Image -> CString -> Ptr (Ptr Image) -> ImageWrittenCallback
vips_image_get_image Ptr Image
image' CString
name' Ptr (Ptr Image)
out
    Ptr Image
out' <- Ptr (Ptr Image) -> IO (Ptr Image)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Image)
out
    Image
out'' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
out'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr (Ptr Image) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Image)
out
    (Int32, Image) -> IO (Int32, Image)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Image
out'')

#if defined(ENABLE_OVERLOADING)
data ImageGetImageMethodInfo
instance (signature ~ (T.Text -> m ((Int32, Image))), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetImageMethodInfo a signature where
    overloadedMethod = imageGetImage

instance O.OverloadedMethodInfo ImageGetImageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetImage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetImage"
        })


#endif

-- method Image::get_int
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get the header field from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "field name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return field value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_int" vips_image_get_int :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr Int32 ->                            -- out : TBasicType TInt
    IO Int32

-- | Gets /@out@/ from /@im@/ under the name /@name@/.
-- The value will be transformed into
-- an int, if possible.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGet', 'GI.Vips.Objects.Image.imageGetTypeof'
imageGetInt ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get the header field from
    -> T.Text
    -- ^ /@name@/: field name
    -> m ((Int32, Int32))
    -- ^ __Returns:__ 0 on success, -1 otherwise.
imageGetInt :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> m (Int32, Int32)
imageGetInt a
image Text
name = IO (Int32, Int32) -> m (Int32, Int32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32) -> m (Int32, Int32))
-> IO (Int32, Int32) -> m (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Int32
out <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Int32
result <- Ptr Image -> CString -> Ptr Int32 -> ImageWrittenCallback
vips_image_get_int Ptr Image
image' CString
name' Ptr Int32
out
    Int32
out' <- Ptr Int32 -> ImageWrittenCallback
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
out
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
out
    (Int32, Int32) -> IO (Int32, Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Int32
out')

#if defined(ENABLE_OVERLOADING)
data ImageGetIntMethodInfo
instance (signature ~ (T.Text -> m ((Int32, Int32))), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetIntMethodInfo a signature where
    overloadedMethod = imageGetInt

instance O.OverloadedMethodInfo ImageGetIntMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetInt",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetInt"
        })


#endif

-- method Image::get_interpretation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Vips" , name = "Interpretation" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_interpretation" vips_image_get_interpretation :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CInt

-- | Return the t'GI.Vips.Enums.Interpretation' set in the image header.
-- Use 'GI.Vips.Objects.Image.imageGuessInterpretation' if you want a sanity-checked value.
imageGetInterpretation ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Vips.Enums.Interpretation
    -- ^ __Returns:__ the t'GI.Vips.Enums.Interpretation' from the image header.
imageGetInterpretation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Interpretation
imageGetInterpretation a
image = IO Interpretation -> m Interpretation
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Interpretation -> m Interpretation)
-> IO Interpretation -> m Interpretation
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CInt
result <- Ptr Image -> IO CInt
vips_image_get_interpretation Ptr Image
image'
    let result' :: Interpretation
result' = (Int -> Interpretation
forall a. Enum a => Int -> a
toEnum (Int -> Interpretation) -> (CInt -> Int) -> CInt -> Interpretation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Interpretation -> IO Interpretation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Interpretation
result'

#if defined(ENABLE_OVERLOADING)
data ImageGetInterpretationMethodInfo
instance (signature ~ (m Vips.Enums.Interpretation), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetInterpretationMethodInfo a signature where
    overloadedMethod = imageGetInterpretation

instance O.OverloadedMethodInfo ImageGetInterpretationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetInterpretation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetInterpretation"
        })


#endif

-- method Image::get_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get 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_image_get_mode" vips_image_get_mode :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CString

-- | Image modes are things like @\"t\"@, meaning a memory buffer, and @\"p\"@
-- meaning a delayed computation.
imageGetMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m T.Text
    -- ^ __Returns:__ the image mode.
imageGetMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Text
imageGetMode a
image = 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 Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
result <- Ptr Image -> IO CString
vips_image_get_mode Ptr Image
image'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageGetMode" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ImageGetModeMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetModeMethodInfo a signature where
    overloadedMethod = imageGetMode

instance O.OverloadedMethodInfo ImageGetModeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetMode"
        })


#endif

-- method Image::get_n_pages
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_n_pages" vips_image_get_n_pages :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | Fetch and sanity-check 'GI.Vips.Constants.META_N_PAGES'. Default to 1 if not present or
-- crazy.
-- 
-- This is the number of pages in the image file, not the number of pages that
-- have been loaded into /@image@/.
imageGetNPages ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Int32
    -- ^ __Returns:__ the number of pages in the image file
imageGetNPages :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Int32
imageGetNPages a
image = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Int32
result <- Ptr Image -> ImageWrittenCallback
vips_image_get_n_pages Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImageGetNPagesMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetNPagesMethodInfo a signature where
    overloadedMethod = imageGetNPages

instance O.OverloadedMethodInfo ImageGetNPagesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetNPages",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetNPages"
        })


#endif

-- method Image::get_n_subifds
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_n_subifds" vips_image_get_n_subifds :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | Fetch and sanity-check 'GI.Vips.Constants.META_N_SUBIFDS'. Default to 0 if not present or
-- crazy.
imageGetNSubifds ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Int32
    -- ^ __Returns:__ the number of subifds in the image file
imageGetNSubifds :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Int32
imageGetNSubifds a
image = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Int32
result <- Ptr Image -> ImageWrittenCallback
vips_image_get_n_subifds Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImageGetNSubifdsMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetNSubifdsMethodInfo a signature where
    overloadedMethod = imageGetNSubifds

instance O.OverloadedMethodInfo ImageGetNSubifdsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetNSubifds",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetNSubifds"
        })


#endif

-- method Image::get_offset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_offset" vips_image_get_offset :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CDouble

-- | Matrix images can have an optional @offset@ field for use by integer
-- convolution.
imageGetOffset ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Double
    -- ^ __Returns:__ the offset.
imageGetOffset :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Double
imageGetOffset a
image = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CDouble
result <- Ptr Image -> IO CDouble
vips_image_get_offset Ptr Image
image'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data ImageGetOffsetMethodInfo
instance (signature ~ (m Double), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetOffsetMethodInfo a signature where
    overloadedMethod = imageGetOffset

instance O.OverloadedMethodInfo ImageGetOffsetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetOffset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetOffset"
        })


#endif

-- method Image::get_orientation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_orientation" vips_image_get_orientation :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | Fetch and sanity-check 'GI.Vips.Constants.META_ORIENTATION'. Default to 1 (no rotate,
-- no flip) if not present or crazy.
imageGetOrientation ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Int32
    -- ^ __Returns:__ the image orientation.
imageGetOrientation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Int32
imageGetOrientation a
image = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Int32
result <- Ptr Image -> ImageWrittenCallback
vips_image_get_orientation Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImageGetOrientationMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetOrientationMethodInfo a signature where
    overloadedMethod = imageGetOrientation

instance O.OverloadedMethodInfo ImageGetOrientationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetOrientation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetOrientation"
        })


#endif

-- method Image::get_orientation_swap
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , 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_image_get_orientation_swap" vips_image_get_orientation_swap :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CInt

-- | Return 'P.True' if applying the orientation would swap width and height.
imageGetOrientationSwap ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Bool
    -- ^ __Returns:__ if width\/height will swap
imageGetOrientationSwap :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Bool
imageGetOrientationSwap a
image = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CInt
result <- Ptr Image -> IO CInt
vips_image_get_orientation_swap Ptr Image
image'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ImageGetOrientationSwapMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetOrientationSwapMethodInfo a signature where
    overloadedMethod = imageGetOrientationSwap

instance O.OverloadedMethodInfo ImageGetOrientationSwapMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetOrientationSwap",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetOrientationSwap"
        })


#endif

-- method Image::get_page_height
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_page_height" vips_image_get_page_height :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | Multi-page images can have a page height. Fetch it, and sanity check it. If
-- page-height is not set, it defaults to the image height.
imageGetPageHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Int32
    -- ^ __Returns:__ the page height.
imageGetPageHeight :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Int32
imageGetPageHeight a
image = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Int32
result <- Ptr Image -> ImageWrittenCallback
vips_image_get_page_height Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImageGetPageHeightMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetPageHeightMethodInfo a signature where
    overloadedMethod = imageGetPageHeight

instance O.OverloadedMethodInfo ImageGetPageHeightMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetPageHeight",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetPageHeight"
        })


#endif

-- method Image::get_scale
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_scale" vips_image_get_scale :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CDouble

-- | Matrix images can have an optional @scale@ field for use by integer
-- convolution.
imageGetScale ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Double
    -- ^ __Returns:__ the scale.
imageGetScale :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Double
imageGetScale a
image = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CDouble
result <- Ptr Image -> IO CDouble
vips_image_get_scale Ptr Image
image'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data ImageGetScaleMethodInfo
instance (signature ~ (m Double), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetScaleMethodInfo a signature where
    overloadedMethod = imageGetScale

instance O.OverloadedMethodInfo ImageGetScaleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetScale",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetScale"
        })


#endif

-- method Image::get_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get the header field from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "field name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return field value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_string" vips_image_get_string :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr CString ->                          -- out : TBasicType TUTF8
    IO Int32

-- | Gets /@out@/ from /@im@/ under the name /@name@/.
-- The field must be of type
-- G_TYPE_STRING, VIPS_TYPE_REF_STRING.
-- 
-- Do not free /@out@/.
-- 
-- Use 'GI.Vips.Objects.Image.imageGetAsString' to fetch any field as a string.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGet', 'GI.Vips.Objects.Image.imageGetTypeof'
imageGetString ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get the header field from
    -> T.Text
    -- ^ /@name@/: field name
    -> m ((Int32, T.Text))
    -- ^ __Returns:__ 0 on success, -1 otherwise.
imageGetString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> m (Int32, Text)
imageGetString a
image Text
name = IO (Int32, Text) -> m (Int32, Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Text) -> m (Int32, Text))
-> IO (Int32, Text) -> m (Int32, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr CString
out <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Int32
result <- Ptr Image -> CString -> Ptr CString -> ImageWrittenCallback
vips_image_get_string Ptr Image
image' CString
name' Ptr CString
out
    CString
out' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
out
    Text
out'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
out'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
out
    (Int32, Text) -> IO (Int32, Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Text
out'')

#if defined(ENABLE_OVERLOADING)
data ImageGetStringMethodInfo
instance (signature ~ (T.Text -> m ((Int32, T.Text))), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetStringMethodInfo a signature where
    overloadedMethod = imageGetString

instance O.OverloadedMethodInfo ImageGetStringMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetString"
        })


#endif

-- method Image::get_typeof
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to test" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name to search for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_typeof" vips_image_get_typeof :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    IO CGType

-- | Read the @/GType/@ for a header field. Returns zero if there is no
-- field of that name.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGet'.
imageGetTypeof ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to test
    -> T.Text
    -- ^ /@name@/: the name to search for
    -> m GType
    -- ^ __Returns:__ the @/GType/@ of the field, or zero if there is no
    -- field of that name.
imageGetTypeof :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> m GType
imageGetTypeof a
image Text
name = IO GType -> m GType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Word64
result <- Ptr Image -> CString -> IO Word64
vips_image_get_typeof Ptr Image
image' CString
name'
    let result' :: GType
result' = Word64 -> GType
GType Word64
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    GType -> IO GType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
data ImageGetTypeofMethodInfo
instance (signature ~ (T.Text -> m GType), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetTypeofMethodInfo a signature where
    overloadedMethod = imageGetTypeof

instance O.OverloadedMethodInfo ImageGetTypeofMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetTypeof",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetTypeof"
        })


#endif

-- method Image::get_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_width" vips_image_get_width :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | /No description available in the introspection data./
imageGetWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Int32
    -- ^ __Returns:__ the number of pixels across the image.
imageGetWidth :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Int32
imageGetWidth a
image = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Int32
result <- Ptr Image -> ImageWrittenCallback
vips_image_get_width Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImageGetWidthMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetWidthMethodInfo a signature where
    overloadedMethod = imageGetWidth

instance O.OverloadedMethodInfo ImageGetWidthMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetWidth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetWidth"
        })


#endif

-- method Image::get_xoffset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_xoffset" vips_image_get_xoffset :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | /No description available in the introspection data./
imageGetXoffset ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Int32
    -- ^ __Returns:__ the horizontal position of the image origin, in pixels.
imageGetXoffset :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Int32
imageGetXoffset a
image = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Int32
result <- Ptr Image -> ImageWrittenCallback
vips_image_get_xoffset Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImageGetXoffsetMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetXoffsetMethodInfo a signature where
    overloadedMethod = imageGetXoffset

instance O.OverloadedMethodInfo ImageGetXoffsetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetXoffset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetXoffset"
        })


#endif

-- method Image::get_xres
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_xres" vips_image_get_xres :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CDouble

-- | /No description available in the introspection data./
imageGetXres ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Double
    -- ^ __Returns:__ the horizontal image resolution in pixels per millimeter.
imageGetXres :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Double
imageGetXres a
image = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CDouble
result <- Ptr Image -> IO CDouble
vips_image_get_xres Ptr Image
image'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data ImageGetXresMethodInfo
instance (signature ~ (m Double), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetXresMethodInfo a signature where
    overloadedMethod = imageGetXres

instance O.OverloadedMethodInfo ImageGetXresMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetXres",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetXres"
        })


#endif

-- method Image::get_yoffset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_yoffset" vips_image_get_yoffset :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | /No description available in the introspection data./
imageGetYoffset ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Int32
    -- ^ __Returns:__ the vertical position of the image origin, in pixels.
imageGetYoffset :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Int32
imageGetYoffset a
image = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Int32
result <- Ptr Image -> ImageWrittenCallback
vips_image_get_yoffset Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImageGetYoffsetMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetYoffsetMethodInfo a signature where
    overloadedMethod = imageGetYoffset

instance O.OverloadedMethodInfo ImageGetYoffsetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetYoffset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetYoffset"
        })


#endif

-- method Image::get_yres
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_yres" vips_image_get_yres :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CDouble

-- | /No description available in the introspection data./
imageGetYres ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get from
    -> m Double
    -- ^ __Returns:__ the vertical image resolution in pixels per millimeter.
imageGetYres :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Double
imageGetYres a
image = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CDouble
result <- Ptr Image -> IO CDouble
vips_image_get_yres Ptr Image
image'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data ImageGetYresMethodInfo
instance (signature ~ (m Double), MonadIO m, IsImage a) => O.OverloadedMethod ImageGetYresMethodInfo a signature where
    overloadedMethod = imageGetYres

instance O.OverloadedMethodInfo ImageGetYresMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGetYres",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGetYres"
        })


#endif

-- method Image::guess_format
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to guess for" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "BandFormat" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_guess_format" vips_image_guess_format :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CInt

-- | Return the t'GI.Vips.Enums.BandFormat' for an image, guessing a sane value if
-- the set value looks crazy.
-- 
-- For example, for a float image tagged as rgb16, we\'d return ushort.
imageGuessFormat ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to guess for
    -> m Vips.Enums.BandFormat
    -- ^ __Returns:__ a sensible t'GI.Vips.Enums.BandFormat' for the image.
imageGuessFormat :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m BandFormat
imageGuessFormat a
image = IO BandFormat -> m BandFormat
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BandFormat -> m BandFormat) -> IO BandFormat -> m BandFormat
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CInt
result <- Ptr Image -> IO CInt
vips_image_guess_format Ptr Image
image'
    let result' :: BandFormat
result' = (Int -> BandFormat
forall a. Enum a => Int -> a
toEnum (Int -> BandFormat) -> (CInt -> Int) -> CInt -> BandFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    BandFormat -> IO BandFormat
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BandFormat
result'

#if defined(ENABLE_OVERLOADING)
data ImageGuessFormatMethodInfo
instance (signature ~ (m Vips.Enums.BandFormat), MonadIO m, IsImage a) => O.OverloadedMethod ImageGuessFormatMethodInfo a signature where
    overloadedMethod = imageGuessFormat

instance O.OverloadedMethodInfo ImageGuessFormatMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGuessFormat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGuessFormat"
        })


#endif

-- method Image::guess_interpretation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to guess for" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Vips" , name = "Interpretation" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_guess_interpretation" vips_image_guess_interpretation :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CInt

-- | Return the t'GI.Vips.Enums.Interpretation' for an image, guessing a sane value if
-- the set value looks crazy.
imageGuessInterpretation ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to guess for
    -> m Vips.Enums.Interpretation
    -- ^ __Returns:__ a sensible t'GI.Vips.Enums.Interpretation' for the image.
imageGuessInterpretation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Interpretation
imageGuessInterpretation a
image = IO Interpretation -> m Interpretation
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Interpretation -> m Interpretation)
-> IO Interpretation -> m Interpretation
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CInt
result <- Ptr Image -> IO CInt
vips_image_guess_interpretation Ptr Image
image'
    let result' :: Interpretation
result' = (Int -> Interpretation
forall a. Enum a => Int -> a
toEnum (Int -> Interpretation) -> (CInt -> Int) -> CInt -> Interpretation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Interpretation -> IO Interpretation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Interpretation
result'

#if defined(ENABLE_OVERLOADING)
data ImageGuessInterpretationMethodInfo
instance (signature ~ (m Vips.Enums.Interpretation), MonadIO m, IsImage a) => O.OverloadedMethod ImageGuessInterpretationMethodInfo a signature where
    overloadedMethod = imageGuessInterpretation

instance O.OverloadedMethodInfo ImageGuessInterpretationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageGuessInterpretation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageGuessInterpretation"
        })


#endif

-- method Image::hasalpha
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to check" , 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_image_hasalpha" vips_image_hasalpha :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CInt

-- | Look at an image\'s interpretation and see if it has extra alpha bands. For
-- example, a 4-band @/VIPS_INTERPRETATION_sRGB/@ would, but a six-band
-- @/VIPS_INTERPRETATION_MULTIBAND/@ would not.
-- 
-- Return 'P.True' if /@image@/ has an alpha channel.
imageHasalpha ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to check
    -> m Bool
imageHasalpha :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Bool
imageHasalpha a
image = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CInt
result <- Ptr Image -> IO CInt
vips_image_hasalpha Ptr Image
image'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ImageHasalphaMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsImage a) => O.OverloadedMethod ImageHasalphaMethodInfo a signature where
    overloadedMethod = imageHasalpha

instance O.OverloadedMethodInfo ImageHasalphaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageHasalpha",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageHasalpha"
        })


#endif

-- method Image::history_args
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to attach history line to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "program name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "argc"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of program arguments"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "argv"
--           , argType = TCArray False (-1) 2 (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "program arguments" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "argc"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of program arguments"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_history_args" vips_image_history_args :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Int32 ->                                -- argc : TBasicType TInt
    Ptr CString ->                          -- argv : TCArray False (-1) 2 (TBasicType TUTF8)
    IO Int32

-- | Formats the name\/argv as a single string and calls
-- @/vips_image_history_printf()/@. A
-- convenience function for command-line prorams.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGetHistory'.
imageHistoryArgs ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to attach history line to
    -> T.Text
    -- ^ /@name@/: program name
    -> [T.Text]
    -- ^ /@argv@/: program arguments
    -> m Int32
    -- ^ __Returns:__ 0 on success, -1 on error.
imageHistoryArgs :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> [Text] -> m Int32
imageHistoryArgs a
image Text
name [Text]
argv = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    let argc :: Int32
argc = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Text]
argv
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr CString
argv' <- [Text] -> IO (Ptr CString)
packUTF8CArray [Text]
argv
    Int32
result <- Ptr Image
-> CString -> Int32 -> Ptr CString -> ImageWrittenCallback
vips_image_history_args Ptr Image
image' CString
name' Int32
argc Ptr CString
argv'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    (Int32 -> (CString -> IO ()) -> Ptr CString -> IO ()
forall a b c.
(Storable a, Integral b) =>
b -> (a -> IO c) -> Ptr a -> IO ()
mapCArrayWithLength Int32
argc) CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
argv'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
argv'
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImageHistoryArgsMethodInfo
instance (signature ~ (T.Text -> [T.Text] -> m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImageHistoryArgsMethodInfo a signature where
    overloadedMethod = imageHistoryArgs

instance O.OverloadedMethodInfo ImageHistoryArgsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageHistoryArgs",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageHistoryArgs"
        })


#endif

-- method Image::icc_ac2rc
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "in"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input image" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "output image" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "profile_filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "use this profile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_icc_ac2rc" vips_icc_ac2rc :: 
    Ptr Image ->                            -- in : TInterface (Name {namespace = "Vips", name = "Image"})
    Ptr (Ptr Image) ->                      -- out : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- profile_filename : TBasicType TUTF8
    IO Int32

-- | Transform an image from absolute to relative colorimetry using the
-- MediaWhitePoint stored in the ICC profile.
-- 
-- See also: @/vips_icc_transform()/@, @/vips_icc_import()/@.
imageIccAc2rc ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@in@/: input image
    -> T.Text
    -- ^ /@profileFilename@/: use this profile
    -> m ((Int32, Image))
    -- ^ __Returns:__ 0 on success, -1 on error.
imageIccAc2rc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> m (Int32, Image)
imageIccAc2rc a
in_ Text
profileFilename = IO (Int32, Image) -> m (Int32, Image)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Image) -> m (Int32, Image))
-> IO (Int32, Image) -> m (Int32, Image)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
in_' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
in_
    Ptr (Ptr Image)
out <- IO (Ptr (Ptr Image))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Image))
    CString
profileFilename' <- Text -> IO CString
textToCString Text
profileFilename
    Int32
result <- Ptr Image -> Ptr (Ptr Image) -> CString -> ImageWrittenCallback
vips_icc_ac2rc Ptr Image
in_' Ptr (Ptr Image)
out CString
profileFilename'
    Ptr Image
out' <- Ptr (Ptr Image) -> IO (Ptr Image)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Image)
out
    Image
out'' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
out'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
in_
    Ptr (Ptr Image) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Image)
out
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
profileFilename'
    (Int32, Image) -> IO (Int32, Image)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Image
out'')

#if defined(ENABLE_OVERLOADING)
data ImageIccAc2rcMethodInfo
instance (signature ~ (T.Text -> m ((Int32, Image))), MonadIO m, IsImage a) => O.OverloadedMethod ImageIccAc2rcMethodInfo a signature where
    overloadedMethod = imageIccAc2rc

instance O.OverloadedMethodInfo ImageIccAc2rcMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageIccAc2rc",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageIccAc2rc"
        })


#endif

-- method Image::init_fields
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to init" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "xsize"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image width" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ysize"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image height" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bands"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image bands" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "BandFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "band format" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "coding"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Coding" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image coding" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interpretation"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Interpretation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "xres"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "horizontal resolution, pixels per millimetre"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "yres"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "vertical resolution, pixels per millimetre"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_init_fields" vips_image_init_fields :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    Int32 ->                                -- xsize : TBasicType TInt
    Int32 ->                                -- ysize : TBasicType TInt
    Int32 ->                                -- bands : TBasicType TInt
    CInt ->                                 -- format : TInterface (Name {namespace = "Vips", name = "BandFormat"})
    CInt ->                                 -- coding : TInterface (Name {namespace = "Vips", name = "Coding"})
    CInt ->                                 -- interpretation : TInterface (Name {namespace = "Vips", name = "Interpretation"})
    CDouble ->                              -- xres : TBasicType TDouble
    CDouble ->                              -- yres : TBasicType TDouble
    IO ()

-- | A convenience function to set the header fields after creating an image.
-- Normally you copy the fields from your input images with
-- @/vips_image_pipelinev()/@ and then make
-- any adjustments you need, but if you are creating an image from scratch,
-- for example @/vips_black()/@ or @/vips_jpegload()/@, you do need to set all the
-- fields yourself.
-- 
-- See also: @/vips_image_pipelinev()/@.
imageInitFields ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to init
    -> Int32
    -- ^ /@xsize@/: image width
    -> Int32
    -- ^ /@ysize@/: image height
    -> Int32
    -- ^ /@bands@/: image bands
    -> Vips.Enums.BandFormat
    -- ^ /@format@/: band format
    -> Vips.Enums.Coding
    -- ^ /@coding@/: image coding
    -> Vips.Enums.Interpretation
    -- ^ /@interpretation@/: image type
    -> Double
    -- ^ /@xres@/: horizontal resolution, pixels per millimetre
    -> Double
    -- ^ /@yres@/: vertical resolution, pixels per millimetre
    -> m ()
imageInitFields :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a
-> Int32
-> Int32
-> Int32
-> BandFormat
-> Coding
-> Interpretation
-> Double
-> Double
-> m ()
imageInitFields a
image Int32
xsize Int32
ysize Int32
bands BandFormat
format Coding
coding Interpretation
interpretation Double
xres Double
yres = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    let format' :: CInt
format' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (BandFormat -> Int) -> BandFormat -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BandFormat -> Int
forall a. Enum a => a -> Int
fromEnum) BandFormat
format
    let coding' :: CInt
coding' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Coding -> Int) -> Coding -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coding -> Int
forall a. Enum a => a -> Int
fromEnum) Coding
coding
    let interpretation' :: CInt
interpretation' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Interpretation -> Int) -> Interpretation -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interpretation -> Int
forall a. Enum a => a -> Int
fromEnum) Interpretation
interpretation
    let xres' :: CDouble
xres' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
xres
    let yres' :: CDouble
yres' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
yres
    Ptr Image
-> Int32
-> Int32
-> Int32
-> CInt
-> CInt
-> CInt
-> CDouble
-> CDouble
-> IO ()
vips_image_init_fields Ptr Image
image' Int32
xsize Int32
ysize Int32
bands CInt
format' CInt
coding' CInt
interpretation' CDouble
xres' CDouble
yres'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageInitFieldsMethodInfo
instance (signature ~ (Int32 -> Int32 -> Int32 -> Vips.Enums.BandFormat -> Vips.Enums.Coding -> Vips.Enums.Interpretation -> Double -> Double -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageInitFieldsMethodInfo a signature where
    overloadedMethod = imageInitFields

instance O.OverloadedMethodInfo ImageInitFieldsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageInitFields",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageInitFields"
        })


#endif

-- method Image::inplace
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to make read-write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_inplace" vips_image_inplace :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | Gets /@image@/ ready for an in-place operation, such as @/vips_draw_circle()/@.
-- After calling this function you can both read and write the image with
-- @/VIPS_IMAGE_ADDR()/@.
-- 
-- This method is called for you by the base class of the draw operations,
-- there\'s no need to call it yourself.
-- 
-- Since this function modifies /@image@/, it is not thread-safe. Only call it on
-- images which you are sure have not been shared with another thread.
-- All in-place operations are inherently not thread-safe, so you need to take
-- great care in any case.
-- 
-- See also: @/vips_draw_circle()/@, 'GI.Vips.Objects.Image.imageWioInput'.
imageInplace ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to make read-write
    -> m Int32
    -- ^ __Returns:__ 0 on succeess, or -1 on error.
imageInplace :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Int32
imageInplace a
image = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Int32
result <- Ptr Image -> ImageWrittenCallback
vips_image_inplace Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImageInplaceMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImageInplaceMethodInfo a signature where
    overloadedMethod = imageInplace

instance O.OverloadedMethodInfo ImageInplaceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageInplace",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageInplace"
        })


#endif

-- method Image::invalidate_all
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#VipsImage to invalidate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_invalidate_all" vips_image_invalidate_all :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO ()

-- | Invalidate all pixel caches on /@image@/ and any downstream images, that
-- is, images which depend on this image. Additionally, all operations which
-- depend upon this image are dropped from the VIPS operation cache.
-- 
-- You should call this function after
-- destructively modifying an image with something like @/vips_draw_circle()/@.
-- 
-- The [Image::invalidate]("GI.Vips.Objects.Image#g:signal:invalidate") signal is emitted for all invalidated images.
-- 
-- See also: 'GI.Vips.Objects.Region.regionInvalidate'.
imageInvalidateAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: t'GI.Vips.Objects.Image.Image' to invalidate
    -> m ()
imageInvalidateAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m ()
imageInvalidateAll a
image = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Ptr Image -> IO ()
vips_image_invalidate_all Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageInvalidateAllMethodInfo
instance (signature ~ (m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageInvalidateAllMethodInfo a signature where
    overloadedMethod = imageInvalidateAll

instance O.OverloadedMethodInfo ImageInvalidateAllMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageInvalidateAll",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageInvalidateAll"
        })


#endif

-- method Image::isMSBfirst
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image 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_image_isMSBfirst" vips_image_isMSBfirst :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CInt

-- | Return 'P.True' if /@image@/ is in most-significant-
-- byte first form. This is the byte order used on the SPARC
-- architecture and others.
imageIsMSBfirst ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to test
    -> m Bool
imageIsMSBfirst :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Bool
imageIsMSBfirst a
image = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CInt
result <- Ptr Image -> IO CInt
vips_image_isMSBfirst Ptr Image
image'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ImageIsMSBfirstMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsImage a) => O.OverloadedMethod ImageIsMSBfirstMethodInfo a signature where
    overloadedMethod = imageIsMSBfirst

instance O.OverloadedMethodInfo ImageIsMSBfirstMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageIsMSBfirst",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageIsMSBfirst"
        })


#endif

-- method Image::is_sequential
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#VipsImage to minimise"
--                 , 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_image_is_sequential" vips_image_is_sequential :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CInt

-- | TRUE if any of the images upstream from /@image@/ were opened in sequential
-- mode. Some operations change behaviour slightly in sequential mode to
-- optimize memory behaviour.
imageIsSequential ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: t'GI.Vips.Objects.Image.Image' to minimise
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@image@/ is in sequential mode.
imageIsSequential :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Bool
imageIsSequential a
image = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CInt
result <- Ptr Image -> IO CInt
vips_image_is_sequential Ptr Image
image'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ImageIsSequentialMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsImage a) => O.OverloadedMethod ImageIsSequentialMethodInfo a signature where
    overloadedMethod = imageIsSequential

instance O.OverloadedMethodInfo ImageIsSequentialMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageIsSequential",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageIsSequential"
        })


#endif

-- method Image::isfile
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image 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_image_isfile" vips_image_isfile :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CInt

-- | Return 'P.True' if /@image@/ represents a file on disc in some way.
imageIsfile ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to test
    -> m Bool
imageIsfile :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Bool
imageIsfile a
image = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CInt
result <- Ptr Image -> IO CInt
vips_image_isfile Ptr Image
image'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ImageIsfileMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsImage a) => O.OverloadedMethod ImageIsfileMethodInfo a signature where
    overloadedMethod = imageIsfile

instance O.OverloadedMethodInfo ImageIsfileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageIsfile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageIsfile"
        })


#endif

-- method Image::iskilled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image 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_image_iskilled" vips_image_iskilled :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CInt

-- | If /@image@/ has been killed (see 'GI.Vips.Objects.Image.imageSetKill'), set an error message,
-- clear the t'GI.Vips.Objects.Image.Image'.@/kill/@ flag and return 'P.True'. Otherwise return 'P.False'.
-- 
-- Handy for loops which need to run sets of threads which can fail.
-- 
-- See also: 'GI.Vips.Objects.Image.imageSetKill'.
imageIskilled ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to test
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@image@/ has been killed.
imageIskilled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Bool
imageIskilled a
image = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CInt
result <- Ptr Image -> IO CInt
vips_image_iskilled Ptr Image
image'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ImageIskilledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsImage a) => O.OverloadedMethod ImageIskilledMethodInfo a signature where
    overloadedMethod = imageIskilled

instance O.OverloadedMethodInfo ImageIskilledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageIskilled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageIskilled"
        })


#endif

-- method Image::ispartial
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image 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_image_ispartial" vips_image_ispartial :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO CInt

-- | Return 'P.True' if /@im@/ represents a partial image (a delayed calculation).
imageIspartial ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to test
    -> m Bool
imageIspartial :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Bool
imageIspartial a
image = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CInt
result <- Ptr Image -> IO CInt
vips_image_ispartial Ptr Image
image'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ImageIspartialMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsImage a) => O.OverloadedMethod ImageIspartialMethodInfo a signature where
    overloadedMethod = imageIspartial

instance O.OverloadedMethodInfo ImageIspartialMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageIspartial",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageIspartial"
        })


#endif

-- XXX Could not generate method Image::map
{-  Bad introspection data: Closure not found! 
    Closure: 1
    c2cm: fromList []
    callable: Callable
      { returnType = Just (TBasicType TPtr)
      , returnMayBeNull = True
      , returnTransfer = TransferNothing
      , returnDocumentation =
          Documentation
            { rawDocText =
                Just "%NULL on success, the failing pointer otherwise."
            , sinceVersion = Nothing
            }
      , args =
          [ Arg
              { argCName = "image"
              , argType = TInterface Name { namespace = "Vips" , name = "Image" }
              , direction = DirectionIn
              , mayBeNull = False
              , argDoc =
                  Documentation
                    { rawDocText = Just "image to map over" , sinceVersion = Nothing }
              , argScope = ScopeTypeInvalid
              , argClosure = -1
              , argDestroy = -1
              , argCallerAllocates = False
              , transfer = TransferNothing
              }
          , Arg
              { argCName = "fn"
              , argType =
                  TInterface Name { namespace = "Vips" , name = "ImageMapFn" }
              , direction = DirectionIn
              , mayBeNull = True
              , argDoc =
                  Documentation
                    { rawDocText = Just "function to call for each header field"
                    , 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 for function"
                    , sinceVersion = Nothing
                    }
              , argScope = ScopeTypeInvalid
              , argClosure = 1
              , argDestroy = -1
              , argCallerAllocates = False
              , transfer = TransferNothing
              }
          ]
      , skipReturn = False
      , callableThrows = False
      , callableDeprecated = Nothing
      , callableDocumentation =
          Documentation
            { rawDocText =
                Just
                  "This function calls @fn for every header field, including every item of\nmetadata.\n\nLike all _map functions, the user function should return %NULL to continue\niteration, or a non-%NULL pointer to indicate early termination.\n\nSee also: vips_image_get_typeof(), vips_image_get()."
            , sinceVersion = Nothing
            }
      , callableResolvable = Just True
      }
-}
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data ImageMapMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "map" Image) => O.OverloadedMethod ImageMapMethodInfo o p where
    overloadedMethod = undefined

instance (o ~ O.UnsupportedMethodError "map" Image) => O.OverloadedMethodInfo ImageMapMethodInfo o where
    overloadedMethodInfo = undefined

#endif

-- method Image::minimise_all
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#VipsImage to minimise"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_minimise_all" vips_image_minimise_all :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO ()

-- | Minimise memory use on this image and any upstream images, that is, images
-- which this image depends upon. This function is called automatically at the
-- end of a computation, but it might be useful to call at other times.
-- 
-- The [Image::minimise]("GI.Vips.Objects.Image#g:signal:minimise") signal is emitted for all minimised images.
imageMinimiseAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: t'GI.Vips.Objects.Image.Image' to minimise
    -> m ()
imageMinimiseAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m ()
imageMinimiseAll a
image = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Ptr Image -> IO ()
vips_image_minimise_all Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageMinimiseAllMethodInfo
instance (signature ~ (m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageMinimiseAllMethodInfo a signature where
    overloadedMethod = imageMinimiseAll

instance O.OverloadedMethodInfo ImageMinimiseAllMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageMinimiseAll",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageMinimiseAll"
        })


#endif

-- method Image::pio_input
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to check" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_pio_input" vips_image_pio_input :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | Check that an image is readable with 'GI.Vips.Objects.Region.regionPrepare' and friends.
-- If it isn\'t, try to transform the image so that 'GI.Vips.Objects.Region.regionPrepare' can
-- work.
-- 
-- See also: 'GI.Vips.Objects.Image.imagePioOutput', 'GI.Vips.Objects.Region.regionPrepare'.
imagePioInput ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to check
    -> m Int32
    -- ^ __Returns:__ 0 on succeess, or -1 on error.
imagePioInput :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Int32
imagePioInput a
image = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Int32
result <- Ptr Image -> ImageWrittenCallback
vips_image_pio_input Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImagePioInputMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImagePioInputMethodInfo a signature where
    overloadedMethod = imagePioInput

instance O.OverloadedMethodInfo ImagePioInputMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imagePioInput",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imagePioInput"
        })


#endif

-- method Image::pio_output
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to check" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_pio_output" vips_image_pio_output :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | Check that an image is writeable with @/vips_image_generate()/@. If it isn\'t,
-- try to transform the image so that @/vips_image_generate()/@ can work.
-- 
-- See also: 'GI.Vips.Objects.Image.imagePioInput'.
imagePioOutput ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to check
    -> m Int32
    -- ^ __Returns:__ 0 on succeess, or -1 on error.
imagePioOutput :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Int32
imagePioOutput a
image = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Int32
result <- Ptr Image -> ImageWrittenCallback
vips_image_pio_output Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImagePioOutputMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImagePioOutputMethodInfo a signature where
    overloadedMethod = imagePioOutput

instance O.OverloadedMethodInfo ImagePioOutputMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imagePioOutput",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imagePioOutput"
        })


#endif

-- method Image::print_field
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to get the header field from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "field name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_print_field" vips_image_print_field :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    IO ()

-- | Prints field /@name@/ to stdout as ASCII. Handy for debugging.
imagePrintField ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to get the header field from
    -> T.Text
    -- ^ /@name@/: field name
    -> m ()
imagePrintField :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> m ()
imagePrintField a
image Text
name = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Image -> CString -> IO ()
vips_image_print_field Ptr Image
image' CString
name'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImagePrintFieldMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImagePrintFieldMethodInfo a signature where
    overloadedMethod = imagePrintField

instance O.OverloadedMethodInfo ImagePrintFieldMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imagePrintField",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imagePrintField"
        })


#endif

-- method Image::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to test" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name to search for"
--                 , 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_image_remove" vips_image_remove :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    IO CInt

-- | Find and remove an item of metadata. Return 'P.False' if no metadata of that
-- name was found.
-- 
-- See also: 'GI.Vips.Objects.Image.imageSet', 'GI.Vips.Objects.Image.imageGetTypeof'.
imageRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to test
    -> T.Text
    -- ^ /@name@/: the name to search for
    -> m Bool
    -- ^ __Returns:__ 'P.True' if an item of metadata of that name was found and removed
imageRemove :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> m Bool
imageRemove a
image Text
name = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    CInt
result <- Ptr Image -> CString -> IO CInt
vips_image_remove Ptr Image
image' CString
name'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ImageRemoveMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsImage a) => O.OverloadedMethod ImageRemoveMethodInfo a signature where
    overloadedMethod = imageRemove

instance O.OverloadedMethodInfo ImageRemoveMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageRemove",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageRemove"
        })


#endif

-- method Image::reorder_margin_hint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the image to hint on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "margin"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the size of the margin this operation has added"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_reorder_margin_hint" vips_reorder_margin_hint :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    Int32 ->                                -- margin : TBasicType TInt
    IO ()

-- | 'GI.Vips.Objects.Image.imageReorderMarginHint' sets a hint that /@image@/ contains a margin, that
-- is, that each 'GI.Vips.Objects.Region.regionPrepare' on /@image@/ will request a slightly larger
-- region from it\'s inputs. A good value for /@margin@/ is (width * height) for
-- the window the operation uses.
-- 
-- This information is used by @/vips_image_prepare_many()/@ to attempt to reorder
-- computations to minimise recomputation.
-- 
-- See also: @/vips_image_prepare_many()/@.
imageReorderMarginHint ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: the image to hint on
    -> Int32
    -- ^ /@margin@/: the size of the margin this operation has added
    -> m ()
imageReorderMarginHint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Int32 -> m ()
imageReorderMarginHint a
image Int32
margin = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Ptr Image -> Int32 -> IO ()
vips_reorder_margin_hint Ptr Image
image' Int32
margin
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageReorderMarginHintMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageReorderMarginHintMethodInfo a signature where
    overloadedMethod = imageReorderMarginHint

instance O.OverloadedMethodInfo ImageReorderMarginHintMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageReorderMarginHint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageReorderMarginHint"
        })


#endif

-- method Image::reorder_prepare_many
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the image that's being written"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "regions"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 (-1)
--                 (TInterface Name { namespace = "Vips" , name = "Region" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the set of regions to prepare"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #VipsRect to prepare on each region"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_reorder_prepare_many" vips_reorder_prepare_many :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    Ptr (Ptr Vips.Region.Region) ->         -- regions : TCArray False (-1) (-1) (TInterface (Name {namespace = "Vips", name = "Region"}))
    Ptr Vips.Rect.Rect ->                   -- r : TInterface (Name {namespace = "Vips", name = "Rect"})
    IO Int32

-- | 'GI.Vips.Objects.Image.imageReorderPrepareMany' runs 'GI.Vips.Objects.Region.regionPrepare' on each region in
-- /@regions@/, requesting the pixels in /@r@/.
-- 
-- It tries to request the regions in the order which will cause least
-- recomputation. This can give a large speedup, in some cases.
-- 
-- See also: 'GI.Vips.Objects.Region.regionPrepare', 'GI.Vips.Objects.Image.imageReorderMarginHint'.
imageReorderPrepareMany ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: the image that\'s being written
    -> [Vips.Region.Region]
    -- ^ /@regions@/: the set of regions to prepare
    -> Vips.Rect.Rect
    -- ^ /@r@/: the t'GI.Vips.Structs.Rect.Rect' to prepare on each region
    -> m Int32
    -- ^ __Returns:__ 0 on success, or -1 on error.
imageReorderPrepareMany :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> [Region] -> Rect -> m Int32
imageReorderPrepareMany a
image [Region]
regions Rect
r = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    [Ptr Region]
regions' <- (Region -> IO (Ptr Region)) -> [Region] -> IO [Ptr Region]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Region -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [Region]
regions
    Ptr (Ptr Region)
regions'' <- [Ptr Region] -> IO (Ptr (Ptr Region))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packPtrArray [Ptr Region]
regions'
    Ptr Rect
r' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r
    Int32
result <- Ptr Image -> Ptr (Ptr Region) -> Ptr Rect -> ImageWrittenCallback
vips_reorder_prepare_many Ptr Image
image' Ptr (Ptr Region)
regions'' Ptr Rect
r'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    (Region -> IO ()) -> [Region] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Region -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Region]
regions
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r
    Ptr (Ptr Region) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Region)
regions''
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImageReorderPrepareManyMethodInfo
instance (signature ~ ([Vips.Region.Region] -> Vips.Rect.Rect -> m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImageReorderPrepareManyMethodInfo a signature where
    overloadedMethod = imageReorderPrepareMany

instance O.OverloadedMethodInfo ImageReorderPrepareManyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageReorderPrepareMany",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageReorderPrepareMany"
        })


#endif

-- method Image::set
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to set the metadata on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name to give the metadata"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %GValue to copy into the image"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_set" vips_image_set :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Set a piece of metadata on /@image@/. Any old metadata with that name is
-- destroyed. The @/GValue/@ is copied into the image, so you need to unset the
-- value when you\'re done with it.
-- 
-- For example, to set an integer on an image (though you would use the
-- convenience function 'GI.Vips.Objects.Image.imageSetInt' in practice), you would do:
-- 
-- >
-- >GValue value = { 0 };
-- >
-- >g_value_init (&value, G_TYPE_INT);
-- >g_value_set_int (&value, 42);
-- >vips_image_set (image, name, &value);
-- >g_value_unset (&value);
-- 
-- 
-- See also: 'GI.Vips.Objects.Image.imageGet'.
imageSet ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to set the metadata on
    -> T.Text
    -- ^ /@name@/: the name to give the metadata
    -> GValue
    -- ^ /@value@/: the @/GValue/@ to copy into the image
    -> m ()
imageSet :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> GValue -> m ()
imageSet a
image Text
name GValue
value = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Image -> CString -> Ptr GValue -> IO ()
vips_image_set Ptr Image
image' CString
name' Ptr GValue
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageSetMethodInfo
instance (signature ~ (T.Text -> GValue -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageSetMethodInfo a signature where
    overloadedMethod = imageSet

instance O.OverloadedMethodInfo ImageSetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageSet",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageSet"
        })


#endif

-- method Image::set_area
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to attach the metadata to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "free_fn"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "CallbackFn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "free function for @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to area of memory"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_set_area" vips_image_set_area :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    FunPtr Vips.Callbacks.C_CallbackFn ->   -- free_fn : TInterface (Name {namespace = "Vips", name = "CallbackFn"})
    Ptr () ->                               -- data : TBasicType TPtr
    IO ()

-- | Attaches /@data@/ as a metadata item on /@image@/ under the name /@name@/. When
-- VIPS no longer needs the metadata, it will be freed with /@freeFn@/.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGetDouble', 'GI.Vips.Objects.Image.imageSet'
imageSetArea ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to attach the metadata to
    -> T.Text
    -- ^ /@name@/: metadata name
    -> Vips.Callbacks.CallbackFn
    -- ^ /@freeFn@/: free function for /@data@/
    -> m ()
imageSetArea :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> CallbackFn -> m ()
imageSetArea a
image Text
name CallbackFn
freeFn = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr (FunPtr CallbackFn)
ptrfreeFn <- IO (Ptr (FunPtr CallbackFn))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Vips.Callbacks.C_CallbackFn))
    FunPtr CallbackFn
freeFn' <- CallbackFn -> IO (FunPtr CallbackFn)
Vips.Callbacks.mk_CallbackFn (Maybe (Ptr (FunPtr CallbackFn)) -> CallbackFn -> CallbackFn
Vips.Callbacks.wrap_CallbackFn (Ptr (FunPtr CallbackFn) -> Maybe (Ptr (FunPtr CallbackFn))
forall a. a -> Maybe a
Just Ptr (FunPtr CallbackFn)
ptrfreeFn) CallbackFn
freeFn)
    Ptr (FunPtr CallbackFn) -> FunPtr CallbackFn -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr CallbackFn)
ptrfreeFn FunPtr CallbackFn
freeFn'
    let data_ :: Ptr a
data_ = Ptr a
forall a. Ptr a
nullPtr
    Ptr Image -> CString -> FunPtr CallbackFn -> Ptr () -> IO ()
vips_image_set_area Ptr Image
image' CString
name' FunPtr CallbackFn
freeFn' Ptr ()
forall a. Ptr a
data_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageSetAreaMethodInfo
instance (signature ~ (T.Text -> Vips.Callbacks.CallbackFn -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageSetAreaMethodInfo a signature where
    overloadedMethod = imageSetArea

instance O.OverloadedMethodInfo ImageSetAreaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageSetArea",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageSetArea"
        })


#endif

-- method Image::set_array_double
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to attach the metadata to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "array"
--           , argType = TCArray False (-1) 3 (TBasicType TDouble)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "array of doubles" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of elements"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of elements"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_set_array_double" vips_image_set_array_double :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr CDouble ->                          -- array : TCArray False (-1) 3 (TBasicType TDouble)
    Int32 ->                                -- n : TBasicType TInt
    IO ()

-- | Attaches /@array@/ as a metadata item on /@image@/ as /@name@/.
-- A convenience function over 'GI.Vips.Objects.Image.imageSet'.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGetImage', 'GI.Vips.Objects.Image.imageSet'.
imageSetArrayDouble ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to attach the metadata to
    -> T.Text
    -- ^ /@name@/: metadata name
    -> Maybe ([Double])
    -- ^ /@array@/: array of doubles
    -> m ()
imageSetArrayDouble :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> Maybe [Double] -> m ()
imageSetArrayDouble a
image Text
name Maybe [Double]
array = 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 n :: Int32
n = case Maybe [Double]
array of
            Maybe [Double]
Nothing -> Int32
0
            Just [Double]
jArray -> Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Double]
jArray
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr CDouble
maybeArray <- case Maybe [Double]
array of
        Maybe [Double]
Nothing -> Ptr CDouble -> IO (Ptr CDouble)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CDouble
forall a. Ptr a
nullPtr
        Just [Double]
jArray -> do
            Ptr CDouble
jArray' <- ((Double -> CDouble) -> [Double] -> IO (Ptr CDouble)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac) [Double]
jArray
            Ptr CDouble -> IO (Ptr CDouble)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CDouble
jArray'
    Ptr Image -> CString -> Ptr CDouble -> Int32 -> IO ()
vips_image_set_array_double Ptr Image
image' CString
name' Ptr CDouble
maybeArray Int32
n
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
maybeArray
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageSetArrayDoubleMethodInfo
instance (signature ~ (T.Text -> Maybe ([Double]) -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageSetArrayDoubleMethodInfo a signature where
    overloadedMethod = imageSetArrayDouble

instance O.OverloadedMethodInfo ImageSetArrayDoubleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageSetArrayDouble",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageSetArrayDouble"
        })


#endif

-- method Image::set_array_int
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to attach the metadata to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "array"
--           , argType = TCArray False (-1) 3 (TBasicType TInt)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "array of ints" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of elements"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of elements"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_set_array_int" vips_image_set_array_int :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr Int32 ->                            -- array : TCArray False (-1) 3 (TBasicType TInt)
    Int32 ->                                -- n : TBasicType TInt
    IO ()

-- | Attaches /@array@/ as a metadata item on /@image@/ as /@name@/.
-- A convenience function over 'GI.Vips.Objects.Image.imageSet'.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGetImage', 'GI.Vips.Objects.Image.imageSet'.
imageSetArrayInt ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to attach the metadata to
    -> T.Text
    -- ^ /@name@/: metadata name
    -> Maybe ([Int32])
    -- ^ /@array@/: array of ints
    -> m ()
imageSetArrayInt :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> Maybe [Int32] -> m ()
imageSetArrayInt a
image Text
name Maybe [Int32]
array = 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 n :: Int32
n = case Maybe [Int32]
array of
            Maybe [Int32]
Nothing -> Int32
0
            Just [Int32]
jArray -> Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Int32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Int32]
jArray
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Int32
maybeArray <- case Maybe [Int32]
array of
        Maybe [Int32]
Nothing -> Ptr Int32 -> IO (Ptr Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Int32
forall a. Ptr a
nullPtr
        Just [Int32]
jArray -> do
            Ptr Int32
jArray' <- [Int32] -> IO (Ptr Int32)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [Int32]
jArray
            Ptr Int32 -> IO (Ptr Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Int32
jArray'
    Ptr Image -> CString -> Ptr Int32 -> Int32 -> IO ()
vips_image_set_array_int Ptr Image
image' CString
name' Ptr Int32
maybeArray Int32
n
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
maybeArray
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageSetArrayIntMethodInfo
instance (signature ~ (T.Text -> Maybe ([Int32]) -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageSetArrayIntMethodInfo a signature where
    overloadedMethod = imageSetArrayInt

instance O.OverloadedMethodInfo ImageSetArrayIntMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageSetArrayInt",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageSetArrayInt"
        })


#endif

-- method Image::set_blob
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to attach the metadata to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "free_fn"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "CallbackFn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "free function for @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 4 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to area of memory"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "length of memory area"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "length of memory area"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_set_blob" vips_image_set_blob :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    FunPtr Vips.Callbacks.C_CallbackFn ->   -- free_fn : TInterface (Name {namespace = "Vips", name = "CallbackFn"})
    Ptr Word8 ->                            -- data : TCArray False (-1) 4 (TBasicType TUInt8)
    Word64 ->                               -- length : TBasicType TUInt64
    IO ()

-- | Attaches /@blob@/ as a metadata item on /@image@/ under the name /@name@/. A
-- convenience
-- function over 'GI.Vips.Objects.Image.imageSet' using a vips_blob.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGetBlob', 'GI.Vips.Objects.Image.imageSet'.
imageSetBlob ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to attach the metadata to
    -> T.Text
    -- ^ /@name@/: metadata name
    -> Vips.Callbacks.CallbackFn
    -- ^ /@freeFn@/: free function for /@data@/
    -> ByteString
    -- ^ /@data@/: pointer to area of memory
    -> m ()
imageSetBlob :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> CallbackFn -> ByteString -> m ()
imageSetBlob a
image Text
name CallbackFn
freeFn ByteString
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 length_ :: Word64
length_ = 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 Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr (FunPtr CallbackFn)
ptrfreeFn <- IO (Ptr (FunPtr CallbackFn))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Vips.Callbacks.C_CallbackFn))
    FunPtr CallbackFn
freeFn' <- CallbackFn -> IO (FunPtr CallbackFn)
Vips.Callbacks.mk_CallbackFn (Maybe (Ptr (FunPtr CallbackFn)) -> CallbackFn -> CallbackFn
Vips.Callbacks.wrap_CallbackFn (Ptr (FunPtr CallbackFn) -> Maybe (Ptr (FunPtr CallbackFn))
forall a. a -> Maybe a
Just Ptr (FunPtr CallbackFn)
ptrfreeFn) CallbackFn
freeFn)
    Ptr (FunPtr CallbackFn) -> FunPtr CallbackFn -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr CallbackFn)
ptrfreeFn FunPtr CallbackFn
freeFn'
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    Ptr Image
-> CString -> FunPtr CallbackFn -> Ptr Word8 -> Word64 -> IO ()
vips_image_set_blob Ptr Image
image' CString
name' FunPtr CallbackFn
freeFn' Ptr Word8
data_' Word64
length_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageSetBlobMethodInfo
instance (signature ~ (T.Text -> Vips.Callbacks.CallbackFn -> ByteString -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageSetBlobMethodInfo a signature where
    overloadedMethod = imageSetBlob

instance O.OverloadedMethodInfo ImageSetBlobMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageSetBlob",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageSetBlob"
        })


#endif

-- method Image::set_blob_copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to attach the metadata to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 3 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to area of memory"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "length of memory area"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "length of memory area"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_set_blob_copy" vips_image_set_blob_copy :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr Word8 ->                            -- data : TCArray False (-1) 3 (TBasicType TUInt8)
    Word64 ->                               -- length : TBasicType TUInt64
    IO ()

-- | Attaches /@blob@/ as a metadata item on /@image@/ under the name /@name@/, taking
-- a copy of the memory area. A convenience function over
-- 'GI.Vips.Objects.Image.imageSetBlob'.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGetBlob', 'GI.Vips.Objects.Image.imageSet'.
imageSetBlobCopy ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to attach the metadata to
    -> T.Text
    -- ^ /@name@/: metadata name
    -> ByteString
    -- ^ /@data@/: pointer to area of memory
    -> m ()
imageSetBlobCopy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> ByteString -> m ()
imageSetBlobCopy a
image Text
name ByteString
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 length_ :: Word64
length_ = 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 Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    Ptr Image -> CString -> Ptr Word8 -> Word64 -> IO ()
vips_image_set_blob_copy Ptr Image
image' CString
name' Ptr Word8
data_' Word64
length_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageSetBlobCopyMethodInfo
instance (signature ~ (T.Text -> ByteString -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageSetBlobCopyMethodInfo a signature where
    overloadedMethod = imageSetBlobCopy

instance O.OverloadedMethodInfo ImageSetBlobCopyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageSetBlobCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageSetBlobCopy"
        })


#endif

-- method Image::set_delete_on_close
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "delete_on_close"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "format of file" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_set_delete_on_close" vips_image_set_delete_on_close :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CInt ->                                 -- delete_on_close : TBasicType TBoolean
    IO ()

-- | Sets the delete_on_close flag for the image. If this flag is set, when
-- /@image@/ is finalized, the filename held in /@image@/->filename at the time of
-- this call is deleted.
-- 
-- This function is clearly extremely dangerous, use with great caution.
-- 
-- See also: 'GI.Vips.Objects.Image.imageNewTempFile'.
imageSetDeleteOnClose ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to set
    -> Bool
    -- ^ /@deleteOnClose@/: format of file
    -> m ()
imageSetDeleteOnClose :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Bool -> m ()
imageSetDeleteOnClose a
image Bool
deleteOnClose = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    let deleteOnClose' :: CInt
deleteOnClose' = (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
deleteOnClose
    Ptr Image -> CInt -> IO ()
vips_image_set_delete_on_close Ptr Image
image' CInt
deleteOnClose'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageSetDeleteOnCloseMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageSetDeleteOnCloseMethodInfo a signature where
    overloadedMethod = imageSetDeleteOnClose

instance O.OverloadedMethodInfo ImageSetDeleteOnCloseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageSetDeleteOnClose",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageSetDeleteOnClose"
        })


#endif

-- method Image::set_double
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to attach the metadata to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "d"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_set_double" vips_image_set_double :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    CDouble ->                              -- d : TBasicType TDouble
    IO ()

-- | Attaches /@d@/ as a metadata item on /@image@/ as /@name@/. A
-- convenience
-- function over 'GI.Vips.Objects.Image.imageSet'.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGetDouble', 'GI.Vips.Objects.Image.imageSet'
imageSetDouble ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to attach the metadata to
    -> T.Text
    -- ^ /@name@/: metadata name
    -> Double
    -- ^ /@d@/: metadata value
    -> m ()
imageSetDouble :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> Double -> m ()
imageSetDouble a
image Text
name Double
d = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    let d' :: CDouble
d' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d
    Ptr Image -> CString -> CDouble -> IO ()
vips_image_set_double Ptr Image
image' CString
name' CDouble
d'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageSetDoubleMethodInfo
instance (signature ~ (T.Text -> Double -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageSetDoubleMethodInfo a signature where
    overloadedMethod = imageSetDouble

instance O.OverloadedMethodInfo ImageSetDoubleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageSetDouble",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageSetDouble"
        })


#endif

-- method Image::set_image
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to attach the metadata to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "im"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_set_image" vips_image_set_image :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr Image ->                            -- im : TInterface (Name {namespace = "Vips", name = "Image"})
    IO ()

-- | Attaches /@im@/ as a metadata item on /@image@/ as /@name@/.
-- A convenience function over 'GI.Vips.Objects.Image.imageSet'.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGetImage', 'GI.Vips.Objects.Image.imageSet'.
imageSetImage ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a, IsImage b) =>
    a
    -- ^ /@image@/: image to attach the metadata to
    -> T.Text
    -- ^ /@name@/: metadata name
    -> b
    -- ^ /@im@/: metadata value
    -> m ()
imageSetImage :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsImage a, IsImage b) =>
a -> Text -> b -> m ()
imageSetImage a
image Text
name b
im = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Image
im' <- b -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
im
    Ptr Image -> CString -> Ptr Image -> IO ()
vips_image_set_image Ptr Image
image' CString
name' Ptr Image
im'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
im
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageSetImageMethodInfo
instance (signature ~ (T.Text -> b -> m ()), MonadIO m, IsImage a, IsImage b) => O.OverloadedMethod ImageSetImageMethodInfo a signature where
    overloadedMethod = imageSetImage

instance O.OverloadedMethodInfo ImageSetImageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageSetImage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageSetImage"
        })


#endif

-- method Image::set_int
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to attach the metadata to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "i"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_set_int" vips_image_set_int :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    Int32 ->                                -- i : TBasicType TInt
    IO ()

-- | Attaches /@i@/ as a metadata item on /@image@/ under the name /@name@/. A
-- convenience
-- function over 'GI.Vips.Objects.Image.imageSet'.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGetInt', 'GI.Vips.Objects.Image.imageSet'
imageSetInt ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to attach the metadata to
    -> T.Text
    -- ^ /@name@/: metadata name
    -> Int32
    -- ^ /@i@/: metadata value
    -> m ()
imageSetInt :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> Int32 -> m ()
imageSetInt a
image Text
name Int32
i = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Image -> CString -> Int32 -> IO ()
vips_image_set_int Ptr Image
image' CString
name' Int32
i
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageSetIntMethodInfo
instance (signature ~ (T.Text -> Int32 -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageSetIntMethodInfo a signature where
    overloadedMethod = imageSetInt

instance O.OverloadedMethodInfo ImageSetIntMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageSetInt",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageSetInt"
        })


#endif

-- method Image::set_kill
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to test" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "kill"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the kill state" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_set_kill" vips_image_set_kill :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CInt ->                                 -- kill : TBasicType TBoolean
    IO ()

-- | Set the t'GI.Vips.Objects.Image.Image'.@/kill/@ flag on an image. Handy for stopping sets of
-- threads.
-- 
-- See also: 'GI.Vips.Objects.Image.imageIskilled'.
imageSetKill ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to test
    -> Bool
    -- ^ /@kill@/: the kill state
    -> m ()
imageSetKill :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Bool -> m ()
imageSetKill a
image Bool
kill = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    let kill' :: CInt
kill' = (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
kill
    Ptr Image -> CInt -> IO ()
vips_image_set_kill Ptr Image
image' CInt
kill'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageSetKillMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageSetKillMethodInfo a signature where
    overloadedMethod = imageSetKill

instance O.OverloadedMethodInfo ImageSetKillMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageSetKill",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageSetKill"
        })


#endif

-- method Image::set_progress
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to signal progress on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "turn progress reporting on or off"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_set_progress" vips_image_set_progress :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CInt ->                                 -- progress : TBasicType TBoolean
    IO ()

-- | vips signals evaluation progress via the [Image::preeval]("GI.Vips.Objects.Image#g:signal:preeval"),
-- [Image::eval]("GI.Vips.Objects.Image#g:signal:eval") and [Image::posteval]("GI.Vips.Objects.Image#g:signal:posteval")
-- signals. Progress is signalled on the most-downstream image for which
-- 'GI.Vips.Objects.Image.imageSetProgress' was called.
imageSetProgress ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to signal progress on
    -> Bool
    -- ^ /@progress@/: turn progress reporting on or off
    -> m ()
imageSetProgress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Bool -> m ()
imageSetProgress a
image Bool
progress = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    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
    Ptr Image -> CInt -> IO ()
vips_image_set_progress Ptr Image
image' CInt
progress'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageSetProgressMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageSetProgressMethodInfo a signature where
    overloadedMethod = imageSetProgress

instance O.OverloadedMethodInfo ImageSetProgressMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageSetProgress",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageSetProgress"
        })


#endif

-- method Image::set_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to attach the metadata to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "metadata value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_set_string" vips_image_set_string :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- str : TBasicType TUTF8
    IO ()

-- | Attaches /@str@/ as a metadata item on /@image@/ as /@name@/.
-- A convenience
-- function over 'GI.Vips.Objects.Image.imageSet' using @/VIPS_TYPE_REF_STRING/@.
-- 
-- See also: 'GI.Vips.Objects.Image.imageGetDouble', 'GI.Vips.Objects.Image.imageSet'.
imageSetString ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to attach the metadata to
    -> T.Text
    -- ^ /@name@/: metadata name
    -> T.Text
    -- ^ /@str@/: metadata value
    -> m ()
imageSetString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Text -> Text -> m ()
imageSetString a
image Text
name Text
str = 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
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
str' <- Text -> IO CString
textToCString Text
str
    Ptr Image -> CString -> CString -> IO ()
vips_image_set_string Ptr Image
image' CString
name' CString
str'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ImageSetStringMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsImage a) => O.OverloadedMethod ImageSetStringMethodInfo a signature where
    overloadedMethod = imageSetString

instance O.OverloadedMethodInfo ImageSetStringMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageSetString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageSetString"
        })


#endif

-- method Image::wio_input
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to transform" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_wio_input" vips_image_wio_input :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | Check that an image is readable via the @/VIPS_IMAGE_ADDR()/@ macro, that is,
-- that the entire image is in memory and all pixels can be read with
-- @/VIPS_IMAGE_ADDR()/@.  If it
-- isn\'t, try to transform it so that @/VIPS_IMAGE_ADDR()/@ can work.
-- 
-- Since this function modifies /@image@/, it is not thread-safe. Only call it on
-- images which you are sure have not been shared with another thread. If the
-- image might have been shared, use the less efficient
-- 'GI.Vips.Objects.Image.imageCopyMemory' instead.
-- 
-- See also: 'GI.Vips.Objects.Image.imageCopyMemory', 'GI.Vips.Objects.Image.imagePioInput',
-- 'GI.Vips.Objects.Image.imageInplace', @/VIPS_IMAGE_ADDR()/@.
imageWioInput ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to transform
    -> m Int32
    -- ^ __Returns:__ 0 on succeess, or -1 on error.
imageWioInput :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Int32
imageWioInput a
image = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Int32
result <- Ptr Image -> ImageWrittenCallback
vips_image_wio_input Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImageWioInputMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImageWioInputMethodInfo a signature where
    overloadedMethod = imageWioInput

instance O.OverloadedMethodInfo ImageWioInputMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageWioInput",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageWioInput"
        })


#endif

-- method Image::write
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to write" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "write to this image"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_write" vips_image_write :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    Ptr (Ptr Image) ->                      -- out : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | Write /@image@/ to /@out@/. Use 'GI.Vips.Objects.Image.imageNew' and friends to create the
-- t'GI.Vips.Objects.Image.Image' you want to write to.
-- 
-- See also: 'GI.Vips.Objects.Image.imageNew', @/vips_copy()/@, @/vips_image_write_to_file()/@.
imageWrite ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to write
    -> m ((Int32, Image))
    -- ^ __Returns:__ 0 on success, or -1 on error.
imageWrite :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m (Int32, Image)
imageWrite a
image = IO (Int32, Image) -> m (Int32, Image)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Image) -> m (Int32, Image))
-> IO (Int32, Image) -> m (Int32, Image)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Ptr (Ptr Image)
out <- IO (Ptr (Ptr Image))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Image))
    Int32
result <- Ptr Image -> Ptr (Ptr Image) -> ImageWrittenCallback
vips_image_write Ptr Image
image' Ptr (Ptr Image)
out
    Ptr Image
out' <- Ptr (Ptr Image) -> IO (Ptr Image)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Image)
out
    Image
out'' <- ((ManagedPtr Image -> Image) -> Ptr Image -> IO Image
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Image -> Image
Image) Ptr Image
out'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Ptr (Ptr Image) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Image)
out
    (Int32, Image) -> IO (Int32, Image)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Image
out'')

#if defined(ENABLE_OVERLOADING)
data ImageWriteMethodInfo
instance (signature ~ (m ((Int32, Image))), MonadIO m, IsImage a) => O.OverloadedMethod ImageWriteMethodInfo a signature where
    overloadedMethod = imageWrite

instance O.OverloadedMethodInfo ImageWriteMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageWrite",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageWrite"
        })


#endif

-- method Image::write_line
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to write to" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ypos"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "vertical position of scan-line to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "linebuffer"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "scanline of pixels" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_write_line" vips_image_write_line :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    Int32 ->                                -- ypos : TBasicType TInt
    Word8 ->                                -- linebuffer : TBasicType TUInt8
    IO Int32

-- | Write a line of pixels to an image. This function must be called repeatedly
-- with /@ypos@/ increasing from 0 to t'GI.Vips.Objects.Image.Image'::@/height/@ .
-- /@linebuffer@/ must be @/VIPS_IMAGE_SIZEOF_LINE()/@ bytes long.
-- 
-- See also: @/vips_image_generate()/@.
imageWriteLine ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to write to
    -> Int32
    -- ^ /@ypos@/: vertical position of scan-line to write
    -> Word8
    -- ^ /@linebuffer@/: scanline of pixels
    -> m Int32
    -- ^ __Returns:__ 0 on success, or -1 on error.
imageWriteLine :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> Int32 -> Word8 -> m Int32
imageWriteLine a
image Int32
ypos Word8
linebuffer = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Int32
result <- Ptr Image -> Int32 -> Word8 -> ImageWrittenCallback
vips_image_write_line Ptr Image
image' Int32
ypos Word8
linebuffer
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImageWriteLineMethodInfo
instance (signature ~ (Int32 -> Word8 -> m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImageWriteLineMethodInfo a signature where
    overloadedMethod = imageWriteLine

instance O.OverloadedMethodInfo ImageWriteLineMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageWriteLine",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageWriteLine"
        })


#endif

-- method Image::write_prepare
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to prepare" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_write_prepare" vips_image_write_prepare :: 
    Ptr Image ->                            -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO Int32

-- | Call this after setting header fields (width, height, and so on) to
-- allocate resources ready for writing.
-- 
-- Normally this function is called for you by @/vips_image_generate()/@ or
-- 'GI.Vips.Objects.Image.imageWriteLine'. You will need to call it yourself if you plan to
-- write directly to the ->data member of a memory image.
imageWritePrepare ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@image@/: image to prepare
    -> m Int32
    -- ^ __Returns:__ 0 on success, or -1 on error.
imageWritePrepare :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Int32
imageWritePrepare a
image = ImageWrittenCallback -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ImageWrittenCallback -> m Int32)
-> ImageWrittenCallback -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Int32
result <- Ptr Image -> ImageWrittenCallback
vips_image_write_prepare Ptr Image
image'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Int32 -> ImageWrittenCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ImageWritePrepareMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsImage a) => O.OverloadedMethod ImageWritePrepareMethodInfo a signature where
    overloadedMethod = imageWritePrepare

instance O.OverloadedMethodInfo ImageWritePrepareMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageWritePrepare",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageWritePrepare"
        })


#endif

-- method Image::write_to_memory
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "in"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to write" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return buffer length here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "size"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "return buffer length here"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TUInt8))
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_write_to_memory" vips_image_write_to_memory :: 
    Ptr Image ->                            -- in : TInterface (Name {namespace = "Vips", name = "Image"})
    Ptr Word64 ->                           -- size : TBasicType TUInt64
    IO (Ptr Word8)

-- | Writes /@in@/ to memory as a simple, unformatted C-style array.
-- 
-- The caller is responsible for freeing this memory with 'GI.GLib.Functions.free'.
-- 
-- See also: @/vips_image_write_to_buffer()/@.
imageWriteToMemory ::
    (B.CallStack.HasCallStack, MonadIO m, IsImage a) =>
    a
    -- ^ /@in@/: image to write
    -> m ByteString
    -- ^ __Returns:__ return buffer start here
imageWriteToMemory :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m ByteString
imageWriteToMemory a
in_ = IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
in_' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
in_
    Ptr Word64
size <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word8
result <- Ptr Image -> Ptr Word64 -> IO (Ptr Word8)
vips_image_write_to_memory Ptr Image
in_' Ptr Word64
size
    Word64
size' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
size
    Text -> Ptr Word8 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"imageWriteToMemory" Ptr Word8
result
    ByteString
result' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
size') Ptr Word8
result
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
in_
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
size
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result'

#if defined(ENABLE_OVERLOADING)
data ImageWriteToMemoryMethodInfo
instance (signature ~ (m ByteString), MonadIO m, IsImage a) => O.OverloadedMethod ImageWriteToMemoryMethodInfo a signature where
    overloadedMethod = imageWriteToMemory

instance O.OverloadedMethodInfo ImageWriteToMemoryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vips.Objects.Image.imageWriteToMemory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vips-8.0.3/docs/GI-Vips-Objects-Image.html#v:imageWriteToMemory"
        })


#endif

-- method Image::get_format_max
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "BandFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "vips_image_get_format_max" vips_image_get_format_max :: 
    CInt ->                                 -- format : TInterface (Name {namespace = "Vips", name = "BandFormat"})
    IO CDouble

-- | /No description available in the introspection data./
imageGetFormatMax ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vips.Enums.BandFormat
    -- ^ /@format@/: the format
    -> m Double
    -- ^ __Returns:__ the maximum numeric value possible for this format.
imageGetFormatMax :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BandFormat -> m Double
imageGetFormatMax BandFormat
format = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    let format' :: CInt
format' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (BandFormat -> Int) -> BandFormat -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BandFormat -> Int
forall a. Enum a => a -> Int
fromEnum) BandFormat
format
    CDouble
result <- CInt -> IO CDouble
vips_image_get_format_max CInt
format'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
#endif