diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,12 @@ +# 0.2.1 + +* Move the package into it's own repository: [lehins/massiv-io](https://github.com/lehins/massiv-io) +* Addition of instances for `GIF` sequences in `RGB` with `Alpha` and instanced with + `GifDisposalMethod` +* Addition of conversion functions: `demoteLumaImage`, `promoteLumaImage`, + `demoteLumaAlphaImage`, `promoteLumaAlphaImage` +* Instances for reading and writing images in Luma: `Y'` and `Y'A` + # 0.2.0 * Switch to `MonadIO` diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,30 +1,29 @@ -Copyright Alexey Kuleshevich (c) 2017-2020 +BSD 3-Clause License +Copyright (c) 2013-2020, Alexey Kuleshevich All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. - * Neither the name of Author name here nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. +* Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,2 +1,16 @@ # massiv-io -Import/export Arrays in various formats. + +`massiv-io` is a package that brings together `JuicyPixels`, `Netpbm`, `Color` and `massiv` +in order to easily read, write and convert images in various formats and color spaces. + +## Status + +| Language | Travis | AppVeyor | Coveralls |Gitter.im | +|:--------:|:------:|:--------:|:---------:|:--------:| +| ![GitHub top language](https://img.shields.io/github/languages/top/lehins/massiv-io.svg) | [![Travis](https://img.shields.io/travis/lehins/massiv-io/master.svg?label=Linux%20%26%20OS%20X)](https://travis-ci.org/lehins/massiv-io) | [![Build status](https://ci.appveyor.com/api/projects/status/k84digw9uo3ldqc9/branch/master?svg=true)](https://ci.appveyor.com/project/lehins/massiv-io/branch/master) | [![Coverage Status](https://coveralls.io/repos/github/lehins/massiv-io/badge.svg?branch=master)](https://coveralls.io/github/lehins/massiv-io?branch=master) | [![Join the chat at https://gitter.im/haskell-massiv/Lobby](https://badges.gitter.im/haskell-massiv/Lobby.svg)](https://gitter.im/haskell-massiv/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) + +| Package | Hackage | Nightly | LTS | +|:-------------------|:-------:|:-------:|:---:| +| [`massiv-io`](https://github.com/lehins/massiv-io)| [![Hackage](https://img.shields.io/hackage/v/massiv-io.svg)](https://hackage.haskell.org/package/massiv-io)| [![Nightly](https://www.stackage.org/package/massiv-io/badge/nightly)](https://www.stackage.org/nightly/package/massiv-io)| [![Nightly](https://www.stackage.org/package/massiv-io/badge/lts)](https://www.stackage.org/lts/package/massiv-io)| +| [`massiv`](https://github.com/lehins/massiv/tree/master/massiv)| [![Hackage](https://img.shields.io/hackage/v/massiv.svg)](https://hackage.haskell.org/package/massiv)| [![Nightly](https://www.stackage.org/package/massiv/badge/nightly)](https://www.stackage.org/nightly/package/massiv)| [![Nightly](https://www.stackage.org/package/massiv/badge/lts)](https://www.stackage.org/lts/package/massiv)| +| [`Color`](https://github.com/lehins/Color/tree/master/Color)| [![Hackage](https://img.shields.io/hackage/v/Color.svg)](https://hackage.haskell.org/package/Color)| [![Nightly](https://www.stackage.org/package/Color/badge/nightly)](https://www.stackage.org/nightly/package/Color)| [![Nightly](https://www.stackage.org/package/Color/badge/lts)](https://www.stackage.org/lts/package/Color)| diff --git a/massiv-io.cabal b/massiv-io.cabal --- a/massiv-io.cabal +++ b/massiv-io.cabal @@ -1,10 +1,10 @@ name: massiv-io -version: 0.2.0.0 +version: 0.2.1.0 synopsis: Import/export of Image files into massiv Arrays description: This package contains functionality for import/export of arrays into the real world. For now it only has the ability to read/write image files in various formats. -homepage: https://github.com/lehins/massiv +homepage: https://github.com/lehins/massiv-io license: BSD3 license-file: LICENSE author: Alexey Kuleshevich @@ -15,7 +15,7 @@ extra-doc-files: files/*.jpg extra-source-files: README.md , CHANGELOG.md -cabal-version: >=1.18 +cabal-version: 1.18 custom-setup setup-depends: base @@ -40,13 +40,13 @@ , Data.Massiv.Array.IO.Image.Netpbm build-depends: base >= 4.8 && < 5 , bytestring - , Color >= 0.1.2 + , Color >= 0.1.4 , data-default-class , deepseq , exceptions , filepath , massiv >= 0.3 - , JuicyPixels >= 3.3 + , JuicyPixels >= 3.3.5 , netpbm , unliftio >= 0.2.12 , vector >= 0.10 @@ -65,7 +65,9 @@ type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Main.hs - other-modules: Data.Massiv.Array.IOSpec + other-modules: Test.Massiv.Array.IO.Image.Common + , Test.Massiv.Array.IO.Image.JuicyPixelsSpec + , Test.Massiv.Array.IO.Image.AutoSpec , Spec build-depends: JuicyPixels , QuickCheck @@ -99,4 +101,4 @@ source-repository head type: git - location: https://github.com/lehins/massiv + location: https://github.com/lehins/massiv-io diff --git a/src/Data/Massiv/Array/IO.hs b/src/Data/Massiv/Array/IO.hs --- a/src/Data/Massiv/Array/IO.hs +++ b/src/Data/Massiv/Array/IO.hs @@ -57,10 +57,14 @@ Readable(..), Sequence(..), Writable(..), convertEither, convertImage, decode', decodeError, - defaultWriteOptions, encode', - encodeError, fromImageBaseModel, - fromMaybeDecode, fromMaybeEncode, - toImageBaseModel, toProxy) + defaultWriteOptions, + demoteLumaAlphaImage, demoteLumaImage, + encode', encodeError, + fromImageBaseModel, fromMaybeDecode, + fromMaybeEncode, + promoteLumaAlphaImage, + promoteLumaImage, toImageBaseModel, + toProxy) import Data.Massiv.Array.IO.Image import Graphics.Pixel.ColorSpace import Prelude @@ -166,7 +170,7 @@ -- actual image file, `ConvertError` will be thrown. -- -- >>> frog <- readImage "files/frog.jpg" :: IO (Image S SRGB Word8) --- *** Exception: ConvertError "Cannot decode JPG image as " +-- *** Exception: ConvertError "Cannot decode JPG image as " -- -- Whenever image is not in the color space or precision that we need, either use -- `readImageAuto` or manually convert to the desired one by using the appropriate @@ -183,16 +187,16 @@ -- -- @since 0.1.0 readImage :: - (ColorSpace cs i e, MonadIO m) + (ColorModel cs e, MonadIO m) => FilePath -- ^ File path for an image -> m (Image S cs e) readImage path = liftIO (B.readFile path >>= decodeImageM imageReadFormats path) {-# INLINE readImage #-} --- | Similar to `readImage`, but works will perform all necessary color space conversion +-- | Similar to `readImage`, but will perform all necessary color space conversion -- and precision adjustment in order to match the result image type. Very useful whenever --- image format isn't known at compile time. +-- image format isn't known ahead of time. -- -- >>> frogCMYK <- readImageAuto "files/frog.jpg" :: IO (Image S (CMYK SRGB) Double) -- >>> size frogCMYK @@ -220,7 +224,7 @@ -- -- @since 0.1.0 writeImage :: - (Source r Ix2 (Pixel cs e), ColorSpace cs i e, MonadIO m) => FilePath -> Image r cs e -> m () + (Source r Ix2 (Pixel cs e), ColorModel cs e, MonadIO m) => FilePath -> Image r cs e -> m () writeImage path img = liftIO (encodeImageM imageWriteFormats path img >>= writeLazyAtomically path) diff --git a/src/Data/Massiv/Array/IO/Base.hs b/src/Data/Massiv/Array/IO/Base.hs --- a/src/Data/Massiv/Array/IO/Base.hs +++ b/src/Data/Massiv/Array/IO/Base.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -31,25 +32,34 @@ , convertImage , toImageBaseModel , fromImageBaseModel + , demoteLumaImage + , promoteLumaImage + , demoteLumaAlphaImage + , promoteLumaAlphaImage , defaultWriteOptions , encodeError , decodeError , toProxy , fromMaybeEncode + , fromMaybeDecodeM , fromMaybeDecode , convertEither + , unsafeFromStorableVectorM , MonadThrow(..) ) where -import Unsafe.Coerce import Control.Exception (Exception, throw) import Control.Monad.Catch (MonadThrow(..)) import qualified Data.ByteString as B (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString) import Data.Default.Class (Default(..)) import Data.Massiv.Array as A +import Data.Massiv.Array.Manifest.Vector import Data.Typeable +import qualified Data.Vector.Storable as V +import Graphics.Pixel as CM import Graphics.Pixel.ColorSpace +import Unsafe.Coerce type Image r cs e = Array r Ix2 (Pixel cs e) @@ -198,7 +208,25 @@ " image <" ++ showCS eImg ++ "> as " ++ showImageType (Proxy :: Proxy (Image r cs e)) Just img -> pure img +-- | Decode an image using the supplied function or throw an error in case of failure. +fromMaybeDecodeM :: + forall r cs e a f m. (ColorModel cs e, FileFormat f, Typeable r, MonadThrow m) + => f + -> (a -> String) + -> (a -> m (Maybe (Image r cs e))) + -> a + -> m (Image r cs e) +fromMaybeDecodeM f showCS conv eImg = + conv eImg >>= \case + Nothing -> + throwM $ + ConvertError $ + "Cannot decode " ++ + show f ++ + " image <" ++ showCS eImg ++ "> as " ++ showImageType (Proxy :: Proxy (Image r cs e)) + Just img -> pure img + -- | Convert an image using the supplied function and return ConvertError error in case of failure. convertEither :: forall r cs i e a f m. (ColorSpace cs i e, FileFormat f, Typeable r, MonadThrow m) @@ -234,18 +262,60 @@ -> Image D cs e convertImage = A.map convertPixel --- | Cast an array. This is theoretically unsafe operation, but for all current `ColorSpace` --- instances this function is perfectly safe. +-- | Cast an array. This is theoretically unsafe operation, but for all currently +-- available `ColorSpace` instances this function is perfectly safe. -- -- @since 0.2.0 toImageBaseModel :: Array S Ix2 (Pixel cs e) -> Array S Ix2 (Pixel (BaseModel cs) e) toImageBaseModel = unsafeCoerce --- | Cast an array. This is theoretically unsafe operation, but for all current `ColorSpace` --- instances this function is perfectly safe. +-- | Cast an array. This is theoretically unsafe operation, but for all currently +-- available `ColorSpace` instances this function is perfectly safe. -- -- @since 0.2.0 fromImageBaseModel :: Array S Ix2 (Pixel (BaseModel cs) e) -> Array S Ix2 (Pixel cs e) fromImageBaseModel = unsafeCoerce + +-- | Cast an array with Luma pixels to an array with pixels in a plain single channel +-- `CM.Y` color model +-- +-- @since 0.2.1 +demoteLumaImage :: Array S Ix2 (Pixel Y' e) -> Array S Ix2 (Pixel CM.Y e) +demoteLumaImage = unsafeCoerce + + +-- | Cast an array with pixels in a plain single channel `CM.Y` color model to an array +-- with Luma pixels +-- +-- @since 0.2.1 +promoteLumaImage :: Array S Ix2 (Pixel CM.Y e) -> Array S Ix2 (Pixel Y' e) +promoteLumaImage = unsafeCoerce + +-- | Same as `demoteLumaImage`, but with Alpha channel +-- +-- @since 0.2.1 +demoteLumaAlphaImage :: Array S Ix2 (Pixel (Alpha Y') e) -> Array S Ix2 (Pixel (Alpha CM.Y) e) +demoteLumaAlphaImage = unsafeCoerce + + +-- | Same as `promoteLumaImage` but with Alpha channel +-- +-- @since 0.2.1 +promoteLumaAlphaImage :: Array S Ix2 (Pixel (Alpha CM.Y) e) -> Array S Ix2 (Pixel (Alpha Y') e) +promoteLumaAlphaImage = unsafeCoerce + + + +unsafeFromStorableVectorM :: + (MonadThrow m, Index ix, Storable a, Storable b) + => Sz ix + -> V.Vector a + -> m (Array S ix b) +unsafeFromStorableVectorM sz v = +#if MIN_VERSION_massiv(0,5,0) + resizeM sz $ fromStorableVector Par $ V.unsafeCast v +#else + fromVectorM Par sz $ V.unsafeCast v +#endif diff --git a/src/Data/Massiv/Array/IO/Image.hs b/src/Data/Massiv/Array/IO/Image.hs --- a/src/Data/Massiv/Array/IO/Image.hs +++ b/src/Data/Massiv/Array/IO/Image.hs @@ -3,6 +3,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeSynonymInstances #-} -- | -- Module : Data.Massiv.Array.IO.Image @@ -79,15 +80,15 @@ -- | List of image formats that can be encoded without any color space conversion. -imageWriteFormats :: (Source r Ix2 (Pixel cs e), ColorSpace cs i e) => [Encode (Image r cs e)] +imageWriteFormats :: (Source r Ix2 (Pixel cs e), ColorModel cs e) => [Encode (Image r cs e)] imageWriteFormats = - [ EncodeAs BMP (\ f -> encodeBMP f def . toImageBaseModel . computeSource) - , EncodeAs GIF (\ f -> encodeGIF f def . toImageBaseModel . computeSource) - , EncodeAs HDR (\ f -> encodeHDR f def . toImageBaseModel . computeSource) - , EncodeAs JPG (\ f -> encodeJPG f def . toImageBaseModel . computeSource) - , EncodeAs PNG (\ f -> encodePNG f . toImageBaseModel . computeSource) - , EncodeAs TGA (\ f -> encodeTGA f . toImageBaseModel . computeSource) - , EncodeAs TIF (\ f -> encodeTIF f . toImageBaseModel . computeSource) + [ EncodeAs BMP (\ f -> encodeBMP f def . computeSource @S) + , EncodeAs GIF (\ f -> encodeGIF f def . computeSource @S) + , EncodeAs HDR (\ f -> encodeHDR f def . computeSource @S) + , EncodeAs JPG (\ f -> encodeJPG f def . computeSource @S) + , EncodeAs PNG (\ f -> encodePNG f . computeSource @S) + , EncodeAs TGA (\ f -> encodeTGA f . computeSource @S) + , EncodeAs TIF (\ f -> encodeTIF f . computeSource @S) ] -- | List of image formats that can be encoded with any necessary color space conversions. @@ -142,18 +143,18 @@ (f:_) -> decodeM f bs -- | List of image formats decodable with no color space conversion -imageReadFormats :: ColorSpace cs i e => [Decode (Image S cs e)] +imageReadFormats :: ColorModel cs e => [Decode (Image S cs e)] imageReadFormats = - [ DecodeAs BMP (\f -> fmap fromImageBaseModel . decodeBMP f) - , DecodeAs GIF (\f -> fmap fromImageBaseModel . decodeGIF f) - , DecodeAs HDR (\f -> fmap fromImageBaseModel . decodeHDR f) - , DecodeAs JPG (\f -> fmap fromImageBaseModel . decodeJPG f) - , DecodeAs PNG (\f -> fmap fromImageBaseModel . decodePNG f) - , DecodeAs TGA (\f -> fmap fromImageBaseModel . decodeTGA f) - , DecodeAs TIF (\f -> fmap fromImageBaseModel . decodeTIF f) - , DecodeAs PBM (\f -> fmap (fromImageBaseModel . fst) . decodeNetpbmImage f) - , DecodeAs PGM (\f -> fmap (fromImageBaseModel . fst) . decodeNetpbmImage f) - , DecodeAs PPM (\f -> fmap (fromImageBaseModel . fst) . decodeNetpbmImage f) + [ DecodeAs BMP decodeBMP + , DecodeAs GIF decodeGIF + , DecodeAs HDR decodeHDR + , DecodeAs JPG decodeJPG + , DecodeAs PNG decodePNG + , DecodeAs TGA decodeTGA + , DecodeAs TIF decodeTIF + , DecodeAs PBM (\f -> fmap fst . decodeNetpbmImage f) + , DecodeAs PGM (\f -> fmap fst . decodeNetpbmImage f) + , DecodeAs PPM (\f -> fmap fst . decodeNetpbmImage f) ] -- | List of image formats decodable with automatic colorspace conversion diff --git a/src/Data/Massiv/Array/IO/Image/JuicyPixels.hs b/src/Data/Massiv/Array/IO/Image/JuicyPixels.hs --- a/src/Data/Massiv/Array/IO/Image/JuicyPixels.hs +++ b/src/Data/Massiv/Array/IO/Image/JuicyPixels.hs @@ -38,6 +38,7 @@ , toJPImageCMYK8 , toJPImageCMYK16 , fromDynamicImage + , fromDynamicImageM , fromDynamicImageAuto ) where diff --git a/src/Data/Massiv/Array/IO/Image/JuicyPixels/BMP.hs b/src/Data/Massiv/Array/IO/Image/JuicyPixels/BMP.hs --- a/src/Data/Massiv/Array/IO/Image/JuicyPixels/BMP.hs +++ b/src/Data/Massiv/Array/IO/Image/JuicyPixels/BMP.hs @@ -76,6 +76,9 @@ pure . JP.encodeBitmapWithMetadata bitmapMetadata . toJPImageRGBA8 +instance Writable BMP (Image S Y' Word8) where + encodeM f opts = encodeM f opts . demoteLumaImage + instance Writable BMP (Image S (Y D65) Word8) where encodeM f opts = encodeM f opts . toImageBaseModel @@ -99,6 +102,8 @@ instance Readable BMP (Image S (Alpha CM.RGB) Word8) where decodeWithMetadataM = decodeWithMetadataBMP +instance Readable BMP (Image S Y' Word8) where + decodeWithMetadataM f = fmap (first promoteLumaImage) . decodeWithMetadataM f instance Readable BMP (Image S (Y D65) Word8) where decodeWithMetadataM f = fmap (first fromImageBaseModel) . decodeWithMetadataM f @@ -141,22 +146,19 @@ decodeWithMetadataM = decodeAutoWithMetadataBMP encodeBMP :: - forall r cs e m. - (ColorModel cs e, Source r Ix2 (Pixel cs e), MonadThrow m) + forall cs e m. (ColorModel cs e, MonadThrow m) => BMP -> BitmapOptions - -> Image r cs e + -> Image S cs e -> m BL.ByteString encodeBMP f BitmapOptions {bitmapMetadata} img = - fromMaybeEncode f (Proxy :: Proxy (Image r cs e)) $ do + fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) $ do Refl <- eqT :: Maybe (e :~: Word8) msum - [ do Refl <- eqT :: Maybe (cs :~: CM.Y) - pure $ JP.encodeBitmapWithMetadata bitmapMetadata $ toJPImageY8 img - , do Refl <- eqT :: Maybe (cs :~: CM.RGB) - pure $ JP.encodeBitmapWithMetadata bitmapMetadata $ toJPImageRGB8 img - , do Refl <- eqT :: Maybe (cs :~: Alpha CM.RGB) - pure $ JP.encodeBitmapWithMetadata bitmapMetadata $ toJPImageRGBA8 img + [ JP.encodeBitmapWithMetadata bitmapMetadata <$> maybeJPImageY8 img + , JP.encodeBitmapWithMetadata bitmapMetadata <$> maybeJPImageRGB8 img + , do Refl <- eqT :: Maybe (cs :~: Alpha (Opaque cs)) + JP.encodeBitmapWithMetadata bitmapMetadata <$> maybeJPImageRGBA8 img ] diff --git a/src/Data/Massiv/Array/IO/Image/JuicyPixels/Base.hs b/src/Data/Massiv/Array/IO/Image/JuicyPixels/Base.hs --- a/src/Data/Massiv/Array/IO/Image/JuicyPixels/Base.hs +++ b/src/Data/Massiv/Array/IO/Image/JuicyPixels/Base.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} @@ -38,7 +39,22 @@ , toJPImageYCbCr8 , toJPImageCMYK8 , toJPImageCMYK16 + , maybeJPImageY8 + , maybeJPImageY16 + , maybeJPImageY32 + , maybeJPImageYA8 + , maybeJPImageYA16 + , maybeJPImageYF + , maybeJPImageRGB8 + , maybeJPImageRGB16 + , maybeJPImageRGBA8 + , maybeJPImageRGBA16 + , maybeJPImageRGBF + , maybeJPImageYCbCr8 + , maybeJPImageCMYK8 + , maybeJPImageCMYK16 , fromDynamicImage + , fromDynamicImageM , fromDynamicImageAuto -- * Conversion to sRGB , toYCbCr8 @@ -50,18 +66,17 @@ , toSRGBA16 ) where -import Prelude as P import qualified Codec.Picture as JP -import qualified Codec.Picture.Types as JP -import Control.Monad (guard, unless) +import Control.Exception (assert) +import Control.Monad (msum, unless) import Data.Massiv.Array as A import Data.Massiv.Array.IO.Base -import Data.Massiv.Array.Manifest.Vector import Data.Typeable import qualified Data.Vector.Storable as V import Foreign.Storable (Storable(sizeOf)) -import Graphics.Pixel.ColorSpace import qualified Graphics.Pixel as CM +import Graphics.Pixel.ColorSpace +import Prelude as P -------------------------------------------------------------------------------- -- Common JuciyPixels encoding/decoding functions ------------------------------ @@ -72,7 +87,7 @@ => f -> Either String JP.DynamicImage -> m (Image S cs e) -convertWith f = either (throwM . DecodeError) (fromMaybeDecode f showJP fromDynamicImage) +convertWith f = either (throwM . DecodeError) (fromMaybeDecodeM f showJP fromDynamicImageM) convertWithMetadata :: @@ -84,27 +99,27 @@ case decoded of Left err -> throwM $ DecodeError err Right (jp, meta) -> do - i <- fromMaybeDecode f showJP fromDynamicImage jp + i <- fromMaybeDecodeM f showJP fromDynamicImageM jp pure (i, meta) convertAutoWithMetadata :: - (MonadThrow m, FileFormat f, Mutable r Ix2 (Pixel cs e), ColorSpace cs i e) + (MonadThrow m, Mutable r Ix2 (Pixel cs e), ColorSpace cs i e) => Auto f -> Either String (JP.DynamicImage, Metadata f) -> m (Image r cs e, Metadata f) -convertAutoWithMetadata f decoded = +convertAutoWithMetadata _ decoded = case decoded of Left err -> throwM $ DecodeError err Right (jp, meta) -> do - i <- fromMaybeDecode f showJP fromDynamicImageAuto jp + i <- fromDynamicImageAuto jp pure (i, meta) convertAutoWith :: - (MonadThrow m, FileFormat f, Mutable r Ix2 (Pixel cs e), ColorSpace cs i e) + (MonadThrow m, Mutable r Ix2 (Pixel cs e), ColorSpace cs i e) => Auto f -> Either String JP.DynamicImage -> m (Image r cs e) -convertAutoWith f = either (throwM . DecodeError) (fromMaybeDecode f showJP fromDynamicImageAuto) +convertAutoWith _ = either (throwM . DecodeError) fromDynamicImageAuto convertSequenceWith :: @@ -114,19 +129,123 @@ -> m [Image S cs e] convertSequenceWith f ejpImgs = do jpImgs <- decodeError ejpImgs - P.traverse (fromMaybeDecode f showJP fromDynamicImage) jpImgs + P.traverse (fromMaybeDecodeM f showJP fromDynamicImageM) jpImgs convertAutoSequenceWith :: - (MonadThrow m, FileFormat (Sequence f), Mutable r Ix2 (Pixel cs e), ColorSpace cs i e) + (MonadThrow m, Mutable r Ix2 (Pixel cs e), ColorSpace cs i e) => Auto (Sequence f) -> Either String [JP.DynamicImage] -> m [Image r cs e] -convertAutoSequenceWith f ejpImgs = do +convertAutoSequenceWith _ ejpImgs = do jpImgs <- decodeError ejpImgs - P.traverse (fromMaybeDecode f showJP fromDynamicImageAuto) jpImgs + P.traverse fromDynamicImageAuto jpImgs +fromJPImageM :: + (Storable (Color cs e), Storable e, JP.Pixel px, MonadThrow m) + => JP.Image px + -> Maybe (Pixel cs e :~: Pixel cs' e') + -> m (Maybe (Image S cs e)) +fromJPImageM jimg = P.mapM $ \Refl -> fromJPImageUnsafeM jimg +sequenceMaybe :: Monad m => [m (Maybe a)] -> m (Maybe a) +sequenceMaybe [] = pure Nothing +sequenceMaybe (x:xs) = + x >>= \case + Nothing -> sequenceMaybe xs + ma -> pure ma + +fromDynamicImageM :: + forall cs e m. (ColorModel cs e, MonadThrow m) + => JP.DynamicImage + -> m (Maybe (Image S cs e)) +fromDynamicImageM jpDynImg = + case jpDynImg of + JP.ImageY8 jimg -> + sequenceMaybe + [ fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel CM.Y Word8)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel Y' Word8)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Y D65) Word8)) + ] + JP.ImageY16 jimg -> + sequenceMaybe + [ fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel CM.Y Word16)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel Y' Word16)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Y D65) Word16)) + ] + JP.ImageY32 jimg -> + sequenceMaybe + [ fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel CM.Y Word32)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel Y' Word32)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Y D65) Word32)) + ] + JP.ImageYF jimg -> + sequenceMaybe + [ fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel CM.Y Float)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel Y' Float)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Y D65) Float)) + ] + JP.ImageYA8 jimg -> + sequenceMaybe + [ fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha CM.Y) Word8)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha Y') Word8)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha (Y D65)) Word8)) + ] + JP.ImageYA16 jimg -> + sequenceMaybe + [ fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha CM.Y) Word16)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha Y') Word16)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha (Y D65)) Word16)) + ] + JP.ImageRGB8 jimg -> + sequenceMaybe + [ fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel CM.RGB Word8)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel SRGB Word8)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel AdobeRGB Word8)) + ] + JP.ImageRGB16 jimg -> + sequenceMaybe + [ fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel CM.RGB Word16)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel SRGB Word16)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel AdobeRGB Word16)) + ] + JP.ImageRGBF jimg -> + sequenceMaybe + [ fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel CM.RGB Float)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel SRGB Float)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel AdobeRGB Float)) + ] + JP.ImageRGBA8 jimg -> + sequenceMaybe + [ fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha CM.RGB) Word8)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha SRGB) Word8)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha AdobeRGB) Word8)) + ] + JP.ImageRGBA16 jimg -> + sequenceMaybe + [ fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha CM.RGB) Word16)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha SRGB) Word16)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha AdobeRGB) Word16)) + ] + JP.ImageYCbCr8 jimg -> + sequenceMaybe + [ fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel CM.YCbCr Word8)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (YCbCr SRGB) Word8)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (YCbCr AdobeRGB) Word8)) + ] + JP.ImageCMYK8 jimg -> + sequenceMaybe + [ fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel CM.CMYK Word8)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (CMYK SRGB) Word8)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (CMYK AdobeRGB) Word8)) + ] + JP.ImageCMYK16 jimg -> + sequenceMaybe + [ fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel CM.CMYK Word16)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (CMYK SRGB) Word16)) + , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (CMYK AdobeRGB) Word16)) + ] + fromDynamicImage :: forall cs e. ColorModel cs e => JP.DynamicImage @@ -135,82 +254,82 @@ case jpDynImg of JP.ImageY8 jimg -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CM.Y Word8) - fromJPImageUnsafe jimg + fromJPImageUnsafeM jimg JP.ImageY16 jimg -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CM.Y Word16) - fromJPImageUnsafe jimg + fromJPImageUnsafeM jimg JP.ImageY32 jimg -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CM.Y Word32) - fromJPImageUnsafe jimg + fromJPImageUnsafeM jimg JP.ImageYF jimg -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CM.Y Float) - fromJPImageUnsafe jimg + fromJPImageUnsafeM jimg JP.ImageYA8 jimg -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel (Alpha CM.Y) Word8) - fromJPImageUnsafe jimg + fromJPImageUnsafeM jimg JP.ImageYA16 jimg -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel (Alpha CM.Y) Word16) - fromJPImageUnsafe jimg + fromJPImageUnsafeM jimg JP.ImageRGB8 jimg -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CM.RGB Word8) - fromJPImageUnsafe jimg + fromJPImageUnsafeM jimg JP.ImageRGB16 jimg -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CM.RGB Word16) - fromJPImageUnsafe jimg + fromJPImageUnsafeM jimg JP.ImageRGBF jimg -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CM.RGB Float) - fromJPImageUnsafe jimg + fromJPImageUnsafeM jimg JP.ImageRGBA8 jimg -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel (Alpha CM.RGB) Word8) - fromJPImageUnsafe jimg + fromJPImageUnsafeM jimg JP.ImageRGBA16 jimg -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel (Alpha CM.RGB) Word16) - fromJPImageUnsafe jimg + fromJPImageUnsafeM jimg JP.ImageYCbCr8 jimg -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CM.YCbCr Word8) - fromJPImageUnsafe jimg + fromJPImageUnsafeM jimg JP.ImageCMYK8 jimg -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CM.CMYK Word8) - fromJPImageUnsafe jimg + fromJPImageUnsafeM jimg JP.ImageCMYK16 jimg -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CM.CMYK Word16) - fromJPImageUnsafe jimg - + fromJPImageUnsafeM jimg +{-# DEPRECATED fromDynamicImage "In favor of `fromDynamicImageM`" #-} fromDynamicImageAuto :: - forall r cs i e. (Mutable r Ix2 (Pixel cs e), ColorSpace cs i e) + forall r cs i e m. (Mutable r Ix2 (Pixel cs e), ColorSpace cs i e, MonadThrow m) => JP.DynamicImage - -> Maybe (Image r cs e) + -> m (Image r cs e) fromDynamicImageAuto jpDynImg = case jpDynImg of JP.ImageY8 jimg -> - compute . convertImage <$> (fromJPImageUnsafe jimg :: Maybe (Image S (Y D65) Word8)) + compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (Y D65) Word8)) JP.ImageY16 jimg -> - compute . convertImage <$> (fromJPImageUnsafe jimg :: Maybe (Image S (Y D65) Word16)) + compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (Y D65) Word16)) JP.ImageY32 jimg -> - compute . convertImage <$> (fromJPImageUnsafe jimg :: Maybe (Image S (Y D65) Word32)) + compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (Y D65) Word32)) JP.ImageYF jimg -> - compute . convertImage <$> (fromJPImageUnsafe jimg :: Maybe (Image S (Y D65) Float)) + compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (Y D65) Float)) JP.ImageYA8 jimg -> - compute . convertImage <$> (fromJPImageUnsafe jimg :: Maybe (Image S (Alpha (Y D65)) Word8)) + compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (Alpha (Y D65)) Word8)) JP.ImageYA16 jimg -> - compute . convertImage <$> (fromJPImageUnsafe jimg :: Maybe (Image S (Alpha (Y D65)) Word16)) + compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (Alpha (Y D65)) Word16)) JP.ImageRGB8 jimg -> - compute . convertImage <$> (fromJPImageUnsafe jimg :: Maybe (Image S SRGB Word8)) + compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S SRGB Word8)) JP.ImageRGB16 jimg -> - compute . convertImage <$> (fromJPImageUnsafe jimg :: Maybe (Image S SRGB Word16)) + compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S SRGB Word16)) JP.ImageRGBF jimg -> - compute . convertImage <$> (fromJPImageUnsafe jimg :: Maybe (Image S SRGB Float)) + compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S SRGB Float)) JP.ImageRGBA8 jimg -> - compute . convertImage <$> (fromJPImageUnsafe jimg :: Maybe (Image S (Alpha SRGB) Word8)) + compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (Alpha SRGB) Word8)) JP.ImageRGBA16 jimg -> - compute . convertImage <$> (fromJPImageUnsafe jimg :: Maybe (Image S (Alpha SRGB) Word16)) + compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (Alpha SRGB) Word16)) JP.ImageYCbCr8 jimg -> - compute . convertImage <$> (fromJPImageUnsafe jimg :: Maybe (Image S (YCbCr SRGB) Word8)) + compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (YCbCr SRGB) Word8)) JP.ImageCMYK8 jimg -> - compute . convertImage <$> (fromJPImageUnsafe jimg :: Maybe (Image S (CMYK SRGB) Word8)) + compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (CMYK SRGB) Word8)) JP.ImageCMYK16 jimg -> - compute . convertImage <$> (fromJPImageUnsafe jimg :: Maybe (Image S (CMYK SRGB) Word16)) + compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (CMYK SRGB) Word16)) @@ -248,23 +367,90 @@ toJPImageY8 = toJPImageUnsafe {-# INLINE toJPImageY8 #-} +maybeJPImageY8 :: + forall cs. (Typeable cs, Source S Ix2 (Pixel cs Word8)) + => Image S cs Word8 + -> Maybe (JP.Image JP.Pixel8) +maybeJPImageY8 img = + msum + [ (\Refl -> toJPImageY8 img) <$> (eqT :: Maybe (cs :~: CM.Y)) + , (\Refl -> toJPImageY8 $ demoteLumaImage img) <$> (eqT :: Maybe (cs :~: Y')) + , (\Refl -> toJPImageY8 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: Y D65)) + ] +{-# INLINE maybeJPImageY8 #-} + toJPImageY16 :: Source r Ix2 (Pixel CM.Y Word16) => Image r CM.Y Word16 -> JP.Image JP.Pixel16 toJPImageY16 = toJPImageUnsafe {-# INLINE toJPImageY16 #-} + + +maybeJPImageY16 :: + forall cs. (Typeable cs, Source S Ix2 (Pixel cs Word16)) + => Image S cs Word16 + -> Maybe (JP.Image JP.Pixel16) +maybeJPImageY16 img = + msum + [ (\Refl -> toJPImageY16 img) <$> (eqT :: Maybe (cs :~: CM.Y)) + , (\Refl -> toJPImageY16 $ demoteLumaImage img) <$> (eqT :: Maybe (cs :~: Y')) + , (\Refl -> toJPImageY16 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: Y D65)) + ] +{-# INLINE maybeJPImageY16 #-} + toJPImageY32 :: Source r Ix2 (Pixel CM.Y Word32) => Image r CM.Y Word32 -> JP.Image JP.Pixel32 toJPImageY32 = toJPImageUnsafe {-# INLINE toJPImageY32 #-} + +maybeJPImageY32 :: + forall cs. (Typeable cs, Source S Ix2 (Pixel cs Word32)) + => Image S cs Word32 + -> Maybe (JP.Image JP.Pixel32) +maybeJPImageY32 img = + msum + [ (\Refl -> toJPImageY32 img) <$> (eqT :: Maybe (cs :~: CM.Y)) + , (\Refl -> toJPImageY32 $ demoteLumaImage img) <$> (eqT :: Maybe (cs :~: Y')) + , (\Refl -> toJPImageY32 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: Y D65)) + ] +{-# INLINE maybeJPImageY32 #-} + + toJPImageYF :: Source r Ix2 (Pixel CM.Y Float) => Image r CM.Y Float -> JP.Image JP.PixelF toJPImageYF = toJPImageUnsafe {-# INLINE toJPImageYF #-} + +maybeJPImageYF :: + forall cs. (Typeable cs, Source S Ix2 (Pixel cs Float)) + => Image S cs Float + -> Maybe (JP.Image JP.PixelF) +maybeJPImageYF img = + msum + [ (\Refl -> toJPImageYF img) <$> (eqT :: Maybe (cs :~: CM.Y)) + , (\Refl -> toJPImageYF $ demoteLumaImage img) <$> (eqT :: Maybe (cs :~: Y')) + , (\Refl -> toJPImageYF $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: Y D65)) + ] +{-# INLINE maybeJPImageYF #-} + + toJPImageYA8 :: Source r Ix2 (Pixel (Alpha CM.Y) Word8) => Image r (Alpha CM.Y) Word8 -> JP.Image JP.PixelYA8 toJPImageYA8 = toJPImageUnsafe {-# INLINE toJPImageYA8 #-} +maybeJPImageYA8 :: + forall cs. (Typeable cs, Source S Ix2 (Pixel (Alpha cs) Word8)) + => Image S (Alpha cs) Word8 + -> Maybe (JP.Image JP.PixelYA8) +maybeJPImageYA8 img = + msum + [ (\Refl -> toJPImageYA8 img) <$> (eqT :: Maybe (cs :~: CM.Y)) + , (\Refl -> toJPImageYA8 $ demoteLumaAlphaImage img) <$> (eqT :: Maybe (cs :~: Y')) + , (\Refl -> toJPImageYA8 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: Y D65)) + ] +{-# INLINE maybeJPImageYA8 #-} + + toJPImageYA16 :: Source r Ix2 (Pixel (Alpha CM.Y) Word16) => Image r (Alpha CM.Y) Word16 @@ -272,19 +458,74 @@ toJPImageYA16 = toJPImageUnsafe {-# INLINE toJPImageYA16 #-} + +maybeJPImageYA16 :: + forall cs. (Typeable cs, Source S Ix2 (Pixel (Alpha cs) Word16)) + => Image S (Alpha cs) Word16 + -> Maybe (JP.Image JP.PixelYA16) +maybeJPImageYA16 img = + msum + [ (\Refl -> toJPImageYA16 img) <$> (eqT :: Maybe (cs :~: CM.Y)) + , (\Refl -> toJPImageYA16 $ demoteLumaAlphaImage img) <$> (eqT :: Maybe (cs :~: Y')) + , (\Refl -> toJPImageYA16 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: Y D65)) + ] +{-# INLINE maybeJPImageYA16 #-} + + + toJPImageRGB8 :: Source r Ix2 (Pixel CM.RGB Word8) => Image r CM.RGB Word8 -> JP.Image JP.PixelRGB8 toJPImageRGB8 = toJPImageUnsafe {-# INLINE toJPImageRGB8 #-} + +maybeJPImageRGB8 :: + forall cs. (Typeable cs, Source S Ix2 (Pixel cs Word8)) + => Image S cs Word8 + -> Maybe (JP.Image JP.PixelRGB8) +maybeJPImageRGB8 img = + msum + [ (\Refl -> toJPImageRGB8 img) <$> (eqT :: Maybe (cs :~: CM.RGB)) + , (\Refl -> toJPImageRGB8 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: SRGB)) + , (\Refl -> toJPImageRGB8 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: AdobeRGB)) + ] +{-# INLINE maybeJPImageRGB8 #-} + + toJPImageRGB16 :: Source r Ix2 (Pixel CM.RGB Word16) => Image r CM.RGB Word16 -> JP.Image JP.PixelRGB16 toJPImageRGB16 = toJPImageUnsafe {-# INLINE toJPImageRGB16 #-} +maybeJPImageRGB16 :: + forall cs. (Typeable cs, Source S Ix2 (Pixel cs Word16)) + => Image S cs Word16 + -> Maybe (JP.Image JP.PixelRGB16) +maybeJPImageRGB16 img = + msum + [ (\Refl -> toJPImageRGB16 img) <$> (eqT :: Maybe (cs :~: CM.RGB)) + , (\Refl -> toJPImageRGB16 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: SRGB)) + , (\Refl -> toJPImageRGB16 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: AdobeRGB)) + ] +{-# INLINE maybeJPImageRGB16 #-} + + toJPImageRGBF :: Source r Ix2 (Pixel CM.RGB Float) => Image r CM.RGB Float -> JP.Image JP.PixelRGBF toJPImageRGBF = toJPImageUnsafe {-# INLINE toJPImageRGBF #-} +maybeJPImageRGBF :: + forall cs. (Typeable cs, Source S Ix2 (Pixel cs Float)) + => Image S cs Float + -> Maybe (JP.Image JP.PixelRGBF) +maybeJPImageRGBF img = + msum + [ (\Refl -> toJPImageRGBF img) <$> (eqT :: Maybe (cs :~: CM.RGB)) + , (\Refl -> toJPImageRGBF $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: SRGB)) + , (\Refl -> toJPImageRGBF $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: AdobeRGB)) + ] +{-# INLINE maybeJPImageRGBF #-} + + toJPImageRGBA8 :: Source r Ix2 (Pixel (Alpha CM.RGB) Word8) => Image r (Alpha CM.RGB) Word8 @@ -292,6 +533,19 @@ toJPImageRGBA8 = toJPImageUnsafe {-# INLINE toJPImageRGBA8 #-} +maybeJPImageRGBA8 :: + forall cs. (Typeable cs, Source S Ix2 (Pixel (Alpha cs) Word8)) + => Image S (Alpha cs) Word8 + -> Maybe (JP.Image JP.PixelRGBA8) +maybeJPImageRGBA8 img = + msum + [ (\Refl -> toJPImageRGBA8 img) <$> (eqT :: Maybe (cs :~: CM.RGB)) + , (\Refl -> toJPImageRGBA8 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: SRGB)) + , (\Refl -> toJPImageRGBA8 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: AdobeRGB)) + ] +{-# INLINE maybeJPImageRGBA8 #-} + + toJPImageRGBA16 :: Source r Ix2 (Pixel (Alpha CM.RGB) Word16) => Image r (Alpha CM.RGB) Word16 @@ -299,41 +553,95 @@ toJPImageRGBA16 = toJPImageUnsafe {-# INLINE toJPImageRGBA16 #-} +maybeJPImageRGBA16 :: + forall cs. (Typeable cs, Source S Ix2 (Pixel (Alpha cs) Word16)) + => Image S (Alpha cs) Word16 + -> Maybe (JP.Image JP.PixelRGBA16) +maybeJPImageRGBA16 img = + msum + [ (\Refl -> toJPImageRGBA16 img) <$> (eqT :: Maybe (cs :~: CM.RGB)) + , (\Refl -> toJPImageRGBA16 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: SRGB)) + , (\Refl -> toJPImageRGBA16 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: AdobeRGB)) + ] +{-# INLINE maybeJPImageRGBA16 #-} toJPImageYCbCr8 :: Source r Ix2 (Pixel CM.YCbCr Word8) => Image r CM.YCbCr Word8 -> JP.Image JP.PixelYCbCr8 toJPImageYCbCr8 = toJPImageUnsafe {-# INLINE toJPImageYCbCr8 #-} + +maybeJPImageYCbCr8 :: + forall cs. (Typeable cs, Source S Ix2 (Pixel cs Word8)) + => Image S cs Word8 + -> Maybe (JP.Image JP.PixelYCbCr8) +maybeJPImageYCbCr8 img = + msum + [ (\Refl -> toJPImageYCbCr8 img) <$> (eqT :: Maybe (cs :~: CM.YCbCr)) + , (\Refl -> toJPImageYCbCr8 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: YCbCr SRGB)) + --, (\Refl -> toJPImageYCbCr8 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: YCbCr AdobeRGB)) + ] +{-# INLINE maybeJPImageYCbCr8 #-} + + toJPImageCMYK8 :: Source r Ix2 (Pixel CM.CMYK Word8) => Image r CM.CMYK Word8 -> JP.Image JP.PixelCMYK8 toJPImageCMYK8 = toJPImageUnsafe {-# INLINE toJPImageCMYK8 #-} + +maybeJPImageCMYK8 :: + forall cs. (Typeable cs, Source S Ix2 (Pixel cs Word8)) + => Image S cs Word8 + -> Maybe (JP.Image JP.PixelCMYK8) +maybeJPImageCMYK8 img = + msum + [ (\Refl -> toJPImageCMYK8 img) <$> (eqT :: Maybe (cs :~: CM.CMYK)) + , (\Refl -> toJPImageCMYK8 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: CMYK SRGB)) + , (\Refl -> toJPImageCMYK8 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: CMYK AdobeRGB)) + ] +{-# INLINE maybeJPImageCMYK8 #-} + + toJPImageCMYK16 :: Source r Ix2 (Pixel CM.CMYK Word16) => Image r CM.CMYK Word16 -> JP.Image JP.PixelCMYK16 toJPImageCMYK16 = toJPImageUnsafe {-# INLINE toJPImageCMYK16 #-} +maybeJPImageCMYK16 :: + forall cs. (Typeable cs, Source S Ix2 (Pixel cs Word16)) + => Image S cs Word16 + -> Maybe (JP.Image JP.PixelCMYK16) +maybeJPImageCMYK16 img = + msum + [ (\Refl -> toJPImageCMYK16 img) <$> (eqT :: Maybe (cs :~: CM.CMYK)) + , (\Refl -> toJPImageCMYK16 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: CMYK SRGB)) + , (\Refl -> toJPImageCMYK16 $ toImageBaseModel img) <$> (eqT :: Maybe (cs :~: CMYK AdobeRGB)) + ] +{-# INLINE maybeJPImageCMYK16 #-} + + -- General decoding and helper functions -fromJPImageUnsafe :: forall jpx cs e . (Storable (Pixel cs e), Storable e, JP.Pixel jpx) => - JP.Image jpx -> Maybe (Image S cs e) -fromJPImageUnsafe (JP.Image n m !v) = do +fromJPImageUnsafeM :: + forall jpx cs e m. (Storable (Pixel cs e), Storable e, JP.Pixel jpx, MonadThrow m) + => JP.Image jpx + -> m (Image S cs e) +fromJPImageUnsafeM (JP.Image n m !v) = do let numberOfComponentsFromSize = sizeOf (undefined :: Pixel cs e) `div` sizeOf (undefined :: e) numComponentsPerPixel = JP.componentCount (undefined :: jpx) unless (numComponentsPerPixel == numberOfComponentsFromSize) $ - error $ + throwM $ ConvertError $ concat [ "Mismatched sizes beteen JuicyPixels: " , show numComponentsPerPixel , " and massiv: " , show numberOfComponentsFromSize ] - guard (n * m * numComponentsPerPixel == V.length v) - fromVectorM Par (Sz (m :. n)) $ V.unsafeCast v -{-# INLINE fromJPImageUnsafe #-} + assert (n * m * numComponentsPerPixel == V.length v) $ + unsafeFromStorableVectorM (Sz (m :. n)) v + -- Conversion to sRGB color space based color models diff --git a/src/Data/Massiv/Array/IO/Image/JuicyPixels/GIF.hs b/src/Data/Massiv/Array/IO/Image/JuicyPixels/GIF.hs --- a/src/Data/Massiv/Array/IO/Image/JuicyPixels/GIF.hs +++ b/src/Data/Massiv/Array/IO/Image/JuicyPixels/GIF.hs @@ -25,9 +25,8 @@ , JP.GifLooping(..) , JP.PaletteOptions(..) , JP.PaletteCreationMethod(..) + , JP.GifDisposalMethod(..) - -- , JP.GifDisposalMethod(..) - -- , , decodeGIF , decodeWithMetadataGIF , decodeAutoGIF @@ -84,6 +83,9 @@ instance Writable GIF (Image S CM.RGB Word8) where encodeM GIF = encodePalettizedRGB +instance Writable GIF (Image S Y' Word8) where + encodeM GIF opts = encodeM GIF opts . demoteLumaImage + instance Writable GIF (Image S (Y D65) Word8) where encodeM GIF opts = encodeM GIF opts . toImageBaseModel @@ -153,17 +155,15 @@ decodeWithMetadataM = decodeAutoWithMetadataGIF encodeGIF :: - forall r cs e m. - (ColorModel cs e, Source r Ix2 (Pixel cs e), MonadThrow m) + forall cs e m. (ColorModel cs e, MonadThrow m) => GIF -> GifOptions - -> Image r cs e + -> Image S cs e -> m BL.ByteString encodeGIF f opts img = fallbackEncodePalettizedRGB $ do - Refl <- eqT :: Maybe (cs :~: CM.Y) Refl <- eqT :: Maybe (e :~: Word8) - pure $ JP.encodeGifImage $ toJPImageY8 img + JP.encodeGifImage <$> maybeJPImageY8 img where fallbackEncodePalettizedRGB = \case @@ -171,7 +171,13 @@ Nothing | Just Refl <- (eqT :: Maybe (e :~: Word8)) , Just Refl <- (eqT :: Maybe (cs :~: CM.RGB)) -> encodePalettizedRGB opts img - Nothing -> fromMaybeEncode f (Proxy :: Proxy (Image r cs e)) Nothing + | Just Refl <- (eqT :: Maybe (e :~: Word8)) + , Just Refl <- (eqT :: Maybe (cs :~: SRGB)) -> + encodePalettizedRGB opts $ toImageBaseModel img + | Just Refl <- (eqT :: Maybe (e :~: Word8)) + , Just Refl <- (eqT :: Maybe (cs :~: AdobeRGB)) -> + encodePalettizedRGB opts $ toImageBaseModel img + Nothing -> fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) Nothing encodeAutoGIF :: @@ -192,6 +198,7 @@ data SequenceGifOptions = SequenceGifOptions { sequenceGifPaletteOptions :: !JP.PaletteOptions + -- ^ Options used for palletization. Ignored for images with Alpha channel , sequenceGifLooping :: !JP.GifLooping } @@ -290,7 +297,9 @@ where (rows :. cols) = foldl1 (liftIndex2 max) $ fmap (unSz . size . snd) gifs -instance Writable (Sequence GIF) (NE.NonEmpty (JP.GifDelay, Image S CM.RGB Word8)) where +instance Writable (Sequence GIF) (NE.NonEmpty ( JP.GifDelay + , JP.GifDisposalMethod + , Image S CM.RGB Word8)) where encodeM _ SequenceGifOptions {sequenceGifLooping, sequenceGifPaletteOptions} gifs = encodeError $ JP.encodeComplexGifImage $ @@ -301,7 +310,7 @@ , JP.geBackground = Nothing , JP.geLooping = sequenceGifLooping , JP.geFrames = - flip fmap (NE.toList gifs) $ \(gifDelay, gif) -> + flip fmap (NE.toList gifs) $ \(gifDelay, disposalMethod, gif) -> let (img, palette) = JP.palettize sequenceGifPaletteOptions $ toJPImageRGB8 gif in JP.GifFrame { JP.gfXOffset = 0 @@ -309,19 +318,61 @@ , JP.gfPalette = Just palette , JP.gfTransparent = Nothing , JP.gfDelay = gifDelay - , JP.gfDisposal = JP.DisposalAny + , JP.gfDisposal = disposalMethod , JP.gfPixels = img } } where - (rows :. cols) = foldl1 (liftIndex2 max) $ fmap (unSz . size . snd) gifs + (rows :. cols) = foldl1 (liftIndex2 max) $ fmap (\(_, _, i) -> unSz $ size i) gifs +instance Writable (Sequence GIF) (NE.NonEmpty (JP.GifDelay, Image S CM.RGB Word8)) where + encodeM f opts = encodeM f opts . fmap (\(d, i) -> (d, JP.DisposalAny, i)) +instance Writable (Sequence GIF) (NE.NonEmpty ( JP.GifDelay + , JP.GifDisposalMethod + , Image S (Alpha CM.RGB) Word8)) where + encodeM _ SequenceGifOptions {sequenceGifLooping} gifsNE = + encodeError $ + JP.encodeComplexGifImage $ + JP.GifEncode + { JP.geWidth = cols + , JP.geHeight = rows + , JP.gePalette = Nothing + , JP.geBackground = Nothing + , JP.geLooping = sequenceGifLooping + , JP.geFrames = + P.zipWith (\d f -> f {JP.gfDisposal = d}) disposals $ + JP.palettizeWithAlpha (P.zip delays $ P.map toJPImageRGBA8 images) JP.DisposalAny + } + where + (delays, disposals, images) = P.unzip3 $ NE.toList gifsNE + (rows :. cols) = foldl1 (liftIndex2 max) $ fmap (unSz . size) images + +instance Writable (Sequence GIF) (NE.NonEmpty (JP.GifDelay, Image S (Alpha CM.RGB) Word8)) where + encodeM f opts = encodeM f opts . fmap (\(d, i) -> (d, JP.DisposalRestoreBackground, i)) + +instance Writable (Sequence GIF) (NE.NonEmpty (JP.GifDelay, Image S Y' Word8)) where + encodeM f opts = encodeM f opts . fmap (fmap demoteLumaImage) + instance Writable (Sequence GIF) (NE.NonEmpty (JP.GifDelay, Image S (Y D65) Word8)) where encodeM f opts = encodeM f opts . fmap (fmap toImageBaseModel) instance Writable (Sequence GIF) (NE.NonEmpty (JP.GifDelay, Image S SRGB Word8)) where encodeM f opts = encodeM f opts . fmap (fmap toImageBaseModel) + +instance Writable (Sequence GIF) (NE.NonEmpty (JP.GifDelay, Image S (Alpha SRGB) Word8)) where + encodeM f opts = encodeM f opts . fmap (fmap toImageBaseModel) + +instance Writable (Sequence GIF) (NE.NonEmpty ( JP.GifDelay + , JP.GifDisposalMethod + , Image S SRGB Word8)) where + encodeM f opts = encodeM f opts . fmap (\(dl, dp, i) -> (dl, dp, toImageBaseModel i)) + +instance Writable (Sequence GIF) (NE.NonEmpty ( JP.GifDelay + , JP.GifDisposalMethod + , Image S (Alpha SRGB) Word8)) where + encodeM f opts = encodeM f opts . fmap (\(dl, dp, i) -> (dl, dp, toImageBaseModel i)) + instance (Mutable r Ix2 (Pixel cs e), ColorSpace cs i e) => Writable (Auto (Sequence GIF)) (NE.NonEmpty (JP.GifDelay, Image r cs e)) where diff --git a/src/Data/Massiv/Array/IO/Image/JuicyPixels/HDR.hs b/src/Data/Massiv/Array/IO/Image/JuicyPixels/HDR.hs --- a/src/Data/Massiv/Array/IO/Image/JuicyPixels/HDR.hs +++ b/src/Data/Massiv/Array/IO/Image/JuicyPixels/HDR.hs @@ -119,17 +119,16 @@ decodeWithMetadataM = decodeAutoWithMetadataHDR encodeHDR :: - forall r cs e m. - (ColorModel cs e, Source r Ix2 (Pixel cs e), MonadThrow m) + forall cs e m. + (ColorModel cs e, MonadThrow m) => HDR -> HdrOptions - -> Image r cs e + -> Image S cs e -> m BL.ByteString encodeHDR f opts img = - fromMaybeEncode f (Proxy :: Proxy (Image r cs e)) $ do + fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) $ do Refl <- eqT :: Maybe (e :~: Float) - Refl <- eqT :: Maybe (cs :~: CM.RGB) - pure $ getHdrEncoder opts $ toJPImageRGBF img + getHdrEncoder opts <$> maybeJPImageRGBF img diff --git a/src/Data/Massiv/Array/IO/Image/JuicyPixels/JPG.hs b/src/Data/Massiv/Array/IO/Image/JuicyPixels/JPG.hs --- a/src/Data/Massiv/Array/IO/Image/JuicyPixels/JPG.hs +++ b/src/Data/Massiv/Array/IO/Image/JuicyPixels/JPG.hs @@ -84,6 +84,9 @@ encodeM JPG JpegOptions {jpegQuality, jpegMetadata} = pure . JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata . toJPImageCMYK8 +instance Writable JPG (Image S Y' Word8) where + encodeM f opts = encodeM f opts . demoteLumaImage + instance Writable JPG (Image S (Y D65) Word8) where encodeM f opts = encodeM f opts . toImageBaseModel @@ -116,7 +119,12 @@ instance Readable JPG (Image S CM.YCbCr Word8) where decodeWithMetadataM = decodeWithMetadataJPG +instance Readable JPG (Image S Y' Word8) where + decodeWithMetadataM f = fmap (first promoteLumaImage) . decodeWithMetadataM f +instance Readable JPG (Image S (Alpha Y') Word8) where + decodeWithMetadataM f = fmap (first promoteLumaAlphaImage) . decodeWithMetadataM f + instance Readable JPG (Image S (Y D65) Word8) where decodeWithMetadataM f = fmap (first fromImageBaseModel) . decodeWithMetadataM f @@ -165,27 +173,19 @@ decodeWithMetadataM = decodeAutoWithMetadataJPG encodeJPG :: - forall r cs e m. - (ColorModel cs e, Source r Ix2 (Pixel cs e), MonadThrow m) + forall cs e m. (ColorModel cs e, MonadThrow m) => JPG -> JpegOptions - -> Image r cs e + -> Image S cs e -> m BL.ByteString encodeJPG f JpegOptions {jpegQuality, jpegMetadata} img = - fromMaybeEncode f (Proxy :: Proxy (Image r cs e)) $ do + fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) $ do Refl <- eqT :: Maybe (e :~: Word8) msum - [ do Refl <- eqT :: Maybe (cs :~: CM.Y) - pure $ - JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata $ toJPImageY8 img - , do Refl <- eqT :: Maybe (cs :~: CM.RGB) - pure $ - JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata $ toJPImageRGB8 img - , do Refl <- eqT :: Maybe (cs :~: CM.YCbCr) - pure $ JP.encodeJpegAtQualityWithMetadata jpegQuality jpegMetadata $ toJPImageYCbCr8 img - , do Refl <- eqT :: Maybe (cs :~: CM.CMYK) - pure $ - JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata $ toJPImageCMYK8 img + [ JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata <$> maybeJPImageY8 img + , JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata <$> maybeJPImageRGB8 img + , JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata <$> maybeJPImageYCbCr8 img + , JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata <$> maybeJPImageCMYK8 img ] diff --git a/src/Data/Massiv/Array/IO/Image/JuicyPixels/PNG.hs b/src/Data/Massiv/Array/IO/Image/JuicyPixels/PNG.hs --- a/src/Data/Massiv/Array/IO/Image/JuicyPixels/PNG.hs +++ b/src/Data/Massiv/Array/IO/Image/JuicyPixels/PNG.hs @@ -78,6 +78,18 @@ encodeM PNG _ img = pure $ JP.encodePng (toJPImageRGBA16 img) +instance Writable PNG (Image S Y' Word8) where + encodeM f opts = encodeM f opts . demoteLumaImage + +instance Writable PNG (Image S Y' Word16) where + encodeM f opts = encodeM f opts . demoteLumaImage + +instance Writable PNG (Image S (Alpha Y') Word8) where + encodeM f opts = encodeM f opts . demoteLumaAlphaImage + +instance Writable PNG (Image S (Alpha Y') Word16) where + encodeM f opts = encodeM f opts . demoteLumaAlphaImage + instance Writable PNG (Image S (Y D65) Word8) where encodeM f opts = encodeM f opts . toImageBaseModel @@ -132,6 +144,18 @@ decodeWithMetadataM = decodeWithMetadataPNG +instance Readable PNG (Image S Y' Word8) where + decodeWithMetadataM f = fmap (first promoteLumaImage) . decodeWithMetadataPNG f + +instance Readable PNG (Image S Y' Word16) where + decodeWithMetadataM f = fmap (first promoteLumaImage) . decodeWithMetadataPNG f + +instance Readable PNG (Image S (Alpha Y') Word8) where + decodeWithMetadataM f = fmap (first promoteLumaAlphaImage) . decodeWithMetadataPNG f + +instance Readable PNG (Image S (Alpha Y') Word16) where + decodeWithMetadataM f = fmap (first promoteLumaAlphaImage) . decodeWithMetadataPNG f + instance Readable PNG (Image S (Y D65) Word8) where decodeWithMetadataM f = fmap (first fromImageBaseModel) . decodeWithMetadataPNG f @@ -188,41 +212,27 @@ decodeWithMetadataM = decodeAutoWithMetadataPNG encodePNG :: - forall r cs e m. - (ColorModel cs e, Source r Ix2 (Pixel cs e), MonadThrow m) + forall cs e m. (ColorModel cs e, MonadThrow m) => PNG - -> Image r cs e + -> Image S cs e -> m BL.ByteString encodePNG f img = - fromMaybeEncode f (Proxy :: Proxy (Image r cs e)) $ + fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) $ msum - [ do Refl <- eqT :: Maybe (cs :~: CM.Y) - msum - [ do Refl <- eqT :: Maybe (e :~: Word8) - pure $ JP.encodePng $ toJPImageY8 img - , do Refl <- eqT :: Maybe (e :~: Word16) - pure $ JP.encodePng $ toJPImageY16 img - ] - , do Refl <- eqT :: Maybe (cs :~: Alpha CM.Y) - msum - [ do Refl <- eqT :: Maybe (e :~: Word8) - pure $ JP.encodePng $ toJPImageYA8 img - , do Refl <- eqT :: Maybe (e :~: Word16) - pure $ JP.encodePng $ toJPImageYA16 img - ] - , do Refl <- eqT :: Maybe (cs :~: CM.RGB) + [ do Refl <- eqT :: Maybe (e :~: Word8) msum - [ do Refl <- eqT :: Maybe (e :~: Word8) - pure $ JP.encodePng $ toJPImageRGB8 img - , do Refl <- eqT :: Maybe (e :~: Word16) - pure $ JP.encodePng $ toJPImageRGB16 img + [ JP.encodePng <$> maybeJPImageY8 img + , JP.encodePng <$> maybeJPImageRGB8 img + , do Refl <- eqT :: Maybe (cs :~: Alpha (Opaque cs)) + msum [JP.encodePng <$> maybeJPImageYA8 img, JP.encodePng <$> maybeJPImageRGBA8 img] ] - , do Refl <- eqT :: Maybe (cs :~: Alpha CM.RGB) + , do Refl <- eqT :: Maybe (e :~: Word16) msum - [ do Refl <- eqT :: Maybe (e :~: Word8) - pure $ JP.encodePng $ toJPImageRGBA8 img - , do Refl <- eqT :: Maybe (e :~: Word16) - pure $ JP.encodePng $ toJPImageRGBA16 img + [ JP.encodePng <$> maybeJPImageY16 img + , JP.encodePng <$> maybeJPImageRGB16 img + , do Refl <- eqT :: Maybe (cs :~: Alpha (Opaque cs)) + msum + [JP.encodePng <$> maybeJPImageYA16 img, JP.encodePng <$> maybeJPImageRGBA16 img] ] ] diff --git a/src/Data/Massiv/Array/IO/Image/JuicyPixels/TGA.hs b/src/Data/Massiv/Array/IO/Image/JuicyPixels/TGA.hs --- a/src/Data/Massiv/Array/IO/Image/JuicyPixels/TGA.hs +++ b/src/Data/Massiv/Array/IO/Image/JuicyPixels/TGA.hs @@ -64,6 +64,9 @@ encodeM TGA _ img = pure $ JP.encodeTga (toJPImageRGBA8 img) +instance Writable TGA (Image S Y' Word8) where + encodeM f opts = encodeM f opts . demoteLumaImage + instance Writable TGA (Image S (Y D65) Word8) where encodeM f opts = encodeM f opts . toImageBaseModel @@ -89,6 +92,9 @@ decodeWithMetadataM = decodeWithMetadataTGA +instance Readable TGA (Image S Y' Word8) where + decodeWithMetadataM f = fmap (first promoteLumaImage) . decodeWithMetadataM f + instance Readable TGA (Image S (Y D65) Word8) where decodeWithMetadataM f = fmap (first fromImageBaseModel) . decodeWithMetadataM f @@ -130,24 +136,19 @@ decodeWithMetadataM = decodeAutoWithMetadataTGA encodeTGA :: - forall r cs e m. - (ColorModel cs e, Source r Ix2 (Pixel cs e), MonadThrow m) + forall cs e m. (ColorModel cs e, MonadThrow m) => TGA - -> Image r cs e + -> Image S cs e -> m BL.ByteString encodeTGA f img = - fromMaybeEncode f (Proxy :: Proxy (Image r cs e)) $ - msum - [ do Refl <- eqT :: Maybe (cs :~: CM.Y) - Refl <- eqT :: Maybe (e :~: Word8) - pure $ JP.encodeTga $ toJPImageY8 img - , do Refl <- eqT :: Maybe (cs :~: CM.RGB) - Refl <- eqT :: Maybe (e :~: Word8) - pure $ JP.encodeTga $ toJPImageRGB8 img - , do Refl <- eqT :: Maybe (cs :~: Alpha CM.RGB) - Refl <- eqT :: Maybe (e :~: Word8) - pure $ JP.encodeTga $ toJPImageRGBA8 img - ] + fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) $ do + Refl <- eqT :: Maybe (e :~: Word8) + msum + [ JP.encodeTga <$> maybeJPImageY8 img + , JP.encodeTga <$> maybeJPImageRGB8 img + , do Refl <- eqT :: Maybe (cs :~: Alpha (Opaque cs)) + JP.encodeTga <$> maybeJPImageRGBA8 img + ] encodeAutoTGA :: diff --git a/src/Data/Massiv/Array/IO/Image/JuicyPixels/TIF.hs b/src/Data/Massiv/Array/IO/Image/JuicyPixels/TIF.hs --- a/src/Data/Massiv/Array/IO/Image/JuicyPixels/TIF.hs +++ b/src/Data/Massiv/Array/IO/Image/JuicyPixels/TIF.hs @@ -100,6 +100,24 @@ instance Writable TIF (Image S CM.CMYK Word16) where encodeM TIF _ img = pure $ JP.encodeTiff (toJPImageCMYK16 img) +instance Writable TIF (Image S Y' Word8) where + encodeM f opts = encodeM f opts . demoteLumaImage + +instance Writable TIF (Image S Y' Word16) where + encodeM f opts = encodeM f opts . demoteLumaImage + +instance Writable TIF (Image S Y' Word32) where + encodeM f opts = encodeM f opts . demoteLumaImage + +instance Writable TIF (Image S Y' Float) where + encodeM f opts = encodeM f opts . demoteLumaImage + +instance Writable TIF (Image S (Alpha Y') Word8) where + encodeM f opts = encodeM f opts . demoteLumaAlphaImage + +instance Writable TIF (Image S (Alpha Y') Word16) where + encodeM f opts = encodeM f opts . demoteLumaAlphaImage + instance Writable TIF (Image S (Y D65) Word8) where encodeM f opts = encodeM f opts . toImageBaseModel @@ -181,6 +199,24 @@ decodeWithMetadataM = decodeWithMetadataTIF +instance Readable TIF (Image S Y' Word8) where + decodeWithMetadataM f = fmap (first promoteLumaImage) . decodeWithMetadataM f + +instance Readable TIF (Image S Y' Word16) where + decodeWithMetadataM f = fmap (first promoteLumaImage) . decodeWithMetadataM f + +instance Readable TIF (Image S Y' Word32) where + decodeWithMetadataM f = fmap (first promoteLumaImage) . decodeWithMetadataM f + +instance Readable TIF (Image S Y' Float) where + decodeWithMetadataM f = fmap (first promoteLumaImage) . decodeWithMetadataM f + +instance Readable TIF (Image S (Alpha Y') Word8) where + decodeWithMetadataM f = fmap (first promoteLumaAlphaImage) . decodeWithMetadataM f + +instance Readable TIF (Image S (Alpha Y') Word16) where + decodeWithMetadataM f = fmap (first promoteLumaAlphaImage) . decodeWithMetadataM f + instance Readable TIF (Image S (Y D65) Word8) where decodeWithMetadataM f = fmap (first fromImageBaseModel) . decodeWithMetadataM f @@ -249,56 +285,37 @@ decodeWithMetadataM = decodeAutoWithMetadataTIF encodeTIF :: - forall r cs e m. - (ColorModel cs e, Source r Ix2 (Pixel cs e), MonadThrow m) + forall cs e m. + (ColorModel cs e, MonadThrow m) => TIF - -> Image r cs e + -> Image S cs e -> m BL.ByteString encodeTIF f img = - fromMaybeEncode f (Proxy :: Proxy (Image r cs e)) $ + fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) $ msum - [ do Refl <- eqT :: Maybe (cs :~: CM.Y) - msum - [ do Refl <- eqT :: Maybe (e :~: Word8) - pure $ JP.encodeTiff $ toJPImageY8 img - , do Refl <- eqT :: Maybe (e :~: Word16) - pure $ JP.encodeTiff $ toJPImageY16 img - , do Refl <- eqT :: Maybe (e :~: Word32) - pure $ JP.encodeTiff $ toJPImageY32 img - , do Refl <- eqT :: Maybe (e :~: Float) - pure $ JP.encodeTiff $ toJPImageYF img - ] - , do Refl <- eqT :: Maybe (cs :~: Alpha CM.Y) - msum - [ do Refl <- eqT :: Maybe (e :~: Word8) - pure $ JP.encodeTiff $ toJPImageYA8 img - , do Refl <- eqT :: Maybe (e :~: Word16) - pure $ JP.encodeTiff $ toJPImageYA16 img - ] - , do Refl <- eqT :: Maybe (cs :~: CM.RGB) - msum - [ do Refl <- eqT :: Maybe (e :~: Word8) - pure $ JP.encodeTiff $ toJPImageRGB8 img - , do Refl <- eqT :: Maybe (e :~: Word16) - pure $ JP.encodeTiff $ toJPImageRGB16 img - ] - , do Refl <- eqT :: Maybe (cs :~: Alpha CM.RGB) + [ do Refl <- eqT :: Maybe (e :~: Word8) msum - [ do Refl <- eqT :: Maybe (e :~: Word8) - pure $ JP.encodeTiff $ toJPImageRGBA8 img - , do Refl <- eqT :: Maybe (e :~: Word16) - pure $ JP.encodeTiff $ toJPImageRGBA16 img + [ JP.encodeTiff <$> maybeJPImageY8 img + , JP.encodeTiff <$> maybeJPImageRGB8 img + , do Refl <- eqT :: Maybe (cs :~: Alpha (Opaque cs)) + msum + [JP.encodeTiff <$> maybeJPImageYA8 img, JP.encodeTiff <$> maybeJPImageRGBA8 img] + , JP.encodeTiff <$> maybeJPImageYCbCr8 img + , JP.encodeTiff <$> maybeJPImageCMYK8 img ] - , do Refl <- eqT :: Maybe (cs :~: CM.YCbCr) - Refl <- eqT :: Maybe (e :~: Word8) - pure $ JP.encodeTiff $ toJPImageYCbCr8 img - , do Refl <- eqT :: Maybe (cs :~: CM.CMYK) + , do Refl <- eqT :: Maybe (e :~: Word16) msum - [ do Refl <- eqT :: Maybe (e :~: Word8) - pure $ JP.encodeTiff $ toJPImageCMYK8 img - , do Refl <- eqT :: Maybe (e :~: Word16) - pure $ JP.encodeTiff $ toJPImageCMYK16 img + [ JP.encodeTiff <$> maybeJPImageY16 img + , JP.encodeTiff <$> maybeJPImageRGB16 img + , do Refl <- eqT :: Maybe (cs :~: Alpha (Opaque cs)) + msum + [JP.encodeTiff <$> maybeJPImageYA16 img, JP.encodeTiff <$> maybeJPImageRGBA16 img] + , JP.encodeTiff <$> maybeJPImageCMYK16 img ] + , do Refl <- eqT :: Maybe (e :~: Word32) + JP.encodeTiff <$> maybeJPImageY32 img + , do Refl <- eqT :: Maybe (e :~: Float) + JP.encodeTiff <$> maybeJPImageYF img ] diff --git a/src/Data/Massiv/Array/IO/Image/Netpbm.hs b/src/Data/Massiv/Array/IO/Image/Netpbm.hs --- a/src/Data/Massiv/Array/IO/Image/Netpbm.hs +++ b/src/Data/Massiv/Array/IO/Image/Netpbm.hs @@ -37,7 +37,6 @@ import qualified Data.ByteString as B (ByteString) import Data.Massiv.Array as M import Data.Massiv.Array.IO.Base -import Data.Massiv.Array.Manifest.Vector import Data.Typeable import qualified Data.Vector.Storable as V import Foreign.Storable (Storable) @@ -162,8 +161,7 @@ => Int -> Int -> V.Vector a -> Maybe (Image S cs e) fromNetpbmImageUnsafe m n v = do guard (n * m == V.length v) - fromVectorM Par (Sz (m :. n)) $ V.unsafeCast v - + unsafeFromStorableVectorM (Sz (m :. n)) v showNetpbmCS :: Netpbm.PPM -> String @@ -195,6 +193,10 @@ decodeWithMetadataM = decodeNetpbmImage +instance Readable PGM (Image S Y' Word8) where + decodeWithMetadataM f = fmap (first promoteLumaImage) . decodeWithMetadataM f +instance Readable PGM (Image S Y' Word16) where + decodeWithMetadataM f = fmap (first promoteLumaImage) . decodeWithMetadataM f instance Readable PGM (Image S (Y D65) Word8) where decodeWithMetadataM f = fmap (first fromImageBaseModel) . decodeWithMetadataM f instance Readable PGM (Image S (Y D65) Word16) where @@ -207,6 +209,10 @@ decodeWithMetadataM = decodePPMs fromNetpbmImage +instance Readable (Sequence PGM) [Image S Y' Word8] where + decodeWithMetadataM f = fmap (first (fmap promoteLumaImage)) . decodeWithMetadataM f +instance Readable (Sequence PGM) [Image S Y' Word16] where + decodeWithMetadataM f = fmap (first (fmap promoteLumaImage)) . decodeWithMetadataM f instance Readable (Sequence PGM) [Image S (Y D65) Word8] where decodeWithMetadataM f = fmap (first (fmap fromImageBaseModel)) . decodeWithMetadataM f instance Readable (Sequence PGM) [Image S (Y D65) Word16] where diff --git a/tests/Data/Massiv/Array/IOSpec.hs b/tests/Data/Massiv/Array/IOSpec.hs deleted file mode 100644 --- a/tests/Data/Massiv/Array/IOSpec.hs +++ /dev/null @@ -1,303 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -module Data.Massiv.Array.IOSpec (spec) where - -import Data.Bifunctor -import Data.List.NonEmpty as NE (NonEmpty, fromList) -import Data.Massiv.Array -import Data.Massiv.Array.IO hiding (showsType) -import qualified Data.ByteString.Lazy as BL -import Test.Massiv.Core -import System.Random -import Test.Hspec.QuickCheck - -elevatorGen :: (Random e, Elevator e) => Gen e -elevatorGen = choose (minValue, maxValue) - -instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (Y i) e) where - arbitrary = PixelY <$> elevatorGen -instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (Alpha (Y i)) e) where - arbitrary = PixelYA <$> elevatorGen <*> elevatorGen -instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel SRGB e) where - arbitrary = PixelRGB <$> elevatorGen <*> elevatorGen <*> elevatorGen -instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (Alpha SRGB) e) where - arbitrary = PixelRGBA <$> elevatorGen <*> elevatorGen <*> elevatorGen <*> elevatorGen -instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel AdobeRGB e) where - arbitrary = PixelRGB <$> elevatorGen <*> elevatorGen <*> elevatorGen -instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (Alpha AdobeRGB) e) where - arbitrary = PixelRGBA <$> elevatorGen <*> elevatorGen <*> elevatorGen <*> elevatorGen -instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (YCbCr cs) e) where - arbitrary = PixelYCbCr <$> elevatorGen <*> elevatorGen <*> elevatorGen -instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (Alpha (YCbCr cs)) e) where - arbitrary = PixelYCbCrA <$> elevatorGen <*> elevatorGen <*> elevatorGen <*> elevatorGen -instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (CMYK cs) e) where - arbitrary = PixelCMYK <$> elevatorGen <*> elevatorGen <*> elevatorGen <*> elevatorGen -instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (Alpha (CMYK cs)) e) where - arbitrary = - PixelCMYKA <$> elevatorGen <*> elevatorGen <*> elevatorGen <*> elevatorGen <*> elevatorGen - -specEncodeNoError :: - forall cs e i f. (Writable f (Image S cs e), Arbitrary (Pixel cs e), ColorSpace cs i e) - => f - -> Spec -specEncodeNoError f = - prop (("Image S " ++) . - showsColorModelName (Proxy :: Proxy (Color cs e)) . (' ':) . - showsType @e $ "") $ - property $ \ (ArrNE img :: ArrNE S Ix2 (Pixel cs e)) -> do - bs <- encodeM f def img - bs' <- encodeImageM imageWriteFormats ("foo" ++ ext f) img - bs' `shouldBe` bs - -specEncodeDecodeNoError :: - forall cs e i f. - ( Readable f (Image S cs e) - , Writable f (Image S cs e) - , Arbitrary (Pixel cs e) - , ColorSpace cs i e - ) - => f - -> Spec -specEncodeDecodeNoError f = - prop (("Image S " ++) . - showsColorModelName (Proxy :: Proxy (Color cs e)) . (' ':) . - showsType @e $ "") $ - property $ \ (ArrNE img :: ArrNE S Ix2 (Pixel cs e)) -> do - bs <- encodeM f def img - img' :: Image S cs e <- decodeM f $ BL.toStrict bs - size img' `shouldBe` size img - bs' <- encodeImageM imageWriteFormats ("foo" ++ ext f) img - bs' `shouldBe` bs - -specEncodeDecodeAutoNoError :: - forall cs e i f. - ( Readable (Auto f) (Image S cs e) - , Writable (Auto f) (Image S cs e) - , Arbitrary (Pixel cs e) - , ColorSpace (BaseSpace cs) i e - , ColorSpace cs i e - ) - => f - -> Spec -specEncodeDecodeAutoNoError nonAutoFormat = - prop (("Image S " ++) . - showsColorModelName (Proxy :: Proxy (Color cs e)) . (' ':) . - showsType @e $ "") $ - property $ \ (ArrNE img :: ArrNE S Ix2 (Pixel cs e)) -> do - let f = Auto nonAutoFormat - bs <- encodeM f def img - img' :: Image S cs e <- decodeM f $ BL.toStrict bs - size img' `shouldBe` size img - bs' <- encodeImageM imageWriteAutoFormats ("foo" ++ ext f) img - bs' `shouldBe` bs - -_specEncodeDecodeGifSequenceNoError :: - forall cs e. - ( Readable (Sequence GIF) [Image S cs e] - , Writable (Sequence GIF) (NonEmpty (GifDelay, Image S cs e)) - , Arbitrary (Pixel cs e) - , ColorModel cs e - ) - => Spec -_specEncodeDecodeGifSequenceNoError = - prop (("Image S " ++) . - showsColorModelName (Proxy :: Proxy (Color cs e)) . (' ':) . - showsType @e $ "") $ - property $ \ (imgsNE :: NonEmptyList (GifDelay, ArrNE S Ix2 (Pixel cs e))) -> do - let imgs = fmap (second unArr) $ NE.fromList $ getNonEmpty imgsNE - bs <- encodeM (Sequence GIF) def imgs - imgs' :: [Image S cs e] <- decodeM (Sequence GIF) $ BL.toStrict bs - length imgs' `shouldBe` length imgs - - -spec :: Spec -spec = do - describe "Readable/Writable" $ do - describe "BMP" $ do - specEncodeNoError @(Y D65) @Word8 BMP - --specEncodeDecodeNoError @(Y D65) @Word8 BMP - specEncodeDecodeNoError @SRGB @Word8 BMP - specEncodeDecodeNoError @(Alpha SRGB) @Word8 BMP - describe "GIF" $ do - specEncodeNoError @(Y D65) @Word8 GIF - specEncodeDecodeNoError @SRGB @Word8 GIF - --specEncodeGifSequenceNoError @(Y D65) @Word8 - --describe "Sequenece" $ -- Need to ensure same size for all arrays - -- TODO: Define (Arbitrary ArrListNE) (either slice 3d, or gen list of functions) - -- specEncodeDecodeGifSequenceNoError @SRGB @Word8 - -- TODO: read RGBA8, write Y8 - describe "HDR" $ do - specEncodeDecodeNoError @SRGB @Float HDR - describe "JPG" $ do - specEncodeDecodeNoError @(Y D65) @Word8 JPG - specEncodeDecodeNoError @SRGB @Word8 JPG - specEncodeDecodeNoError @(CMYK SRGB) @Word8 JPG - specEncodeDecodeNoError @(YCbCr SRGB) @Word8 JPG - -- TODO: read YA8 - describe "PNG" $ do - specEncodeDecodeNoError @(Y D65) @Word8 PNG - specEncodeDecodeNoError @(Y D65) @Word16 PNG - specEncodeDecodeNoError @(Alpha (Y D65)) @Word8 PNG - specEncodeDecodeNoError @(Alpha (Y D65)) @Word16 PNG - specEncodeDecodeNoError @SRGB @Word8 PNG - specEncodeDecodeNoError @SRGB @Word16 PNG - specEncodeDecodeNoError @(Alpha SRGB) @Word8 PNG - specEncodeDecodeNoError @(Alpha SRGB) @Word16 PNG - describe "TGA" $ do - specEncodeDecodeNoError @(Y D65) @Word8 TGA - specEncodeDecodeNoError @SRGB @Word8 TGA - specEncodeDecodeNoError @(Alpha SRGB) @Word8 TGA - describe "TIF" $ do - specEncodeDecodeNoError @(Y D65) @Word8 TIF - specEncodeDecodeNoError @(Y D65) @Word16 TIF - specEncodeDecodeNoError @(Y D65) @Word32 TIF - specEncodeDecodeNoError @(Y D65) @Float TIF - specEncodeDecodeNoError @(Alpha (Y D65)) @Word8 TIF - specEncodeDecodeNoError @(Alpha (Y D65)) @Word16 TIF - specEncodeDecodeNoError @SRGB @Word8 TIF - specEncodeDecodeNoError @SRGB @Word16 TIF - specEncodeDecodeNoError @(Alpha SRGB) @Word8 TIF - specEncodeDecodeNoError @(Alpha SRGB) @Word16 TIF - specEncodeDecodeNoError @(CMYK SRGB) @Word8 TIF - specEncodeDecodeNoError @(CMYK SRGB) @Word16 TIF - specEncodeNoError @(YCbCr SRGB) @Word8 TIF - specEncodeDecodeNoErrorAuto BMP - specEncodeDecodeNoErrorAuto GIF - --specEncodeDecodeNoErrorAuto HDR -- Get "Invalid sanline size" from JuicyPixels - specEncodeDecodeNoErrorAuto JPG - specEncodeDecodeNoErrorAuto PNG - specEncodeDecodeNoErrorAuto TGA - specEncodeDecodeNoErrorAuto TIF - - - -specEncodeDecodeNoErrorAuto :: - ( Show f - , Readable (Auto f) (Image S (Y D65) Word8) - , Readable (Auto f) (Image S (Y D65) Word16) - , Readable (Auto f) (Image S (Y D65) Word32) - , Readable (Auto f) (Image S (Y D65) Word64) - , Readable (Auto f) (Image S (CMYK SRGB) Word8) - , Readable (Auto f) (Image S (CMYK SRGB) Word16) - , Readable (Auto f) (Image S (CMYK SRGB) Word32) - , Readable (Auto f) (Image S (CMYK SRGB) Word64) - , Readable (Auto f) (Image S (CMYK AdobeRGB) Word8) - , Readable (Auto f) (Image S (CMYK AdobeRGB) Word16) - , Readable (Auto f) (Image S (CMYK AdobeRGB) Word32) - , Readable (Auto f) (Image S (CMYK AdobeRGB) Word64) - , Readable (Auto f) (Image S (YCbCr SRGB) Word8) - , Readable (Auto f) (Image S (YCbCr SRGB) Word16) - , Readable (Auto f) (Image S (YCbCr SRGB) Word32) - , Readable (Auto f) (Image S (YCbCr SRGB) Word64) - -- , Readable (Auto f) (Image S (YCbCr AdobeRGB) Word8) - -- , Readable (Auto f) (Image S (YCbCr AdobeRGB) Word16) - -- , Readable (Auto f) (Image S (YCbCr AdobeRGB) Word32) - -- , Readable (Auto f) (Image S (YCbCr AdobeRGB) Word64) - , Readable (Auto f) (Image S (Alpha (Y D65)) Word8) - , Readable (Auto f) (Image S (Alpha (Y D65)) Word16) - , Readable (Auto f) (Image S (Alpha (Y D65)) Word32) - , Readable (Auto f) (Image S (Alpha (Y D65)) Word64) - , Readable (Auto f) (Image S (Alpha SRGB) Word8) - , Readable (Auto f) (Image S (Alpha SRGB) Word16) - , Readable (Auto f) (Image S (Alpha SRGB) Word32) - , Readable (Auto f) (Image S (Alpha SRGB) Word64) - , Readable (Auto f) (Image S (Alpha AdobeRGB) Word8) - , Readable (Auto f) (Image S (Alpha AdobeRGB) Word16) - , Readable (Auto f) (Image S (Alpha AdobeRGB) Word32) - , Readable (Auto f) (Image S (Alpha AdobeRGB) Word64) - , Readable (Auto f) (Image S SRGB Word8) - , Readable (Auto f) (Image S SRGB Word16) - , Readable (Auto f) (Image S SRGB Word32) - , Readable (Auto f) (Image S SRGB Word64) - , Readable (Auto f) (Image S AdobeRGB Word8) - , Readable (Auto f) (Image S AdobeRGB Word16) - , Readable (Auto f) (Image S AdobeRGB Word32) - , Readable (Auto f) (Image S AdobeRGB Word64) - , Writable (Auto f) (Image S (Y D65) Word8) - , Writable (Auto f) (Image S (Y D65) Word16) - , Writable (Auto f) (Image S (Y D65) Word32) - , Writable (Auto f) (Image S (Y D65) Word64) - , Writable (Auto f) (Image S (CMYK SRGB) Word8) - , Writable (Auto f) (Image S (CMYK SRGB) Word16) - , Writable (Auto f) (Image S (CMYK SRGB) Word32) - , Writable (Auto f) (Image S (CMYK SRGB) Word64) - , Writable (Auto f) (Image S (CMYK AdobeRGB) Word8) - , Writable (Auto f) (Image S (CMYK AdobeRGB) Word16) - , Writable (Auto f) (Image S (CMYK AdobeRGB) Word32) - , Writable (Auto f) (Image S (CMYK AdobeRGB) Word64) - , Writable (Auto f) (Image S (YCbCr SRGB) Word8) - , Writable (Auto f) (Image S (YCbCr SRGB) Word16) - , Writable (Auto f) (Image S (YCbCr SRGB) Word32) - , Writable (Auto f) (Image S (YCbCr SRGB) Word64) - -- , Writable (Auto f) (Image S (YCbCr AdobeRGB) Word8) - -- , Writable (Auto f) (Image S (YCbCr AdobeRGB) Word16) - -- , Writable (Auto f) (Image S (YCbCr AdobeRGB) Word32) - -- , Writable (Auto f) (Image S (YCbCr AdobeRGB) Word64) - , Writable (Auto f) (Image S (Alpha (Y D65)) Word8) - , Writable (Auto f) (Image S (Alpha (Y D65)) Word16) - , Writable (Auto f) (Image S (Alpha (Y D65)) Word32) - , Writable (Auto f) (Image S (Alpha (Y D65)) Word64) - , Writable (Auto f) (Image S (Alpha SRGB) Word8) - , Writable (Auto f) (Image S (Alpha SRGB) Word16) - , Writable (Auto f) (Image S (Alpha SRGB) Word32) - , Writable (Auto f) (Image S (Alpha SRGB) Word64) - , Writable (Auto f) (Image S (Alpha AdobeRGB) Word8) - , Writable (Auto f) (Image S (Alpha AdobeRGB) Word16) - , Writable (Auto f) (Image S (Alpha AdobeRGB) Word32) - , Writable (Auto f) (Image S (Alpha AdobeRGB) Word64) - , Writable (Auto f) (Image S SRGB Word8) - , Writable (Auto f) (Image S SRGB Word16) - , Writable (Auto f) (Image S SRGB Word32) - , Writable (Auto f) (Image S SRGB Word64) - , Writable (Auto f) (Image S AdobeRGB Word8) - , Writable (Auto f) (Image S AdobeRGB Word16) - , Writable (Auto f) (Image S AdobeRGB Word32) - , Writable (Auto f) (Image S AdobeRGB Word64) - ) - => f - -> Spec -specEncodeDecodeNoErrorAuto f = - describe ("Auto " ++ show f) $ do - specEncodeDecodeAutoNoError @(Y D65) @Word8 f - specEncodeDecodeAutoNoError @(Y D65) @Word16 f - specEncodeDecodeAutoNoError @(Y D65) @Word32 f - specEncodeDecodeAutoNoError @(Y D65) @Word64 f - specEncodeDecodeAutoNoError @(Alpha (Y D65)) @Word8 f - specEncodeDecodeAutoNoError @(Alpha (Y D65)) @Word16 f - specEncodeDecodeAutoNoError @(Alpha (Y D65)) @Word32 f - specEncodeDecodeAutoNoError @(Alpha (Y D65)) @Word64 f - specEncodeDecodeAutoNoError @SRGB @Word8 f - specEncodeDecodeAutoNoError @SRGB @Word16 f - specEncodeDecodeAutoNoError @SRGB @Word32 f - specEncodeDecodeAutoNoError @SRGB @Word64 f - specEncodeDecodeAutoNoError @(Alpha SRGB) @Word8 f - specEncodeDecodeAutoNoError @(Alpha SRGB) @Word16 f - specEncodeDecodeAutoNoError @(Alpha SRGB) @Word32 f - specEncodeDecodeAutoNoError @(Alpha SRGB) @Word64 f - specEncodeDecodeAutoNoError @(CMYK SRGB) @Word8 f - specEncodeDecodeAutoNoError @(CMYK SRGB) @Word16 f - specEncodeDecodeAutoNoError @(CMYK SRGB) @Word32 f - specEncodeDecodeAutoNoError @(CMYK SRGB) @Word64 f - specEncodeDecodeAutoNoError @(YCbCr SRGB) @Word8 f - specEncodeDecodeAutoNoError @(YCbCr SRGB) @Word16 f - specEncodeDecodeAutoNoError @(YCbCr SRGB) @Word32 f - specEncodeDecodeAutoNoError @(YCbCr SRGB) @Word64 f - specEncodeDecodeAutoNoError @AdobeRGB @Word8 f - specEncodeDecodeAutoNoError @AdobeRGB @Word16 f - specEncodeDecodeAutoNoError @AdobeRGB @Word32 f - specEncodeDecodeAutoNoError @AdobeRGB @Word64 f - specEncodeDecodeAutoNoError @(Alpha AdobeRGB) @Word8 f - specEncodeDecodeAutoNoError @(Alpha AdobeRGB) @Word16 f - specEncodeDecodeAutoNoError @(Alpha AdobeRGB) @Word32 f - specEncodeDecodeAutoNoError @(Alpha AdobeRGB) @Word64 f - specEncodeDecodeAutoNoError @(CMYK AdobeRGB) @Word8 f - specEncodeDecodeAutoNoError @(CMYK AdobeRGB) @Word16 f - specEncodeDecodeAutoNoError @(CMYK AdobeRGB) @Word32 f - specEncodeDecodeAutoNoError @(CMYK AdobeRGB) @Word64 f - -- specEncodeDecodeAutoNoError @(YCbCr AdobeRGB) @Word8 f - -- specEncodeDecodeAutoNoError @(YCbCr AdobeRGB) @Word16 f - -- specEncodeDecodeAutoNoError @(YCbCr AdobeRGB) @Word32 f - -- specEncodeDecodeAutoNoError @(YCbCr AdobeRGB) @Word64 f diff --git a/tests/Test/Massiv/Array/IO/Image/AutoSpec.hs b/tests/Test/Massiv/Array/IO/Image/AutoSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Massiv/Array/IO/Image/AutoSpec.hs @@ -0,0 +1,153 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +module Test.Massiv.Array.IO.Image.AutoSpec (spec) where + +import Data.Massiv.Array +import Data.Massiv.Array.IO hiding (showsType) +import Test.Massiv.Core +import Test.Massiv.Array.IO.Image.Common + +spec :: Spec +spec = + describe "Auto" $ + describe "Encode/Decode" $ do + specEncodeDecodeNoErrorAuto BMP + specEncodeDecodeNoErrorAuto GIF + --specEncodeDecodeNoErrorAuto HDR -- Get "Invalid sanline size" from JuicyPixels + specEncodeDecodeNoErrorAuto JPG + specEncodeDecodeNoErrorAuto PNG + specEncodeDecodeNoErrorAuto TGA + specEncodeDecodeNoErrorAuto TIF + + +specEncodeDecodeNoErrorAuto :: + ( Show f + , Readable (Auto f) (Image S (Y D65) Word8) + , Readable (Auto f) (Image S (Y D65) Word16) + , Readable (Auto f) (Image S (Y D65) Word32) + , Readable (Auto f) (Image S (Y D65) Word64) + , Readable (Auto f) (Image S (CMYK SRGB) Word8) + , Readable (Auto f) (Image S (CMYK SRGB) Word16) + , Readable (Auto f) (Image S (CMYK SRGB) Word32) + , Readable (Auto f) (Image S (CMYK SRGB) Word64) + , Readable (Auto f) (Image S (CMYK AdobeRGB) Word8) + , Readable (Auto f) (Image S (CMYK AdobeRGB) Word16) + , Readable (Auto f) (Image S (CMYK AdobeRGB) Word32) + , Readable (Auto f) (Image S (CMYK AdobeRGB) Word64) + , Readable (Auto f) (Image S (YCbCr SRGB) Word8) + , Readable (Auto f) (Image S (YCbCr SRGB) Word16) + , Readable (Auto f) (Image S (YCbCr SRGB) Word32) + , Readable (Auto f) (Image S (YCbCr SRGB) Word64) + -- AdobeRGB doesn't have Luma instance + -- , Readable (Auto f) (Image S (YCbCr AdobeRGB) Word8) + -- , Readable (Auto f) (Image S (YCbCr AdobeRGB) Word16) + -- , Readable (Auto f) (Image S (YCbCr AdobeRGB) Word32) + -- , Readable (Auto f) (Image S (YCbCr AdobeRGB) Word64) + , Readable (Auto f) (Image S (Alpha (Y D65)) Word8) + , Readable (Auto f) (Image S (Alpha (Y D65)) Word16) + , Readable (Auto f) (Image S (Alpha (Y D65)) Word32) + , Readable (Auto f) (Image S (Alpha (Y D65)) Word64) + , Readable (Auto f) (Image S (Alpha SRGB) Word8) + , Readable (Auto f) (Image S (Alpha SRGB) Word16) + , Readable (Auto f) (Image S (Alpha SRGB) Word32) + , Readable (Auto f) (Image S (Alpha SRGB) Word64) + , Readable (Auto f) (Image S (Alpha AdobeRGB) Word8) + , Readable (Auto f) (Image S (Alpha AdobeRGB) Word16) + , Readable (Auto f) (Image S (Alpha AdobeRGB) Word32) + , Readable (Auto f) (Image S (Alpha AdobeRGB) Word64) + , Readable (Auto f) (Image S SRGB Word8) + , Readable (Auto f) (Image S SRGB Word16) + , Readable (Auto f) (Image S SRGB Word32) + , Readable (Auto f) (Image S SRGB Word64) + , Readable (Auto f) (Image S AdobeRGB Word8) + , Readable (Auto f) (Image S AdobeRGB Word16) + , Readable (Auto f) (Image S AdobeRGB Word32) + , Readable (Auto f) (Image S AdobeRGB Word64) + , Writable (Auto f) (Image S (Y D65) Word8) + , Writable (Auto f) (Image S (Y D65) Word16) + , Writable (Auto f) (Image S (Y D65) Word32) + , Writable (Auto f) (Image S (Y D65) Word64) + , Writable (Auto f) (Image S (CMYK SRGB) Word8) + , Writable (Auto f) (Image S (CMYK SRGB) Word16) + , Writable (Auto f) (Image S (CMYK SRGB) Word32) + , Writable (Auto f) (Image S (CMYK SRGB) Word64) + , Writable (Auto f) (Image S (CMYK AdobeRGB) Word8) + , Writable (Auto f) (Image S (CMYK AdobeRGB) Word16) + , Writable (Auto f) (Image S (CMYK AdobeRGB) Word32) + , Writable (Auto f) (Image S (CMYK AdobeRGB) Word64) + , Writable (Auto f) (Image S (YCbCr SRGB) Word8) + , Writable (Auto f) (Image S (YCbCr SRGB) Word16) + , Writable (Auto f) (Image S (YCbCr SRGB) Word32) + , Writable (Auto f) (Image S (YCbCr SRGB) Word64) + -- , Writable (Auto f) (Image S (YCbCr AdobeRGB) Word8) + -- , Writable (Auto f) (Image S (YCbCr AdobeRGB) Word16) + -- , Writable (Auto f) (Image S (YCbCr AdobeRGB) Word32) + -- , Writable (Auto f) (Image S (YCbCr AdobeRGB) Word64) + , Writable (Auto f) (Image S (Alpha (Y D65)) Word8) + , Writable (Auto f) (Image S (Alpha (Y D65)) Word16) + , Writable (Auto f) (Image S (Alpha (Y D65)) Word32) + , Writable (Auto f) (Image S (Alpha (Y D65)) Word64) + , Writable (Auto f) (Image S (Alpha SRGB) Word8) + , Writable (Auto f) (Image S (Alpha SRGB) Word16) + , Writable (Auto f) (Image S (Alpha SRGB) Word32) + , Writable (Auto f) (Image S (Alpha SRGB) Word64) + , Writable (Auto f) (Image S (Alpha AdobeRGB) Word8) + , Writable (Auto f) (Image S (Alpha AdobeRGB) Word16) + , Writable (Auto f) (Image S (Alpha AdobeRGB) Word32) + , Writable (Auto f) (Image S (Alpha AdobeRGB) Word64) + , Writable (Auto f) (Image S SRGB Word8) + , Writable (Auto f) (Image S SRGB Word16) + , Writable (Auto f) (Image S SRGB Word32) + , Writable (Auto f) (Image S SRGB Word64) + , Writable (Auto f) (Image S AdobeRGB Word8) + , Writable (Auto f) (Image S AdobeRGB Word16) + , Writable (Auto f) (Image S AdobeRGB Word32) + , Writable (Auto f) (Image S AdobeRGB Word64) + ) + => f + -> Spec +specEncodeDecodeNoErrorAuto f = + describe (show f) $ do + specEncodeDecodeAutoNoError @(Y D65) @Word8 f + specEncodeDecodeAutoNoError @(Y D65) @Word16 f + specEncodeDecodeAutoNoError @(Y D65) @Word32 f + specEncodeDecodeAutoNoError @(Y D65) @Word64 f + specEncodeDecodeAutoNoError @(Alpha (Y D65)) @Word8 f + specEncodeDecodeAutoNoError @(Alpha (Y D65)) @Word16 f + specEncodeDecodeAutoNoError @(Alpha (Y D65)) @Word32 f + specEncodeDecodeAutoNoError @(Alpha (Y D65)) @Word64 f + specEncodeDecodeAutoNoError @SRGB @Word8 f + specEncodeDecodeAutoNoError @SRGB @Word16 f + specEncodeDecodeAutoNoError @SRGB @Word32 f + specEncodeDecodeAutoNoError @SRGB @Word64 f + specEncodeDecodeAutoNoError @(Alpha SRGB) @Word8 f + specEncodeDecodeAutoNoError @(Alpha SRGB) @Word16 f + specEncodeDecodeAutoNoError @(Alpha SRGB) @Word32 f + specEncodeDecodeAutoNoError @(Alpha SRGB) @Word64 f + specEncodeDecodeAutoNoError @(CMYK SRGB) @Word8 f + specEncodeDecodeAutoNoError @(CMYK SRGB) @Word16 f + specEncodeDecodeAutoNoError @(CMYK SRGB) @Word32 f + specEncodeDecodeAutoNoError @(CMYK SRGB) @Word64 f + specEncodeDecodeAutoNoError @(YCbCr SRGB) @Word8 f + specEncodeDecodeAutoNoError @(YCbCr SRGB) @Word16 f + specEncodeDecodeAutoNoError @(YCbCr SRGB) @Word32 f + specEncodeDecodeAutoNoError @(YCbCr SRGB) @Word64 f + specEncodeDecodeAutoNoError @AdobeRGB @Word8 f + specEncodeDecodeAutoNoError @AdobeRGB @Word16 f + specEncodeDecodeAutoNoError @AdobeRGB @Word32 f + specEncodeDecodeAutoNoError @AdobeRGB @Word64 f + specEncodeDecodeAutoNoError @(Alpha AdobeRGB) @Word8 f + specEncodeDecodeAutoNoError @(Alpha AdobeRGB) @Word16 f + specEncodeDecodeAutoNoError @(Alpha AdobeRGB) @Word32 f + specEncodeDecodeAutoNoError @(Alpha AdobeRGB) @Word64 f + specEncodeDecodeAutoNoError @(CMYK AdobeRGB) @Word8 f + specEncodeDecodeAutoNoError @(CMYK AdobeRGB) @Word16 f + specEncodeDecodeAutoNoError @(CMYK AdobeRGB) @Word32 f + specEncodeDecodeAutoNoError @(CMYK AdobeRGB) @Word64 f + -- specEncodeDecodeAutoNoError @(YCbCr AdobeRGB) @Word8 f + -- specEncodeDecodeAutoNoError @(YCbCr AdobeRGB) @Word16 f + -- specEncodeDecodeAutoNoError @(YCbCr AdobeRGB) @Word32 f + -- specEncodeDecodeAutoNoError @(YCbCr AdobeRGB) @Word64 f diff --git a/tests/Test/Massiv/Array/IO/Image/Common.hs b/tests/Test/Massiv/Array/IO/Image/Common.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Massiv/Array/IO/Image/Common.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +module Test.Massiv.Array.IO.Image.Common where + +import Data.List.NonEmpty as NE (NonEmpty(..)) +import Data.Massiv.Array +import Data.Massiv.Array.IO hiding (showsType) +import qualified Data.ByteString.Lazy as BL +import Test.Massiv.Core +import System.Random +import Test.Hspec.QuickCheck + +elevatorGen :: (Random e, Elevator e) => Gen e +elevatorGen = choose (minValue, maxValue) + +instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel Y' e) where + arbitrary = PixelY' <$> elevatorGen +instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (Alpha Y') e) where + arbitrary = PixelY'A <$> elevatorGen <*> elevatorGen +instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (Y i) e) where + arbitrary = PixelY <$> elevatorGen +instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (Alpha (Y i)) e) where + arbitrary = PixelYA <$> elevatorGen <*> elevatorGen +instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel SRGB e) where + arbitrary = PixelRGB <$> elevatorGen <*> elevatorGen <*> elevatorGen +instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (Alpha SRGB) e) where + arbitrary = PixelRGBA <$> elevatorGen <*> elevatorGen <*> elevatorGen <*> elevatorGen +instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel AdobeRGB e) where + arbitrary = PixelRGB <$> elevatorGen <*> elevatorGen <*> elevatorGen +instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (Alpha AdobeRGB) e) where + arbitrary = PixelRGBA <$> elevatorGen <*> elevatorGen <*> elevatorGen <*> elevatorGen +instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (YCbCr cs) e) where + arbitrary = PixelYCbCr <$> elevatorGen <*> elevatorGen <*> elevatorGen +instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (Alpha (YCbCr cs)) e) where + arbitrary = PixelYCbCrA <$> elevatorGen <*> elevatorGen <*> elevatorGen <*> elevatorGen +instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (CMYK cs) e) where + arbitrary = PixelCMYK <$> elevatorGen <*> elevatorGen <*> elevatorGen <*> elevatorGen +instance (Arbitrary e, Random e, Elevator e) => Arbitrary (Pixel (Alpha (CMYK cs)) e) where + arbitrary = + PixelCMYKA <$> elevatorGen <*> elevatorGen <*> elevatorGen <*> elevatorGen <*> elevatorGen + +specEncodeNoError :: + forall cs e f. (Writable f (Image S cs e), Arbitrary (Pixel cs e), ColorModel cs e) + => f + -> Spec +specEncodeNoError f = + prop (("Image S " ++) . + showsColorModelName (Proxy :: Proxy (Color cs e)) . (' ':) . + showsType @e $ "") $ + property $ \ (ArrNE img :: ArrNE S Ix2 (Pixel cs e)) -> do + bs <- encodeM f def img + bs' <- encodeImageM imageWriteFormats ("foo" ++ ext f) img + bs' `shouldBe` bs + +specEncodeDecodeNoError :: + forall cs e f. + ( Readable f (Image S cs e) + , Writable f (Image S cs e) + , Arbitrary (Pixel cs e) + , ColorModel cs e + ) + => f + -> Spec +specEncodeDecodeNoError f = + prop (("Image S " ++) . + showsColorModelName (Proxy :: Proxy (Color cs e)) . (' ':) . + showsType @e $ "") $ + property $ \ (ArrNE img :: ArrNE S Ix2 (Pixel cs e)) -> do + bs <- encodeM f def img + img' :: Image S cs e <- decodeM f $ BL.toStrict bs + size img' `shouldBe` size img + bs' <- encodeImageM imageWriteFormats ("foo" ++ ext f) img + bs' `shouldBe` bs + +specEncodeDecodeAutoNoError :: + forall cs e i f. + ( Readable (Auto f) (Image S cs e) + , Writable (Auto f) (Image S cs e) + , Arbitrary (Pixel cs e) + , ColorSpace (BaseSpace cs) i e + , ColorSpace cs i e + ) + => f + -> Spec +specEncodeDecodeAutoNoError nonAutoFormat = + prop (("Image S " ++) . + showsColorModelName (Proxy :: Proxy (Color cs e)) . (' ':) . + showsType @e $ "") $ + property $ \ (ArrNE img :: ArrNE S Ix2 (Pixel cs e)) -> do + let f = Auto nonAutoFormat + bs <- encodeM f def img + img' :: Image S cs e <- decodeM f $ BL.toStrict bs + size img' `shouldBe` size img + bs' <- encodeImageM imageWriteAutoFormats ("foo" ++ ext f) img + bs' `shouldBe` bs + +specEncodeDecodeGifSequenceNoError :: + forall cs e. + ( Readable (Sequence GIF) [Image S cs e] + , Writable (Sequence GIF) (NonEmpty (GifDelay, Image S cs e)) + , Arbitrary (Pixel cs e) + , ColorModel cs e + ) + => Spec +specEncodeDecodeGifSequenceNoError = + prop (("Image S " ++) . + showsColorModelName (Proxy :: Proxy (Color cs e)) . (' ':) . + showsType @e $ "") $ + property $ forAll (genNonEmptyImagesWithGifDelay @cs @e) $ \ imgs -> do + bs <- encodeM (Sequence GIF) def imgs + imgs' :: [Image S cs e] <- decodeM (Sequence GIF) $ BL.toStrict bs + Prelude.length imgs' `shouldBe` Prelude.length imgs + +genNonEmptyImagesWithGifDelay :: + forall cs e. (Storable (Color cs e), Arbitrary (Pixel cs e)) + => Gen (NonEmpty (GifDelay, Image S cs e)) +genNonEmptyImagesWithGifDelay = do + arrs <- toSameSizeNE <$> (arbitrary :: Gen (ArrNE D Ix3 (Pixel cs e))) + Prelude.mapM (\i -> (,) <$> arbitrary <*> pure (compute i)) arrs + +toSameSizeNE :: OuterSlice r ix e => ArrNE r ix e -> NonEmpty (Elt r ix e) +toSameSizeNE (ArrNE arr) = (arr !>) <$> (0 :| [1 .. unSz (fst (unconsSz (size arr))) - 1]) diff --git a/tests/Test/Massiv/Array/IO/Image/JuicyPixelsSpec.hs b/tests/Test/Massiv/Array/IO/Image/JuicyPixelsSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Massiv/Array/IO/Image/JuicyPixelsSpec.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +module Test.Massiv.Array.IO.Image.JuicyPixelsSpec (spec) where + +import Data.Massiv.Array.IO hiding (showsType) +import Test.Massiv.Core +import Test.Massiv.Array.IO.Image.Common + +spec :: Spec +spec = + describe "Readable/Writable" $ do + describe "BMP" $ do + specEncodeNoError @Y' @Word8 BMP + specEncodeNoError @(Y D65) @Word8 BMP + --specEncodeDecodeNoError @(Y D65) @Word8 BMP + specEncodeDecodeNoError @SRGB @Word8 BMP + specEncodeDecodeNoError @(Alpha SRGB) @Word8 BMP + describe "GIF" $ do + specEncodeNoError @Y' @Word8 GIF + specEncodeNoError @(Y D65) @Word8 GIF + specEncodeDecodeNoError @SRGB @Word8 GIF + --specEncodeGifSequenceNoError @(Y D65) @Word8 + describe "Sequenece" $ do + specEncodeDecodeGifSequenceNoError @SRGB @Word8 + specEncodeDecodeGifSequenceNoError @(Alpha SRGB) @Word8 + -- TODO: read RGBA8, write Y8 + -- getting 'DecodeError "Invalid sanline size"' with seed=2023820902 + -- describe "HDR" $ do + -- specEncodeDecodeNoError @SRGB @Float HDR + describe "JPG" $ do + specEncodeDecodeNoError @Y' @Word8 JPG + specEncodeDecodeNoError @(Y D65) @Word8 JPG + specEncodeDecodeNoError @SRGB @Word8 JPG + specEncodeDecodeNoError @(CMYK SRGB) @Word8 JPG + specEncodeDecodeNoError @(YCbCr SRGB) @Word8 JPG + -- TODO: read YA8 + describe "PNG" $ do + specEncodeDecodeNoError @Y' @Word8 PNG + specEncodeDecodeNoError @Y' @Word16 PNG + specEncodeDecodeNoError @(Alpha Y') @Word8 PNG + specEncodeDecodeNoError @(Alpha Y') @Word16 PNG + specEncodeDecodeNoError @(Y D65) @Word8 PNG + specEncodeDecodeNoError @(Y D65) @Word16 PNG + specEncodeDecodeNoError @(Alpha (Y D65)) @Word8 PNG + specEncodeDecodeNoError @(Alpha (Y D65)) @Word16 PNG + specEncodeDecodeNoError @SRGB @Word8 PNG + specEncodeDecodeNoError @SRGB @Word16 PNG + specEncodeDecodeNoError @(Alpha SRGB) @Word8 PNG + specEncodeDecodeNoError @(Alpha SRGB) @Word16 PNG + describe "TGA" $ do + specEncodeDecodeNoError @Y' @Word8 TGA + specEncodeDecodeNoError @(Y D65) @Word8 TGA + specEncodeDecodeNoError @SRGB @Word8 TGA + specEncodeDecodeNoError @(Alpha SRGB) @Word8 TGA + describe "TIF" $ do + specEncodeDecodeNoError @Y' @Word8 TIF + specEncodeDecodeNoError @Y' @Word16 TIF + specEncodeDecodeNoError @Y' @Word32 TIF + specEncodeDecodeNoError @Y' @Float TIF + specEncodeDecodeNoError @(Y D65) @Word8 TIF + specEncodeDecodeNoError @(Y D65) @Word16 TIF + specEncodeDecodeNoError @(Y D65) @Word32 TIF + specEncodeDecodeNoError @(Y D65) @Float TIF + specEncodeDecodeNoError @(Alpha Y') @Word8 TIF + specEncodeDecodeNoError @(Alpha Y') @Word16 TIF + specEncodeDecodeNoError @(Alpha (Y D65)) @Word8 TIF + specEncodeDecodeNoError @(Alpha (Y D65)) @Word16 TIF + specEncodeDecodeNoError @SRGB @Word8 TIF + specEncodeDecodeNoError @SRGB @Word16 TIF + specEncodeDecodeNoError @(Alpha SRGB) @Word8 TIF + specEncodeDecodeNoError @(Alpha SRGB) @Word16 TIF + specEncodeDecodeNoError @(CMYK SRGB) @Word8 TIF + specEncodeDecodeNoError @(CMYK SRGB) @Word16 TIF + specEncodeNoError @(YCbCr SRGB) @Word8 TIF