{-# LANGUAGE TypeFamilies #-}

module Codec.Picture.WebP ( decodeRgb8
                          , decodeRgba8
                          , encodeRgb8Lossless
                          , encodeRgba8Lossless
                          , encodeRgb8
                          , encodeRgba8
                          ) where

import           Codec.Picture            (Image (Image), PixelBaseComponent,
                                           PixelRGB8, PixelRGBA8)
import           Control.Applicative      (pure, (<*>))
import qualified Data.ByteString          as BS
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Unsafe   as BS
import           Data.Functor             ((<$>))
import           Data.Vector.Storable     (Vector, unsafeFromForeignPtr0,
                                           unsafeWith)
import           Data.Word                (Word8)
import           Foreign.C.Types          (CChar, CFloat, CInt, CSize)
import           Foreign.ForeignPtr       (newForeignPtr)
import           Foreign.Ptr              (Ptr, castPtr)
import           System.IO.Unsafe         (unsafePerformIO)
import           WebP.Decode
import           WebP.Encode
import           WebP.Types

decodeRgb8 :: BS.ByteString -> Image PixelRGB8
decodeRgb8 :: ByteString -> Image PixelRGB8
decodeRgb8 = (ByteString -> (CInt, CInt, ByteString))
-> ByteString -> Image PixelRGB8
forall p.
(PixelBaseComponent p ~ Word8) =>
(ByteString -> (CInt, CInt, ByteString)) -> ByteString -> Image p
decodeJuicyPixels ByteString -> (CInt, CInt, ByteString)
decodeRgb8BS

decodeRgba8 :: BS.ByteString -> Image PixelRGBA8
decodeRgba8 :: ByteString -> Image PixelRGBA8
decodeRgba8 = (ByteString -> (CInt, CInt, ByteString))
-> ByteString -> Image PixelRGBA8
forall p.
(PixelBaseComponent p ~ Word8) =>
(ByteString -> (CInt, CInt, ByteString)) -> ByteString -> Image p
decodeJuicyPixels ByteString -> (CInt, CInt, ByteString)
decodeRgba8BS

encodeRgba8 :: CFloat -- ^ Quality, @0.0@ to @100.0@
            -> Image PixelRGBA8 -> BS.ByteString
encodeRgba8 :: CFloat -> Image PixelRGBA8 -> ByteString
encodeRgba8 = (Image PixelRGBA8 -> CFloat -> ByteString)
-> CFloat -> Image PixelRGBA8 -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Ptr UInt8
 -> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
-> Int -> Image PixelRGBA8 -> CFloat -> ByteString
forall p.
(PixelBaseComponent p ~ Word8) =>
(Ptr UInt8
 -> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
-> Int -> Image p -> CFloat -> ByteString
encodeJuicyPixels Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8)
webPEncodeRGBA Int
4)

encodeRgb8 :: CFloat -- ^ Quality, @0.0@ to @100.0@
           -> Image PixelRGB8 -> BS.ByteString
encodeRgb8 :: CFloat -> Image PixelRGB8 -> ByteString
encodeRgb8 = (Image PixelRGB8 -> CFloat -> ByteString)
-> CFloat -> Image PixelRGB8 -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Ptr UInt8
 -> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
-> Int -> Image PixelRGB8 -> CFloat -> ByteString
forall p.
(PixelBaseComponent p ~ Word8) =>
(Ptr UInt8
 -> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
-> Int -> Image p -> CFloat -> ByteString
encodeJuicyPixels Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8)
webPEncodeRGB Int
3)

encodeRgb8Lossless :: Image PixelRGB8 -> BS.ByteString
encodeRgb8Lossless :: Image PixelRGB8 -> ByteString
encodeRgb8Lossless = (Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
-> Int -> Image PixelRGB8 -> ByteString
forall p.
(PixelBaseComponent p ~ Word8) =>
(Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
-> Int -> Image p -> ByteString
encodeJuicyPixelsLossless Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8)
webPEncodeLosslessRGB Int
3

encodeRgba8Lossless :: Image PixelRGBA8 -> BS.ByteString
encodeRgba8Lossless :: Image PixelRGBA8 -> ByteString
encodeRgba8Lossless = (Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
-> Int -> Image PixelRGBA8 -> ByteString
forall p.
(PixelBaseComponent p ~ Word8) =>
(Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
-> Int -> Image p -> ByteString
encodeJuicyPixelsLossless Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8)
webPEncodeLosslessRGBA Int
4

encodeJuicyPixels :: (PixelBaseComponent p ~ Word8)
                  => (Ptr UInt8 -> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
                  -> Int
                  -> Image p
                  -> CFloat
                  -> BS.ByteString
encodeJuicyPixels :: (Ptr UInt8
 -> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
-> Int -> Image p -> CFloat -> ByteString
encodeJuicyPixels Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8)
encoder Int
pxFactor Image p
img = (Ptr UInt8
 -> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
-> Int -> Int -> Vector Word8 -> Int -> CFloat -> ByteString
encodeAbsBS Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8)
encoder Int
h Int
w Vector Word8
Vector (PixelBaseComponent p)
bytes Int
pxFactor -- JuicyPixels and libwebp define weidth/height in opposite way?
    where (Image Int
w Int
h Vector (PixelBaseComponent p)
bytes) = Image p
img

encodeJuicyPixelsLossless :: (PixelBaseComponent p ~ Word8)
                          => (Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
                          -> Int
                          -> Image p
                          -> BS.ByteString
encodeJuicyPixelsLossless :: (Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
-> Int -> Image p -> ByteString
encodeJuicyPixelsLossless Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8)
encoder Int
pxFactor Image p
img = (Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
-> Int -> Int -> Vector Word8 -> Int -> ByteString
encodeAbsBSLossless Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8)
encoder Int
h Int
w Vector Word8
Vector (PixelBaseComponent p)
bytes Int
pxFactor -- JuicyPixels and libwebp define weidth/height in opposite way?
    where (Image Int
w Int
h Vector (PixelBaseComponent p)
bytes) = Image p
img

decodeJuicyPixels :: (PixelBaseComponent p ~ Word8)
                  => (BS.ByteString -> (CInt, CInt, BS.ByteString))
                  -> BS.ByteString
                  -> Image p
decodeJuicyPixels :: (ByteString -> (CInt, CInt, ByteString)) -> ByteString -> Image p
decodeJuicyPixels ByteString -> (CInt, CInt, ByteString)
decoder = (\(CInt
w, CInt
h, ByteString
img) -> Int -> Int -> Vector (PixelBaseComponent p) -> Image p
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
w) (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
h) (ByteString -> Vector Word8
bytesToVec ByteString
img)) ((CInt, CInt, ByteString) -> Image p)
-> (ByteString -> (CInt, CInt, ByteString))
-> ByteString
-> Image p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (CInt, CInt, ByteString)
decoder
    where bytesToVec :: ByteString -> Vector Word8
bytesToVec = \(BS.PS ForeignPtr Word8
fp Int
_ Int
l) -> ForeignPtr Word8 -> Int -> Vector Word8
forall a. Storable a => ForeignPtr a -> Int -> Vector a
unsafeFromForeignPtr0 ForeignPtr Word8
fp Int
l

decodeRgb8BS :: BS.ByteString -> (CInt, CInt, BS.ByteString)
decodeRgb8BS :: ByteString -> (CInt, CInt, ByteString)
decodeRgb8BS = (Ptr CChar -> CSize -> IO (Ptr UInt8, CInt, CInt))
-> CInt -> ByteString -> (CInt, CInt, ByteString)
decodeAbsBS Ptr CChar -> CSize -> IO (Ptr UInt8, CInt, CInt)
forall a. Ptr a -> CSize -> IO (Ptr UInt8, CInt, CInt)
webPDecodeRGB CInt
3

decodeRgba8BS :: BS.ByteString -> (CInt, CInt, BS.ByteString)
decodeRgba8BS :: ByteString -> (CInt, CInt, ByteString)
decodeRgba8BS = (Ptr CChar -> CSize -> IO (Ptr UInt8, CInt, CInt))
-> CInt -> ByteString -> (CInt, CInt, ByteString)
decodeAbsBS Ptr CChar -> CSize -> IO (Ptr UInt8, CInt, CInt)
forall a. Ptr a -> CSize -> IO (Ptr UInt8, CInt, CInt)
webPDecodeRGBA CInt
4

{-# NOINLINE decodeAbsBS #-}
decodeAbsBS :: (Ptr CChar -> CSize -> IO (Ptr UInt8, CInt, CInt))
            -> CInt
            -> BS.ByteString
            -> (CInt, CInt, BS.ByteString)
decodeAbsBS :: (Ptr CChar -> CSize -> IO (Ptr UInt8, CInt, CInt))
-> CInt -> ByteString -> (CInt, CInt, ByteString)
decodeAbsBS Ptr CChar -> CSize -> IO (Ptr UInt8, CInt, CInt)
decoder CInt
pxFactor ByteString
bs = IO (CInt, CInt, ByteString) -> (CInt, CInt, ByteString)
forall a. IO a -> a
unsafePerformIO (IO (CInt, CInt, ByteString) -> (CInt, CInt, ByteString))
-> IO (CInt, CInt, ByteString) -> (CInt, CInt, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString
-> (CStringLen -> IO (CInt, CInt, ByteString))
-> IO (CInt, CInt, ByteString)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (CInt, CInt, ByteString))
 -> IO (CInt, CInt, ByteString))
-> (CStringLen -> IO (CInt, CInt, ByteString))
-> IO (CInt, CInt, ByteString)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
p, Int
l) -> do
    (Ptr UInt8
res, CInt
h, CInt
w) <- Ptr CChar -> CSize -> IO (Ptr UInt8, CInt, CInt)
decoder Ptr CChar
p (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
    let sz :: CInt
sz = CInt
pxFactor CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* CInt
w CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* CInt
h -- bytes
    ByteString
img <- ForeignPtr Word8 -> Int -> Int -> ByteString
BS.PS (ForeignPtr Word8 -> Int -> Int -> ByteString)
-> IO (ForeignPtr Word8) -> IO (Int -> Int -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr Word8 -> Ptr Word8 -> IO (ForeignPtr Word8)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Word8
forall a. FunPtr (Ptr a -> IO ())
webPFree (Ptr UInt8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr UInt8
res) IO (Int -> Int -> ByteString) -> IO Int -> IO (Int -> ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0 IO (Int -> ByteString) -> IO Int -> IO ByteString
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
sz)
    (CInt, CInt, ByteString) -> IO (CInt, CInt, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CInt
w, CInt
h, ByteString
img)

{-# NOINLINE encodeAbsBSLossless #-}
encodeAbsBSLossless :: (Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
                    -> Int
                    -> Int
                    -> Vector Word8
                    -> Int -- ^ Bytes per pixel
                    -> BS.ByteString
encodeAbsBSLossless :: (Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
-> Int -> Int -> Vector Word8 -> Int -> ByteString
encodeAbsBSLossless Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8)
encoder Int
w Int
h Vector Word8
datums Int
pxFactor =
    IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Vector Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
unsafeWith Vector Word8
datums ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
        (CSize
resSz, Ptr UInt8
res) <- Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8)
encoder (Ptr Word8 -> Ptr UInt8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p) (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) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Int
pxFactor Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w)
        ForeignPtr Word8
fP <- FinalizerPtr Word8 -> Ptr Word8 -> IO (ForeignPtr Word8)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Word8
forall a. FunPtr (Ptr a -> IO ())
webPFree (Ptr UInt8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr UInt8
res)
        ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr Word8 -> Int -> Int -> ByteString
BS.PS ForeignPtr Word8
fP Int
0 (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
resSz))

{-# NOINLINE encodeAbsBS #-}
encodeAbsBS :: (Ptr UInt8 -> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
            -> Int -- ^ Width
            -> Int -- ^ Height
            -> Vector Word8
            -> Int -- ^ Bytes per pixel
            -> CFloat
            -> BS.ByteString
encodeAbsBS :: (Ptr UInt8
 -> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
-> Int -> Int -> Vector Word8 -> Int -> CFloat -> ByteString
encodeAbsBS Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8)
encoder Int
w Int
h Vector Word8
datums Int
pxFactor CFloat
quality =
    IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Vector Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
unsafeWith Vector Word8
datums ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
        (CSize
resSz, Ptr UInt8
res) <- Ptr UInt8
-> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8)
encoder (Ptr Word8 -> Ptr UInt8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p) (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) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Int
pxFactor Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w) CFloat
quality
        ForeignPtr Word8
fP <- FinalizerPtr Word8 -> Ptr Word8 -> IO (ForeignPtr Word8)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Word8
forall a. FunPtr (Ptr a -> IO ())
webPFree (Ptr UInt8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr UInt8
res)
        ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr Word8 -> Int -> Int -> ByteString
BS.PS ForeignPtr Word8
fP Int
0 (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
resSz))