diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# webp
+
+## 0.1.0.0
+
+Initial release
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,14 @@
+Copyright (C) 2020 Vanessa McHale
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program. If not, see .
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,5 @@
+# webp
+
+[JuicyPixels](http://hackage.haskell.org/package/JuicyPixels) support for
+[webp](https://developers.google.com/speed/webp)
+format, via [libwebp](https://developers.google.com/speed/webp/docs/api).
diff --git a/src/Codec/Picture/WebP.hs b/src/Codec/Picture/WebP.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/Picture/WebP.hs
@@ -0,0 +1,115 @@
+{-# 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 = decodeJuicyPixels decodeRgb8BS
+
+decodeRgba8 :: BS.ByteString -> Image PixelRGBA8
+decodeRgba8 = decodeJuicyPixels decodeRgba8BS
+
+encodeRgba8 :: CFloat -- ^ Quality, @0.0@ to @100.0@
+ -> Image PixelRGBA8 -> BS.ByteString
+encodeRgba8 = flip (encodeJuicyPixels webPEncodeRGBA 4)
+
+encodeRgb8 :: CFloat -- ^ Quality, @0.0@ to @100.0@
+ -> Image PixelRGB8 -> BS.ByteString
+encodeRgb8 = flip (encodeJuicyPixels webPEncodeRGB 3)
+
+encodeRgb8Lossless :: Image PixelRGB8 -> BS.ByteString
+encodeRgb8Lossless = encodeJuicyPixelsLossless webPEncodeLosslessRGB 3
+
+encodeRgba8Lossless :: Image PixelRGBA8 -> BS.ByteString
+encodeRgba8Lossless = encodeJuicyPixelsLossless webPEncodeLosslessRGBA 4
+
+encodeJuicyPixels :: (PixelBaseComponent p ~ Word8)
+ => (Ptr UInt8 -> CInt -> CInt -> CInt -> CFloat -> IO (CSize, Ptr UInt8))
+ -> Int
+ -> Image p
+ -> CFloat
+ -> BS.ByteString
+encodeJuicyPixels encoder pxFactor img = encodeAbsBS encoder h w bytes pxFactor -- JuicyPixels and libwebp define weidth/height in opposite way?
+ where (Image w h bytes) = img
+
+encodeJuicyPixelsLossless :: (PixelBaseComponent p ~ Word8)
+ => (Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
+ -> Int
+ -> Image p
+ -> BS.ByteString
+encodeJuicyPixelsLossless encoder pxFactor img = encodeAbsBSLossless encoder h w bytes pxFactor -- JuicyPixels and libwebp define weidth/height in opposite way?
+ where (Image w h bytes) = img
+
+decodeJuicyPixels :: (PixelBaseComponent p ~ Word8)
+ => (BS.ByteString -> (CInt, CInt, BS.ByteString))
+ -> BS.ByteString
+ -> Image p
+decodeJuicyPixels decoder = (\(w, h, img) -> Image (fromIntegral w) (fromIntegral h) (bytesToVec img)) . decoder
+ where bytesToVec = \(BS.PS fp _ l) -> unsafeFromForeignPtr0 fp l
+
+decodeRgb8BS :: BS.ByteString -> (CInt, CInt, BS.ByteString)
+decodeRgb8BS = decodeAbsBS webPDecodeRGB 3
+
+decodeRgba8BS :: BS.ByteString -> (CInt, CInt, BS.ByteString)
+decodeRgba8BS = decodeAbsBS webPDecodeRGBA 4
+
+{-# NOINLINE decodeAbsBS #-}
+decodeAbsBS :: (Ptr CChar -> CSize -> IO (Ptr UInt8, CInt, CInt))
+ -> CInt
+ -> BS.ByteString
+ -> (CInt, CInt, BS.ByteString)
+decodeAbsBS decoder pxFactor bs = unsafePerformIO $ BS.unsafeUseAsCStringLen bs $ \(p, l) -> do
+ (res, h, w) <- decoder p (fromIntegral l)
+ let sz = pxFactor * w * h -- bytes
+ img <- BS.PS <$> newForeignPtr webPFree (castPtr res) <*> pure 0 <*> pure (fromIntegral sz)
+ pure (w, h, img)
+
+{-# NOINLINE encodeAbsBSLossless #-}
+encodeAbsBSLossless :: (Ptr UInt8 -> CInt -> CInt -> CInt -> IO (CSize, Ptr UInt8))
+ -> Int
+ -> Int
+ -> Vector Word8
+ -> Int -- ^ Bytes per pixel
+ -> BS.ByteString
+encodeAbsBSLossless encoder w h datums pxFactor =
+ unsafePerformIO $ unsafeWith datums $ \p -> do
+ (resSz, res) <- encoder (castPtr p) (fromIntegral w) (fromIntegral h) (fromIntegral $ pxFactor * w)
+ fP <- newForeignPtr webPFree (castPtr res)
+ pure (BS.PS fP 0 (fromIntegral 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 encoder w h datums pxFactor quality =
+ unsafePerformIO $ unsafeWith datums $ \p -> do
+ (resSz, res) <- encoder (castPtr p) (fromIntegral w) (fromIntegral h) (fromIntegral $ pxFactor * w) quality
+ fP <- newForeignPtr webPFree (castPtr res)
+ pure (BS.PS fP 0 (fromIntegral resSz))
diff --git a/src/WebP/Decode.chs b/src/WebP/Decode.chs
new file mode 100644
--- /dev/null
+++ b/src/WebP/Decode.chs
@@ -0,0 +1,21 @@
+module WebP.Decode ( webPDecodeRGBA
+ , webPDecodeRGB
+ , UInt8
+ ) where
+
+import Data.Coerce (coerce)
+import Foreign.C.Types (CInt, CSize)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Ptr (Ptr, castPtr)
+import Foreign.Storable (peek)
+
+#include
+
+type UInt8 = {# type uint8_t #}
+
+-- see docs: https://developers.google.com/speed/webp/docs/api
+
+{# fun WebPDecodeRGBA as ^ { castPtr `Ptr a', coerce `CSize', alloca- `CInt' peek*, alloca- `CInt' peek* } -> `Ptr UInt8' id #}
+{# fun WebPDecodeRGB as ^ { castPtr `Ptr a', coerce `CSize', alloca- `CInt' peek*, alloca- `CInt' peek* } -> `Ptr UInt8' id #}
+
+-- WebPDecodeYUV
diff --git a/src/WebP/Encode.chs b/src/WebP/Encode.chs
new file mode 100644
--- /dev/null
+++ b/src/WebP/Encode.chs
@@ -0,0 +1,20 @@
+module WebP.Encode ( webPEncodeRGB
+ , webPEncodeRGBA
+ , webPEncodeLosslessRGB
+ , webPEncodeLosslessRGBA
+ ) where
+
+import Data.Coerce (coerce)
+import Foreign.C.Types (CFloat, CInt, CSize)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Ptr (Ptr)
+import Foreign.Storable (peek)
+
+#include
+
+type UInt8 = {# type uint8_t #}
+
+{# fun WebPEncodeRGB as ^ { id `Ptr UInt8', `CInt', `CInt', `CInt', `CFloat', alloca- `Ptr UInt8' peek* } -> `CSize' coerce #}
+{# fun WebPEncodeRGBA as ^ { id `Ptr UInt8', `CInt', `CInt', `CInt', `CFloat', alloca- `Ptr UInt8' peek* } -> `CSize' coerce #}
+{# fun WebPEncodeLosslessRGB as ^ { id `Ptr UInt8', `CInt', `CInt', `CInt', alloca- `Ptr UInt8' peek* } -> `CSize' coerce #}
+{# fun WebPEncodeLosslessRGBA as ^ { id `Ptr UInt8', `CInt', `CInt', `CInt', alloca- `Ptr UInt8' peek* } -> `CSize' coerce #}
diff --git a/src/WebP/Types.hs b/src/WebP/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/WebP/Types.hs
@@ -0,0 +1,6 @@
+module WebP.Types ( webPFree
+ ) where
+
+import Foreign.Ptr (FunPtr, Ptr)
+
+foreign import ccall unsafe "webp/types.h &WebPFree" webPFree :: FunPtr (Ptr a -> IO ())
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,66 @@
+module Main (main) where
+
+import Codec.Picture.Png (encodePng)
+import Codec.Picture.WebP
+import qualified Data.ByteString as BS
+import Test.Tasty
+import Test.Tasty.HUnit
+
+main :: IO ()
+main = defaultMain $
+ testGroup "Converts to PNG without throwing an exception"
+ [ convRgbPng "test/data/6b3001b4ebfc341ed0359c00586e6ce1.webp"
+ , convRgbPng "test/data/d99cc366dfbbf99493f917e2d43c683f.webp"
+ , convRgbaPng "test/data/6b3001b4ebfc341ed0359c00586e6ce1.webp"
+ , convRgbaPng "test/data/d99cc366dfbbf99493f917e2d43c683f.webp"
+ , roundtripLosslessRGB "test/data/6b3001b4ebfc341ed0359c00586e6ce1.webp"
+ , roundtripLosslessRGB "test/data/d99cc366dfbbf99493f917e2d43c683f.webp"
+ , roundtripLosslessRGBA "test/data/6b3001b4ebfc341ed0359c00586e6ce1.webp"
+ , roundtripLosslessRGBA "test/data/d99cc366dfbbf99493f917e2d43c683f.webp"
+ , roundtripRGB "test/data/6b3001b4ebfc341ed0359c00586e6ce1.webp"
+ , roundtripRGB "test/data/d99cc366dfbbf99493f917e2d43c683f.webp"
+ , roundtripRGBA "test/data/6b3001b4ebfc341ed0359c00586e6ce1.webp"
+ , roundtripRGBA "test/data/d99cc366dfbbf99493f917e2d43c683f.webp"
+ ]
+
+convRgbPng :: FilePath -> TestTree
+convRgbPng fp = testCase ("Converts to PNG (" ++ fp ++ ")") $ do
+ bs <- BS.readFile fp
+ let img = decodeRgb8 bs
+ conv = encodePng img
+ assertBool "No exception" (conv `seq` True)
+
+convRgbaPng :: FilePath -> TestTree
+convRgbaPng fp = testCase ("Converts to PNG (" ++ fp ++ ")") $ do
+ bs <- BS.readFile fp
+ let img = decodeRgba8 bs
+ conv = encodePng img
+ assertBool "No exception" (conv `seq` True)
+
+roundtripLosslessRGB :: FilePath -> TestTree
+roundtripLosslessRGB fp = testCase ("roundtripLosslesss (" ++ fp ++ ")") $ do
+ bs <- BS.readFile fp
+ let img = decodeRgb8 bs
+ conv = encodeRgb8Lossless img
+ assertBool "No exception" (conv `seq` True)
+
+roundtripLosslessRGBA :: FilePath -> TestTree
+roundtripLosslessRGBA fp = testCase ("roundtripLosslesss (" ++ fp ++ ")") $ do
+ bs <- BS.readFile fp
+ let img = decodeRgba8 bs
+ conv = encodeRgba8Lossless img
+ assertBool "No exception" (conv `seq` True)
+
+roundtripRGB :: FilePath -> TestTree
+roundtripRGB fp = testCase ("roundtripLosslesss (" ++ fp ++ ")") $ do
+ bs <- BS.readFile fp
+ let img = decodeRgb8 bs
+ conv = encodeRgb8 0.4 img
+ assertBool "No exception" (conv `seq` True)
+
+roundtripRGBA :: FilePath -> TestTree
+roundtripRGBA fp = testCase ("roundtripLosslesss (" ++ fp ++ ")") $ do
+ bs <- BS.readFile fp
+ let img = decodeRgba8 bs
+ conv = encodeRgba8 0.4 img
+ assertBool "No exception" (conv `seq` True)
diff --git a/test/data/6b3001b4ebfc341ed0359c00586e6ce1.webp b/test/data/6b3001b4ebfc341ed0359c00586e6ce1.webp
new file mode 100644
Binary files /dev/null and b/test/data/6b3001b4ebfc341ed0359c00586e6ce1.webp differ
diff --git a/test/data/d99cc366dfbbf99493f917e2d43c683f.webp b/test/data/d99cc366dfbbf99493f917e2d43c683f.webp
new file mode 100644
Binary files /dev/null and b/test/data/d99cc366dfbbf99493f917e2d43c683f.webp differ
diff --git a/webp.cabal b/webp.cabal
new file mode 100644
--- /dev/null
+++ b/webp.cabal
@@ -0,0 +1,83 @@
+cabal-version: 1.18
+name: webp
+version: 0.1.0.0
+license: GPL-3
+license-file: LICENSE
+copyright: Copyright: (c) 2020 Vanessa
+maintainer: McHale
+author: Vanessa
+synopsis: JuicyPixels support for WebP format
+description:
+ Haskell library for webp format, via [c2hs](http://hackage.haskell.org/package/c2hs) and [libwebp](https://developers.google.com/speed/webp/docs/api).
+
+category: Codec, Image, Compression
+build-type: Simple
+extra-source-files: test/data/*.webp
+extra-doc-files:
+ README.md
+ CHANGELOG.md
+
+source-repository head
+ type: darcs
+ location: http://hub.darcs.net/vmchale/webp
+
+library
+ exposed-modules: Codec.Picture.WebP
+ build-tool-depends: c2hs:c2hs -any
+ pkgconfig-depends: libwebp ==1.1.0 || >1.1.0
+ hs-source-dirs: src
+ other-modules:
+ WebP.Encode
+ WebP.Decode
+ WebP.Types
+
+ default-language: Haskell2010
+ other-extensions: TypeFamilies
+ ghc-options: -Wall
+ build-depends:
+ base >=4.7 && <5,
+ JuicyPixels >=3.0,
+ bytestring -any,
+ vector -any
+
+ if impl(ghc >=8.0)
+ ghc-options:
+ -Wincomplete-uni-patterns -Wincomplete-record-updates
+ -Wredundant-constraints
+
+ if impl(ghc >=8.4)
+ ghc-options: -Wmissing-export-lists
+
+ if impl(ghc >=8.2)
+ ghc-options: -Wcpp-undef
+
+ if impl(ghc >=8.10)
+ ghc-options: -Wunused-packages
+
+test-suite webp-test
+ type: exitcode-stdio-1.0
+ main-is: Spec.hs
+ hs-source-dirs: test
+ default-language: Haskell2010
+ ghc-options: -threaded -rtsopts "-with-rtsopts=-N -K1K" -Wall
+ build-depends:
+ base -any,
+ webp -any,
+ tasty -any,
+ tasty-hunit -any,
+ JuicyPixels -any,
+ bytestring -any
+
+ if impl(ghc >=8.0)
+ ghc-options:
+ -Wincomplete-uni-patterns -Wincomplete-record-updates
+ -Wredundant-constraints
+
+ if impl(ghc >=8.4)
+ ghc-options: -Wmissing-export-lists
+
+ if impl(ghc >=8.2)
+ ghc-options: -Wcpp-undef
+
+ if impl(ghc >=8.10)
+ ghc-options: -Wunused-packages