{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

A 'GI.GdkPixbuf.Structs.Pixdata.Pixdata' contains pixbuf information in a form suitable for
serialization and streaming.
-}

module GI.GdkPixbuf.Structs.Pixdata
    ( 

-- * Exported types
    Pixdata(..)                             ,
    newZeroPixdata                          ,
    noPixdata                               ,


 -- * Methods
-- ** deserialize #method:deserialize#
    PixdataDeserializeMethodInfo            ,
    pixdataDeserialize                      ,


-- ** serialize #method:serialize#
    PixdataSerializeMethodInfo              ,
    pixdataSerialize                        ,


-- ** toCsource #method:toCsource#
    PixdataToCsourceMethodInfo              ,
    pixdataToCsource                        ,




 -- * Properties
-- ** height #attr:height#
    getPixdataHeight                        ,
    pixdata_height                          ,
    setPixdataHeight                        ,


-- ** length #attr:length#
    getPixdataLength                        ,
    pixdata_length                          ,
    setPixdataLength                        ,


-- ** magic #attr:magic#
    getPixdataMagic                         ,
    pixdata_magic                           ,
    setPixdataMagic                         ,


-- ** pixdataType #attr:pixdataType#
    getPixdataPixdataType                   ,
    pixdata_pixdataType                     ,
    setPixdataPixdataType                   ,


-- ** pixelData #attr:pixelData#
    clearPixdataPixelData                   ,
    getPixdataPixelData                     ,
    pixdata_pixelData                       ,
    setPixdataPixelData                     ,


-- ** rowstride #attr:rowstride#
    getPixdataRowstride                     ,
    pixdata_rowstride                       ,
    setPixdataRowstride                     ,


-- ** width #attr:width#
    getPixdataWidth                         ,
    pixdata_width                           ,
    setPixdataWidth                         ,




    ) 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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 GI.GLib.Structs.String as GLib.String
import {-# SOURCE #-} qualified GI.GdkPixbuf.Flags as GdkPixbuf.Flags

newtype Pixdata = Pixdata (ManagedPtr Pixdata)
instance WrappedPtr Pixdata where
    wrappedPtrCalloc = callocBytes 32
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 32 >=> wrapPtr Pixdata)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `Pixdata` struct initialized to zero.
newZeroPixdata :: MonadIO m => m Pixdata
newZeroPixdata = liftIO $ wrappedPtrCalloc >>= wrapPtr Pixdata

instance tag ~ 'AttrSet => Constructible Pixdata tag where
    new _ attrs = do
        o <- newZeroPixdata
        GI.Attributes.set o attrs
        return o


noPixdata :: Maybe Pixdata
noPixdata = Nothing

getPixdataMagic :: MonadIO m => Pixdata -> m Word32
getPixdataMagic s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO Word32
    return val

setPixdataMagic :: MonadIO m => Pixdata -> Word32 -> m ()
setPixdataMagic s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: Word32)

data PixdataMagicFieldInfo
instance AttrInfo PixdataMagicFieldInfo where
    type AttrAllowedOps PixdataMagicFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PixdataMagicFieldInfo = (~) Word32
    type AttrBaseTypeConstraint PixdataMagicFieldInfo = (~) Pixdata
    type AttrGetType PixdataMagicFieldInfo = Word32
    type AttrLabel PixdataMagicFieldInfo = "magic"
    type AttrOrigin PixdataMagicFieldInfo = Pixdata
    attrGet _ = getPixdataMagic
    attrSet _ = setPixdataMagic
    attrConstruct = undefined
    attrClear _ = undefined

pixdata_magic :: AttrLabelProxy "magic"
pixdata_magic = AttrLabelProxy


getPixdataLength :: MonadIO m => Pixdata -> m Int32
getPixdataLength s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 4) :: IO Int32
    return val

setPixdataLength :: MonadIO m => Pixdata -> Int32 -> m ()
setPixdataLength s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 4) (val :: Int32)

data PixdataLengthFieldInfo
instance AttrInfo PixdataLengthFieldInfo where
    type AttrAllowedOps PixdataLengthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PixdataLengthFieldInfo = (~) Int32
    type AttrBaseTypeConstraint PixdataLengthFieldInfo = (~) Pixdata
    type AttrGetType PixdataLengthFieldInfo = Int32
    type AttrLabel PixdataLengthFieldInfo = "length"
    type AttrOrigin PixdataLengthFieldInfo = Pixdata
    attrGet _ = getPixdataLength
    attrSet _ = setPixdataLength
    attrConstruct = undefined
    attrClear _ = undefined

pixdata_length :: AttrLabelProxy "length"
pixdata_length = AttrLabelProxy


getPixdataPixdataType :: MonadIO m => Pixdata -> m Word32
getPixdataPixdataType s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO Word32
    return val

setPixdataPixdataType :: MonadIO m => Pixdata -> Word32 -> m ()
setPixdataPixdataType s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: Word32)

data PixdataPixdataTypeFieldInfo
instance AttrInfo PixdataPixdataTypeFieldInfo where
    type AttrAllowedOps PixdataPixdataTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PixdataPixdataTypeFieldInfo = (~) Word32
    type AttrBaseTypeConstraint PixdataPixdataTypeFieldInfo = (~) Pixdata
    type AttrGetType PixdataPixdataTypeFieldInfo = Word32
    type AttrLabel PixdataPixdataTypeFieldInfo = "pixdata_type"
    type AttrOrigin PixdataPixdataTypeFieldInfo = Pixdata
    attrGet _ = getPixdataPixdataType
    attrSet _ = setPixdataPixdataType
    attrConstruct = undefined
    attrClear _ = undefined

pixdata_pixdataType :: AttrLabelProxy "pixdataType"
pixdata_pixdataType = AttrLabelProxy


getPixdataRowstride :: MonadIO m => Pixdata -> m Word32
getPixdataRowstride s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 12) :: IO Word32
    return val

setPixdataRowstride :: MonadIO m => Pixdata -> Word32 -> m ()
setPixdataRowstride s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 12) (val :: Word32)

data PixdataRowstrideFieldInfo
instance AttrInfo PixdataRowstrideFieldInfo where
    type AttrAllowedOps PixdataRowstrideFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PixdataRowstrideFieldInfo = (~) Word32
    type AttrBaseTypeConstraint PixdataRowstrideFieldInfo = (~) Pixdata
    type AttrGetType PixdataRowstrideFieldInfo = Word32
    type AttrLabel PixdataRowstrideFieldInfo = "rowstride"
    type AttrOrigin PixdataRowstrideFieldInfo = Pixdata
    attrGet _ = getPixdataRowstride
    attrSet _ = setPixdataRowstride
    attrConstruct = undefined
    attrClear _ = undefined

pixdata_rowstride :: AttrLabelProxy "rowstride"
pixdata_rowstride = AttrLabelProxy


getPixdataWidth :: MonadIO m => Pixdata -> m Word32
getPixdataWidth s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO Word32
    return val

setPixdataWidth :: MonadIO m => Pixdata -> Word32 -> m ()
setPixdataWidth s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: Word32)

data PixdataWidthFieldInfo
instance AttrInfo PixdataWidthFieldInfo where
    type AttrAllowedOps PixdataWidthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PixdataWidthFieldInfo = (~) Word32
    type AttrBaseTypeConstraint PixdataWidthFieldInfo = (~) Pixdata
    type AttrGetType PixdataWidthFieldInfo = Word32
    type AttrLabel PixdataWidthFieldInfo = "width"
    type AttrOrigin PixdataWidthFieldInfo = Pixdata
    attrGet _ = getPixdataWidth
    attrSet _ = setPixdataWidth
    attrConstruct = undefined
    attrClear _ = undefined

pixdata_width :: AttrLabelProxy "width"
pixdata_width = AttrLabelProxy


getPixdataHeight :: MonadIO m => Pixdata -> m Word32
getPixdataHeight s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 20) :: IO Word32
    return val

setPixdataHeight :: MonadIO m => Pixdata -> Word32 -> m ()
setPixdataHeight s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 20) (val :: Word32)

data PixdataHeightFieldInfo
instance AttrInfo PixdataHeightFieldInfo where
    type AttrAllowedOps PixdataHeightFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PixdataHeightFieldInfo = (~) Word32
    type AttrBaseTypeConstraint PixdataHeightFieldInfo = (~) Pixdata
    type AttrGetType PixdataHeightFieldInfo = Word32
    type AttrLabel PixdataHeightFieldInfo = "height"
    type AttrOrigin PixdataHeightFieldInfo = Pixdata
    attrGet _ = getPixdataHeight
    attrSet _ = setPixdataHeight
    attrConstruct = undefined
    attrClear _ = undefined

pixdata_height :: AttrLabelProxy "height"
pixdata_height = AttrLabelProxy


getPixdataPixelData :: MonadIO m => Pixdata -> m (Maybe (Ptr Word8))
getPixdataPixelData s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO (Ptr Word8)
    result <- SP.convertIfNonNull val $ \val' -> do
        return val'
    return result

setPixdataPixelData :: MonadIO m => Pixdata -> Ptr Word8 -> m ()
setPixdataPixelData s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (val :: Ptr Word8)

clearPixdataPixelData :: MonadIO m => Pixdata -> m ()
clearPixdataPixelData s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (FP.nullPtr :: Ptr Word8)

data PixdataPixelDataFieldInfo
instance AttrInfo PixdataPixelDataFieldInfo where
    type AttrAllowedOps PixdataPixelDataFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PixdataPixelDataFieldInfo = (~) (Ptr Word8)
    type AttrBaseTypeConstraint PixdataPixelDataFieldInfo = (~) Pixdata
    type AttrGetType PixdataPixelDataFieldInfo = Maybe (Ptr Word8)
    type AttrLabel PixdataPixelDataFieldInfo = "pixel_data"
    type AttrOrigin PixdataPixelDataFieldInfo = Pixdata
    attrGet _ = getPixdataPixelData
    attrSet _ = setPixdataPixelData
    attrConstruct = undefined
    attrClear _ = clearPixdataPixelData

pixdata_pixelData :: AttrLabelProxy "pixelData"
pixdata_pixelData = AttrLabelProxy



instance O.HasAttributeList Pixdata
type instance O.AttributeList Pixdata = PixdataAttributeList
type PixdataAttributeList = ('[ '("magic", PixdataMagicFieldInfo), '("length", PixdataLengthFieldInfo), '("pixdataType", PixdataPixdataTypeFieldInfo), '("rowstride", PixdataRowstrideFieldInfo), '("width", PixdataWidthFieldInfo), '("height", PixdataHeightFieldInfo), '("pixelData", PixdataPixelDataFieldInfo)] :: [(Symbol, *)])

-- method Pixdata::deserialize
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "pixdata", argType = TInterface (Name {namespace = "GdkPixbuf", name = "Pixdata"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GdkPixdata structure to be filled in.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "stream_length", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "length of the stream used for deserialization.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "stream", argType = TCArray False (-1) 1 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "stream of bytes containing a\n  serialized #GdkPixdata structure.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : [Arg {argCName = "stream_length", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "length of the stream used for deserialization.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- returnType : Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gdk_pixdata_deserialize" gdk_pixdata_deserialize :: 
    Ptr Pixdata ->                          -- pixdata : TInterface (Name {namespace = "GdkPixbuf", name = "Pixdata"})
    Word32 ->                               -- stream_length : TBasicType TUInt
    Ptr Word8 ->                            -- stream : TCArray False (-1) 1 (TBasicType TUInt8)
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED pixdataDeserialize ["(Since version 2.32)","Use 'GI.Gio.Structs.Resource.Resource' instead."] #-}
{- |
Deserializes (reconstruct) a 'GI.GdkPixbuf.Structs.Pixdata.Pixdata' structure from a byte stream.
The byte stream consists of a straightforward writeout of the
'GI.GdkPixbuf.Structs.Pixdata.Pixdata' fields in network byte order, plus the /@pixelData@/
bytes the structure points to.
The /@pixdata@/ contents are reconstructed byte by byte and are checked
for validity. This function may fail with 'GI.GdkPixbuf.Enums.PixbufErrorCorruptImage'
or 'GI.GdkPixbuf.Enums.PixbufErrorUnknownType'.
-}
pixdataDeserialize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Pixdata
    {- ^ /@pixdata@/: a 'GI.GdkPixbuf.Structs.Pixdata.Pixdata' structure to be filled in. -}
    -> ByteString
    {- ^ /@stream@/: stream of bytes containing a
  serialized 'GI.GdkPixbuf.Structs.Pixdata.Pixdata' structure. -}
    -> m ()
    {- ^ /(Can throw 'Data.GI.Base.GError.GError')/ -}
pixdataDeserialize pixdata stream = liftIO $ do
    let streamLength = fromIntegral $ B.length stream
    pixdata' <- unsafeManagedPtrGetPtr pixdata
    stream' <- packByteString stream
    onException (do
        _ <- propagateGError $ gdk_pixdata_deserialize pixdata' streamLength stream'
        touchManagedPtr pixdata
        freeMem stream'
        return ()
     ) (do
        freeMem stream'
     )

data PixdataDeserializeMethodInfo
instance (signature ~ (ByteString -> m ()), MonadIO m) => O.MethodInfo PixdataDeserializeMethodInfo Pixdata signature where
    overloadedMethod _ = pixdataDeserialize

-- method Pixdata::serialize
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "pixdata", argType = TInterface (Name {namespace = "GdkPixbuf", name = "Pixdata"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a valid #GdkPixdata structure to serialize.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "stream_length_p", argType = TBasicType TUInt, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "location to store the resulting stream length in.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : [Arg {argCName = "stream_length_p", argType = TBasicType TUInt, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "location to store the resulting stream length in.", 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 "gdk_pixdata_serialize" gdk_pixdata_serialize :: 
    Ptr Pixdata ->                          -- pixdata : TInterface (Name {namespace = "GdkPixbuf", name = "Pixdata"})
    Ptr Word32 ->                           -- stream_length_p : TBasicType TUInt
    IO (Ptr Word8)

{-# DEPRECATED pixdataSerialize ["(Since version 2.32)","Use 'GI.Gio.Structs.Resource.Resource' instead."] #-}
{- |
Serializes a 'GI.GdkPixbuf.Structs.Pixdata.Pixdata' structure into a byte stream.
The byte stream consists of a straightforward writeout of the
'GI.GdkPixbuf.Structs.Pixdata.Pixdata' fields in network byte order, plus the /@pixelData@/
bytes the structure points to.
-}
pixdataSerialize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Pixdata
    {- ^ /@pixdata@/: a valid 'GI.GdkPixbuf.Structs.Pixdata.Pixdata' structure to serialize. -}
    -> m ByteString
    {- ^ __Returns:__ A
newly-allocated string containing the serialized 'GI.GdkPixbuf.Structs.Pixdata.Pixdata'
structure. -}
pixdataSerialize pixdata = liftIO $ do
    pixdata' <- unsafeManagedPtrGetPtr pixdata
    streamLengthP <- allocMem :: IO (Ptr Word32)
    result <- gdk_pixdata_serialize pixdata' streamLengthP
    streamLengthP' <- peek streamLengthP
    checkUnexpectedReturnNULL "pixdataSerialize" result
    result' <- (unpackByteStringWithLength streamLengthP') result
    freeMem result
    touchManagedPtr pixdata
    freeMem streamLengthP
    return result'

data PixdataSerializeMethodInfo
instance (signature ~ (m ByteString), MonadIO m) => O.MethodInfo PixdataSerializeMethodInfo Pixdata signature where
    overloadedMethod _ = pixdataSerialize

-- method Pixdata::to_csource
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "pixdata", argType = TInterface (Name {namespace = "GdkPixbuf", name = "Pixdata"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GdkPixdata to convert to C source.", 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 "used for naming generated data structures or macros.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "dump_type", argType = TInterface (Name {namespace = "GdkPixbuf", name = "PixdataDumpType"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GdkPixdataDumpType determining the kind of C\n  source to be generated.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "gdk_pixdata_to_csource" gdk_pixdata_to_csource :: 
    Ptr Pixdata ->                          -- pixdata : TInterface (Name {namespace = "GdkPixbuf", name = "Pixdata"})
    CString ->                              -- name : TBasicType TUTF8
    CUInt ->                                -- dump_type : TInterface (Name {namespace = "GdkPixbuf", name = "PixdataDumpType"})
    IO (Ptr GLib.String.String)

{-# DEPRECATED pixdataToCsource ["(Since version 2.32)","Use 'GI.Gio.Structs.Resource.Resource' instead."] #-}
{- |
Generates C source code suitable for compiling images directly
into programs.

gdk-pixbuf ships with a program called
[gdk-pixbuf-csource][gdk-pixbuf-csource], which offers a command
line interface to this function.
-}
pixdataToCsource ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Pixdata
    {- ^ /@pixdata@/: a 'GI.GdkPixbuf.Structs.Pixdata.Pixdata' to convert to C source. -}
    -> T.Text
    {- ^ /@name@/: used for naming generated data structures or macros. -}
    -> [GdkPixbuf.Flags.PixdataDumpType]
    {- ^ /@dumpType@/: a 'GI.GdkPixbuf.Flags.PixdataDumpType' determining the kind of C
  source to be generated. -}
    -> m GLib.String.String
    {- ^ __Returns:__ a newly-allocated string containing the C source form
  of /@pixdata@/. -}
pixdataToCsource pixdata name dumpType = liftIO $ do
    pixdata' <- unsafeManagedPtrGetPtr pixdata
    name' <- textToCString name
    let dumpType' = gflagsToWord dumpType
    result <- gdk_pixdata_to_csource pixdata' name' dumpType'
    checkUnexpectedReturnNULL "pixdataToCsource" result
    result' <- (wrapBoxed GLib.String.String) result
    touchManagedPtr pixdata
    freeMem name'
    return result'

data PixdataToCsourceMethodInfo
instance (signature ~ (T.Text -> [GdkPixbuf.Flags.PixdataDumpType] -> m GLib.String.String), MonadIO m) => O.MethodInfo PixdataToCsourceMethodInfo Pixdata signature where
    overloadedMethod _ = pixdataToCsource

type family ResolvePixdataMethod (t :: Symbol) (o :: *) :: * where
    ResolvePixdataMethod "deserialize" o = PixdataDeserializeMethodInfo
    ResolvePixdataMethod "serialize" o = PixdataSerializeMethodInfo
    ResolvePixdataMethod "toCsource" o = PixdataToCsourceMethodInfo
    ResolvePixdataMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolvePixdataMethod t Pixdata, O.MethodInfo info Pixdata p) => O.IsLabelProxy t (Pixdata -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolvePixdataMethod t Pixdata, O.MethodInfo info Pixdata p) => O.IsLabel t (Pixdata -> p) where
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif