-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Codec/Avif.chs" #-}
module Codec.Avif ( encode
                  , decode
                  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



import Codec.Avif.FFI
import Codec.Picture (Image (Image), PixelRGBA8, PixelYCbCr8)
import Control.Applicative (pure)
import Control.Exception (throwIO)
import qualified Data.ByteString as BS
import Data.ByteString.Internal (memcpy)
import qualified Data.ByteString.Unsafe as BS
import Data.Functor ((<$>), (<$))
import Foreign.Ptr (castPtr)
import Foreign.ForeignPtr (castForeignPtr, newForeignPtr, mallocForeignPtrBytes, withForeignPtr)
import Foreign.Marshal (allocaBytes)
import qualified Data.Vector.Storable as VS
import System.IO.Unsafe (unsafePerformIO)



-- PixelYCbCr8?

throwRes :: AvifResult -> IO ()
throwRes :: AvifResult -> IO ()
throwRes AvifResult
AvifResultOk = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (); throwRes AvifResult
err = AvifResult -> IO ()
forall e a. Exception e => e -> IO a
throwIO AvifResult
err

{-# NOINLINE encode #-}
encode :: Image PixelRGBA8 -> BS.ByteString
encode :: Image PixelRGBA8 -> ByteString
encode Image PixelRGBA8
img = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    Ptr AvifImage
avifImgPtr <- CInt -> CInt -> CInt -> AvifPixelFormat -> IO (Ptr AvifImage)
avifImageCreate (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) CInt
8 AvifPixelFormat
AvifPixelFormatYuv444
    ByteString
res <- Int -> (Ptr AvifRGBImage -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 ((Ptr AvifRGBImage -> IO ByteString) -> IO ByteString)
-> (Ptr AvifRGBImage -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr AvifRGBImage
rgbImagePtr ->
        Int -> (Ptr AvifRwData -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
16 ((Ptr AvifRwData -> IO ByteString) -> IO ByteString)
-> (Ptr AvifRwData -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr AvifRwData
rwDataPtr -> do
            Ptr AvifRGBImage -> Ptr AvifImage -> IO ()
avifRGBImageSetDefaults Ptr AvifRGBImage
rgbImagePtr Ptr AvifImage
avifImgPtr
            CUInt
pxSz <- Ptr AvifRGBImage -> IO CUInt
avifRGBImagePixelSize Ptr AvifRGBImage
rgbImagePtr

            Ptr AvifEncoder
preEnc <- IO (Ptr AvifEncoder)
avifEncoderCreate
            ForeignPtr AvifEncoder
enc <- ForeignPtr () -> ForeignPtr AvifEncoder
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr (ForeignPtr () -> ForeignPtr AvifEncoder)
-> IO (ForeignPtr ()) -> IO (ForeignPtr AvifEncoder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr () -> Ptr () -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
avifEncoderDestroy (Ptr AvifEncoder -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr AvifEncoder
preEnc)

            ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
imgPtr ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
iPtr -> do

                (\Ptr AvifRGBImage
ptr CUInt
val -> do {Ptr AvifRGBImage -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr AvifRGBImage
ptr Int
4 (CUInt
val :: C2HSImp.CUInt)}) Ptr AvifRGBImage
rgbImagePtr (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
                (\Ptr AvifRGBImage
ptr CUInt
val -> do {Ptr AvifRGBImage -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr AvifRGBImage
ptr Int
0 (CUInt
val :: C2HSImp.CUInt)}) Ptr AvifRGBImage
rgbImagePtr (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)
                (\Ptr AvifRGBImage
ptr Ptr CUChar
val -> do {Ptr AvifRGBImage -> Int -> Ptr CUChar -> IO ()
forall b. Ptr b -> Int -> Ptr CUChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr AvifRGBImage
ptr Int
32 (Ptr CUChar
val :: (C2HSImp.Ptr C2HSImp.CUChar))}) Ptr AvifRGBImage
rgbImagePtr (Ptr Word8 -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
iPtr)
                (\Ptr AvifRGBImage
ptr CUInt
val -> do {Ptr AvifRGBImage -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr AvifRGBImage
ptr Int
40 (CUInt
val :: C2HSImp.CUInt)}) Ptr AvifRGBImage
rgbImagePtr (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wCUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
*CUInt
pxSz)

                AvifResult -> IO ()
throwRes (AvifResult -> IO ()) -> IO AvifResult -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr AvifImage -> Ptr AvifRGBImage -> IO AvifResult
avifImageRGBToYUV Ptr AvifImage
avifImgPtr Ptr AvifRGBImage
rgbImagePtr

                AvifResult -> IO ()
throwRes (AvifResult -> IO ()) -> IO AvifResult -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ForeignPtr AvifEncoder
-> Ptr AvifImage -> Ptr AvifRwData -> IO AvifResult
avifEncoderWrite ForeignPtr AvifEncoder
enc Ptr AvifImage
avifImgPtr Ptr AvifRwData
rwDataPtr

                CULong
sz <- (\Ptr AvifRwData
ptr -> do {Ptr AvifRwData -> Int -> IO CULong
forall b. Ptr b -> Int -> IO CULong
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr AvifRwData
ptr Int
8 :: IO C2HSImp.CULong}) Ptr AvifRwData
rwDataPtr
                Ptr CUChar
bs <- (\Ptr AvifRwData
ptr -> do {Ptr AvifRwData -> Int -> IO (Ptr CUChar)
forall b. Ptr b -> Int -> IO (Ptr CUChar)
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr AvifRwData
ptr Int
0 :: IO (C2HSImp.Ptr C2HSImp.CUChar)}) Ptr AvifRwData
rwDataPtr

                CStringLen -> IO ByteString
BS.packCStringLen (Ptr CUChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
bs, CULong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULong
sz)

    ByteString
res ByteString -> IO () -> IO ByteString
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Ptr AvifImage -> IO ()
avifImageDestroy Ptr AvifImage
avifImgPtr

    where (Image Int
w Int
h Vector (PixelBaseComponent PixelRGBA8)
bytes) = Image PixelRGBA8
img
          (ForeignPtr Word8
imgPtr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
VS.unsafeToForeignPtr0 Vector Word8
bytes

{-# NOINLINE decode #-}
decode :: BS.ByteString -> Image PixelRGBA8
decode :: ByteString -> Image PixelRGBA8
decode ByteString
bs = IO (Image PixelRGBA8) -> Image PixelRGBA8
forall a. IO a -> a
unsafePerformIO (IO (Image PixelRGBA8) -> Image PixelRGBA8)
-> IO (Image PixelRGBA8) -> Image PixelRGBA8
forall a b. (a -> b) -> a -> b
$ ByteString
-> (CStringLen -> IO (Image PixelRGBA8)) -> IO (Image PixelRGBA8)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (Image PixelRGBA8)) -> IO (Image PixelRGBA8))
-> (CStringLen -> IO (Image PixelRGBA8)) -> IO (Image PixelRGBA8)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
sz) -> do
    Ptr AvifDecoder
preDec <- IO (Ptr AvifDecoder)
avifDecoderCreate
    ForeignPtr AvifDecoder
dec <- ForeignPtr () -> ForeignPtr AvifDecoder
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr (ForeignPtr () -> ForeignPtr AvifDecoder)
-> IO (ForeignPtr ()) -> IO (ForeignPtr AvifDecoder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr () -> Ptr () -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
avifDecoderDestroy (Ptr AvifDecoder -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr AvifDecoder
preDec)
    Ptr AvifImage
avifImg <- IO (Ptr AvifImage)
avifImageCreateEmpty

    AvifResult -> IO ()
throwRes (AvifResult -> IO ()) -> IO AvifResult -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ForeignPtr AvifDecoder
-> Ptr AvifImage -> Ptr CUChar -> CSize -> IO AvifResult
avifDecoderReadMemory ForeignPtr AvifDecoder
dec Ptr AvifImage
avifImg (Ptr CChar -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)

    Int
-> (Ptr AvifRGBImage -> IO (Image PixelRGBA8))
-> IO (Image PixelRGBA8)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 ((Ptr AvifRGBImage -> IO (Image PixelRGBA8))
 -> IO (Image PixelRGBA8))
-> (Ptr AvifRGBImage -> IO (Image PixelRGBA8))
-> IO (Image PixelRGBA8)
forall a b. (a -> b) -> a -> b
$ \Ptr AvifRGBImage
rgbImagePtr -> do
        Ptr AvifRGBImage -> Ptr AvifImage -> IO ()
avifRGBImageSetDefaults Ptr AvifRGBImage
rgbImagePtr Ptr AvifImage
avifImg
        Ptr AvifRGBImage -> IO ()
avifRGBImageAllocatePixels Ptr AvifRGBImage
rgbImagePtr
        AvifResult -> IO ()
throwRes (AvifResult -> IO ()) -> IO AvifResult -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr AvifImage -> Ptr AvifRGBImage -> IO AvifResult
avifImageYUVToRGB Ptr AvifImage
avifImg Ptr AvifRGBImage
rgbImagePtr

        CUInt
w <- (\Ptr AvifRGBImage
ptr -> do {Ptr AvifRGBImage -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr AvifRGBImage
ptr Int
0 :: IO C2HSImp.CUInt}) Ptr AvifRGBImage
rgbImagePtr
        CUInt
h <- (\Ptr AvifRGBImage
ptr -> do {Ptr AvifRGBImage -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr AvifRGBImage
ptr Int
4 :: IO C2HSImp.CUInt}) Ptr AvifRGBImage
rgbImagePtr
        CUInt
pxSz <- Ptr AvifRGBImage -> IO CUInt
avifRGBImagePixelSize Ptr AvifRGBImage
rgbImagePtr

        Ptr CUChar
pxPtr <- (\Ptr AvifRGBImage
ptr -> do {Ptr AvifRGBImage -> Int -> IO (Ptr CUChar)
forall b. Ptr b -> Int -> IO (Ptr CUChar)
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr AvifRGBImage
ptr Int
32 :: IO (C2HSImp.Ptr C2HSImp.CUChar)}) Ptr AvifRGBImage
rgbImagePtr

        let sz' :: CUInt
sz' = CUInt
w CUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
* CUInt
h CUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
* CUInt
pxSz

        ForeignPtr Word8
outBytes <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
sz')

        ForeignPtr Word8
-> (Ptr Word8 -> IO (Image PixelRGBA8)) -> IO (Image PixelRGBA8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
outBytes ((Ptr Word8 -> IO (Image PixelRGBA8)) -> IO (Image PixelRGBA8))
-> (Ptr Word8 -> IO (Image PixelRGBA8)) -> IO (Image PixelRGBA8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outPtr -> do
            Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
outPtr) (Ptr CUChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
pxPtr) (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
sz')
            Int
-> Int
-> Vector (PixelBaseComponent PixelRGBA8)
-> Image PixelRGBA8
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
w) (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
h) (ForeignPtr Word8 -> Int -> Vector Word8
forall a. ForeignPtr a -> Int -> Vector a
VS.unsafeFromForeignPtr0 ForeignPtr Word8
outBytes (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
sz')) Image PixelRGBA8 -> IO () -> IO (Image PixelRGBA8)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Ptr AvifRGBImage -> IO ()
avifRGBImageFreePixels Ptr AvifRGBImage
rgbImagePtr IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr AvifImage -> IO ()
avifImageDestroy Ptr AvifImage
avifImg)