webp (empty) → 0.1.0.0
raw patch · 11 files changed
+335/−0 lines, 11 filesdep +JuicyPixelsdep +basedep +bytestringbinary-added
Dependencies added: JuicyPixels, base, bytestring, tasty, tasty-hunit, vector, webp
Files
- CHANGELOG.md +5/−0
- LICENSE +14/−0
- README.md +5/−0
- src/Codec/Picture/WebP.hs +115/−0
- src/WebP/Decode.chs +21/−0
- src/WebP/Encode.chs +20/−0
- src/WebP/Types.hs +6/−0
- test/Spec.hs +66/−0
- test/data/6b3001b4ebfc341ed0359c00586e6ce1.webp binary
- test/data/d99cc366dfbbf99493f917e2d43c683f.webp binary
- webp.cabal +83/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# webp++## 0.1.0.0++Initial release
+ LICENSE view
@@ -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 <http://www.gnu.org/licenses/>.
+ README.md view
@@ -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).
+ src/Codec/Picture/WebP.hs view
@@ -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))
+ src/WebP/Decode.chs view
@@ -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 <webp/decode.h>++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
+ src/WebP/Encode.chs view
@@ -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 <webp/encode.h>++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 #}
+ src/WebP/Types.hs view
@@ -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 ())
+ test/Spec.hs view
@@ -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)
+ test/data/6b3001b4ebfc341ed0359c00586e6ce1.webp view
binary file changed (absent → 86312 bytes)
+ test/data/d99cc366dfbbf99493f917e2d43c683f.webp view
binary file changed (absent → 67586 bytes)
+ webp.cabal view
@@ -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