packages feed

avif (empty) → 0.1.0.0

raw patch · 7 files changed

+274/−0 lines, 7 filesdep +JuicyPixelsdep +avifdep +base

Dependencies added: JuicyPixels, avif, base, bytestring, deepseq, tasty, tasty-hunit, vector

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# avif++## 0.1.0.0++Initial release
+ LICENSE view
@@ -0,0 +1,15 @@+avif+Copyright (C) 2021  Vanessa McHale++This program is free software: you can redistribute it and/or modify+it under the terms of the GNU Affero 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 Affero General Public License for more details.++You should have received a copy of the GNU Affero General Public License+along with this program. If not, see <http://www.gnu.org/licenses/>.
+ README.md view
@@ -0,0 +1,3 @@+# avif++Haskell bindings to [libavif](https://github.com/AOMediaCodec/libavif).
+ avif.cabal view
@@ -0,0 +1,75 @@+cabal-version:   1.18+name:            avif+version:         0.1.0.0+license:         AGPL-3+license-file:    LICENSE+copyright:       Copyright: (c) 2021 Vanessa McHale+maintainer:      vamchale@gmail.com+author:          Vanessa McHale+category:        Image, Codec+synopsis: High-level bindings to libavif+build-type:      Simple+extra-doc-files:+    README.md+    CHANGELOG.md++source-repository head+    type:     git+    location: https://github.com/vmchale/avif++library+    exposed-modules:  Codec.Avif+    other-modules:    Codec.Avif.FFI+    hs-source-dirs:   src+    default-language: Haskell2010+    ghc-options:      -Wall+    build-depends:    base >=4.7 && <5+                    , bytestring+                    , JuicyPixels+                    , vector+    build-tool-depends: c2hs:c2hs+    pkgconfig-depends: libavif++    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 avif-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+    -- libyuv is wrong?? lol+    -- extra-libraries:  jpeg+    build-depends:+        base,+        avif,+        tasty,+        tasty-hunit,+        bytestring,+        deepseq++    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
+ src/Codec/Avif.chs view
@@ -0,0 +1,85 @@+module Codec.Avif ( encode+                  , decode+                  ) where++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)++#include <avif/avif.h>++-- PixelYCbCr8?++throwRes :: AvifResult -> IO ()+throwRes AvifResultOk = pure (); throwRes err = throwIO err++{-# NOINLINE encode #-}+encode :: Image PixelRGBA8 -> BS.ByteString+encode img = unsafePerformIO $ do+    avifImgPtr <- avifImageCreate (fromIntegral w) (fromIntegral h) 8 AvifPixelFormatYuv444+    res <- allocaBytes {# sizeof avifRGBImage #} $ \rgbImagePtr ->+        allocaBytes {# sizeof avifRWData #} $ \rwDataPtr -> do+            avifRGBImageSetDefaults rgbImagePtr avifImgPtr+            pxSz <- avifRGBImagePixelSize rgbImagePtr++            preEnc <- avifEncoderCreate+            enc <- castForeignPtr <$> newForeignPtr avifEncoderDestroy (castPtr preEnc)++            withForeignPtr imgPtr $ \iPtr -> do++                {# set avifRGBImage.height #} rgbImagePtr (fromIntegral h)+                {# set avifRGBImage.width #} rgbImagePtr (fromIntegral w)+                {# set avifRGBImage.pixels #} rgbImagePtr (castPtr iPtr)+                {# set avifRGBImage.rowBytes #} rgbImagePtr (fromIntegral w*pxSz)++                throwRes =<< avifImageRGBToYUV avifImgPtr rgbImagePtr++                throwRes =<< avifEncoderWrite enc avifImgPtr rwDataPtr++                sz <- {# get avifRWData->size #} rwDataPtr+                bs <- {# get avifRWData->data #} rwDataPtr++                BS.packCStringLen (castPtr bs, fromIntegral sz)++    res <$ avifImageDestroy avifImgPtr++    where (Image w h bytes) = img+          (imgPtr, _) = VS.unsafeToForeignPtr0 bytes++{-# NOINLINE decode #-}+decode :: BS.ByteString -> Image PixelRGBA8+decode bs = unsafePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, sz) -> do+    preDec <- avifDecoderCreate+    dec <- castForeignPtr <$> newForeignPtr avifDecoderDestroy (castPtr preDec)+    avifImg <- avifImageCreateEmpty++    throwRes =<< avifDecoderReadMemory dec avifImg (castPtr ptr) (fromIntegral sz)++    allocaBytes {# sizeof avifRGBImage #} $ \rgbImagePtr -> do+        avifRGBImageSetDefaults rgbImagePtr avifImg+        avifRGBImageAllocatePixels rgbImagePtr+        throwRes =<< avifImageYUVToRGB avifImg rgbImagePtr++        w <- {# get avifRGBImage->width #} rgbImagePtr+        h <- {# get avifRGBImage->height #} rgbImagePtr+        pxSz <- avifRGBImagePixelSize rgbImagePtr++        pxPtr <- {# get avifRGBImage->pixels #} rgbImagePtr++        let sz' = w * h * pxSz++        outBytes <- mallocForeignPtrBytes (fromIntegral sz')++        withForeignPtr outBytes $ \outPtr -> do+            memcpy (castPtr outPtr) (castPtr pxPtr) (fromIntegral sz')+            Image (fromIntegral w) (fromIntegral h) (VS.unsafeFromForeignPtr0 outBytes (fromIntegral sz')) <$ (avifRGBImageFreePixels rgbImagePtr *> avifImageDestroy avifImg)
+ src/Codec/Avif/FFI.chs view
@@ -0,0 +1,65 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Codec.Avif.FFI ( avifImageCreate+                      , avifImageCreateEmpty+                      , avifImageDestroy+                      , avifEncoderCreate+                      , avifEncoderDestroy+                      , avifEncoderWrite+                      , avifDecoderCreate+                      , avifDecoderDestroy+                      , avifDecoderReadMemory+                      , avifRGBImageSetDefaults+                      , avifRGBImagePixelSize+                      , avifImageRGBToYUV+                      , avifImageYUVToRGB+                      , avifRGBImageAllocatePixels+                      , avifRGBImageFreePixels+                      , AvifPixelFormat (..)+                      , AvifResult (..)+                      ) where++import Control.Exception (Exception)+import Data.Coerce (coerce)+import Data.Typeable (Typeable (..))+import Foreign.C.Types (CInt, CSize)+import Foreign.Ptr (castPtr, Ptr)++#include <avif/avif.h>++type UInt8 = {# type uint8_t #}+type UInt32 = {# type uint32_t #}++{# enum avifPixelFormat as AvifPixelFormat {underscoreToCase} #}+{# enum avifResult as AvifResult {underscoreToCase} deriving (Eq, Show, Typeable) #}++instance Exception AvifResult where++-- {# pointer *LZ_Decoder as LZDecoderPtr foreign finalizer LZ_decompress_close as ^ -> LZDecoder #}+data AvifImage -- TODO: finalizer for AvifImage+data AvifEncoder+data AvifDecoder+data AvifRwData+data AvifRGBImage++{# pointer *avifEncoder as AvifEncoderPtr foreign finalizer avifEncoderDestroy as ^ -> AvifEncoder #}+{# pointer *avifDecoder as AvifDecoderPtr foreign finalizer avifDecoderDestroy as ^ -> AvifDecoder #}++{# fun avifImageCreate as ^ { `CInt', `CInt', `CInt', `AvifPixelFormat' } -> `Ptr AvifImage' castPtr #}+{# fun avifImageCreateEmpty as ^ { } -> `Ptr AvifImage' castPtr #}+{# fun avifImageDestroy as ^ { castPtr `Ptr AvifImage' } -> `()' #}++{# fun avifEncoderCreate as ^ { } -> `Ptr AvifEncoder' castPtr #}+{# fun avifEncoderWrite as ^ { `AvifEncoderPtr', castPtr `Ptr AvifImage', castPtr `Ptr AvifRwData' } -> `AvifResult' #}++{# fun avifDecoderCreate as ^ { } -> `Ptr AvifDecoder' castPtr #}+{# fun avifDecoderReadMemory as ^ { `AvifDecoderPtr', castPtr `Ptr AvifImage', castPtr `Ptr UInt8', coerce `CSize' } -> `AvifResult' #}++{# fun avifRGBImageSetDefaults as ^ { castPtr `Ptr AvifRGBImage', castPtr `Ptr AvifImage' } -> `()' #}+{# fun avifRGBImagePixelSize as ^ { castPtr `Ptr AvifRGBImage' } -> `UInt32' id #}++{# fun avifImageRGBToYUV as ^ { castPtr `Ptr AvifImage', castPtr `Ptr AvifRGBImage' } -> `AvifResult' #}+{# fun avifImageYUVToRGB as ^ { castPtr `Ptr AvifImage', castPtr `Ptr AvifRGBImage' } -> `AvifResult' #}++{# fun avifRGBImageAllocatePixels as ^ { castPtr `Ptr AvifRGBImage' } -> `()' #}+{# fun avifRGBImageFreePixels as ^ { castPtr `Ptr AvifRGBImage' } -> `()' #}
+ test/Spec.hs view
@@ -0,0 +1,26 @@+module Main (main) where++import           Codec.Avif+import           Control.Applicative ((<$>))+import           Control.DeepSeq     (deepseq)+import qualified Data.ByteString     as BS+import           Test.Tasty+import           Test.Tasty.HUnit++main :: IO ()+main = defaultMain $+    testGroup "Roundtrip"+        [ decodeNoThrow "test/data/original.avif"+        , decEncNoThrow "test/data/original.avif"+        ]++decodeNoThrow :: FilePath -> TestTree+decodeNoThrow fp = testCase fp $ do+    res <- decode <$> BS.readFile fp+    assertBool "Doesn't throw exception" (res `deepseq` True)++decEncNoThrow :: FilePath -> TestTree+decEncNoThrow fp = testCase fp $ do+    bytes <- BS.readFile fp+    let res = encode (decode bytes)+    assertBool "Doesn't throw exception" (res `deepseq` True)