{-# LANGUAGE TypeFamilies  #-}
{-# LANGUAGE TypeOperators #-}

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 = 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 = 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip (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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip (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 = 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 = 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 :: 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)
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
w Int
h Vector (PixelBaseComponent p)
bytes Int
pxFactor
    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 :: 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)
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
w Int
h Vector (PixelBaseComponent p)
bytes Int
pxFactor
    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 :: forall p.
(PixelBaseComponent p ~ Word8) =>
(ByteString -> (CInt, CInt, ByteString)) -> ByteString -> Image p
decodeJuicyPixels ByteString -> (CInt, CInt, ByteString)
decoder = (\(CInt
w, CInt
h, ByteString
img) -> forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
w) (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
h) (ByteString -> Vector Word8
bytesToVec ByteString
img)) 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) -> forall 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 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 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 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
    let sz :: CInt
sz = CInt
pxFactor forall a. Num a => a -> a -> a
* CInt
w forall a. Num a => a -> a -> a
* CInt
h -- bytes
    ByteString
img <- ForeignPtr Word8 -> Int -> Int -> ByteString
BS.PS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr forall a. FunPtr (Ptr a -> IO ())
webPFree (forall a b. Ptr a -> Ptr b
castPtr Ptr UInt8
res) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
sz)
    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 =
    forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
unsafeWith Vector Word8
datums 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 (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
pxFactor forall a. Num a => a -> a -> a
* Int
w)
        ForeignPtr Word8
fP <- forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr forall a. FunPtr (Ptr a -> IO ())
webPFree (forall a b. Ptr a -> Ptr b
castPtr Ptr UInt8
res)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr Word8 -> Int -> Int -> ByteString
BS.PS ForeignPtr Word8
fP Int
0 (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 =
    forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
unsafeWith Vector Word8
datums 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 (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
pxFactor forall a. Num a => a -> a -> a
* Int
w) CFloat
quality
        ForeignPtr Word8
fP <- forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr forall a. FunPtr (Ptr a -> IO ())
webPFree (forall a b. Ptr a -> Ptr b
castPtr Ptr UInt8
res)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr Word8 -> Int -> Int -> ByteString
BS.PS ForeignPtr Word8
fP Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
resSz))