packages feed

massiv-io 0.2.0.0 → 0.2.1.0

raw patch · 21 files changed

+1095/−549 lines, 21 filesdep ~Colordep ~JuicyPixelsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: Color, JuicyPixels

API changes (from Hackage documentation)

+ Data.Massiv.Array.IO: DisposalAny :: GifDisposalMethod
+ Data.Massiv.Array.IO: DisposalDoNot :: GifDisposalMethod
+ Data.Massiv.Array.IO: DisposalRestoreBackground :: GifDisposalMethod
+ Data.Massiv.Array.IO: DisposalRestorePrevious :: GifDisposalMethod
+ Data.Massiv.Array.IO: DisposalUnknown :: Word8 -> GifDisposalMethod
+ Data.Massiv.Array.IO: data GifDisposalMethod
+ Data.Massiv.Array.IO: demoteLumaAlphaImage :: Array S Ix2 (Pixel (Alpha Y') e) -> Array S Ix2 (Pixel (Alpha Y) e)
+ Data.Massiv.Array.IO: demoteLumaImage :: Array S Ix2 (Pixel Y' e) -> Array S Ix2 (Pixel Y e)
+ Data.Massiv.Array.IO: fromDynamicImageM :: forall cs e m. (ColorModel cs e, MonadThrow m) => DynamicImage -> m (Maybe (Image S cs e))
+ Data.Massiv.Array.IO: promoteLumaAlphaImage :: Array S Ix2 (Pixel (Alpha Y) e) -> Array S Ix2 (Pixel (Alpha Y') e)
+ Data.Massiv.Array.IO: promoteLumaImage :: Array S Ix2 (Pixel Y e) -> Array S Ix2 (Pixel Y' e)
- Data.Massiv.Array.IO: encodeBMP :: forall r cs e m. (ColorModel cs e, Source r Ix2 (Pixel cs e), MonadThrow m) => BMP -> BitmapOptions -> Image r cs e -> m ByteString
+ Data.Massiv.Array.IO: encodeBMP :: forall cs e m. (ColorModel cs e, MonadThrow m) => BMP -> BitmapOptions -> Image S cs e -> m ByteString
- Data.Massiv.Array.IO: encodeGIF :: forall r cs e m. (ColorModel cs e, Source r Ix2 (Pixel cs e), MonadThrow m) => GIF -> GifOptions -> Image r cs e -> m ByteString
+ Data.Massiv.Array.IO: encodeGIF :: forall cs e m. (ColorModel cs e, MonadThrow m) => GIF -> GifOptions -> Image S cs e -> m ByteString
- Data.Massiv.Array.IO: encodeHDR :: forall r cs e m. (ColorModel cs e, Source r Ix2 (Pixel cs e), MonadThrow m) => HDR -> HdrOptions -> Image r cs e -> m ByteString
+ Data.Massiv.Array.IO: encodeHDR :: forall cs e m. (ColorModel cs e, MonadThrow m) => HDR -> HdrOptions -> Image S cs e -> m ByteString
- Data.Massiv.Array.IO: encodeJPG :: forall r cs e m. (ColorModel cs e, Source r Ix2 (Pixel cs e), MonadThrow m) => JPG -> JpegOptions -> Image r cs e -> m ByteString
+ Data.Massiv.Array.IO: encodeJPG :: forall cs e m. (ColorModel cs e, MonadThrow m) => JPG -> JpegOptions -> Image S cs e -> m ByteString
- Data.Massiv.Array.IO: encodePNG :: forall r cs e m. (ColorModel cs e, Source r Ix2 (Pixel cs e), MonadThrow m) => PNG -> Image r cs e -> m ByteString
+ Data.Massiv.Array.IO: encodePNG :: forall cs e m. (ColorModel cs e, MonadThrow m) => PNG -> Image S cs e -> m ByteString
- Data.Massiv.Array.IO: encodeTGA :: forall r cs e m. (ColorModel cs e, Source r Ix2 (Pixel cs e), MonadThrow m) => TGA -> Image r cs e -> m ByteString
+ Data.Massiv.Array.IO: encodeTGA :: forall cs e m. (ColorModel cs e, MonadThrow m) => TGA -> Image S cs e -> m ByteString
- Data.Massiv.Array.IO: encodeTIF :: forall r cs e m. (ColorModel cs e, Source r Ix2 (Pixel cs e), MonadThrow m) => TIF -> Image r cs e -> m ByteString
+ Data.Massiv.Array.IO: encodeTIF :: forall cs e m. (ColorModel cs e, MonadThrow m) => TIF -> Image S cs e -> m ByteString
- Data.Massiv.Array.IO: fromDynamicImageAuto :: forall r cs i e. (Mutable r Ix2 (Pixel cs e), ColorSpace cs i e) => DynamicImage -> Maybe (Image r cs e)
+ Data.Massiv.Array.IO: fromDynamicImageAuto :: forall r cs i e m. (Mutable r Ix2 (Pixel cs e), ColorSpace cs i e, MonadThrow m) => DynamicImage -> m (Image r cs e)
- Data.Massiv.Array.IO: imageReadFormats :: ColorSpace cs i e => [Decode (Image S cs e)]
+ Data.Massiv.Array.IO: imageReadFormats :: ColorModel cs e => [Decode (Image S cs e)]
- Data.Massiv.Array.IO: imageWriteFormats :: (Source r Ix2 (Pixel cs e), ColorSpace cs i e) => [Encode (Image r cs e)]
+ Data.Massiv.Array.IO: imageWriteFormats :: (Source r Ix2 (Pixel cs e), ColorModel cs e) => [Encode (Image r cs e)]
- Data.Massiv.Array.IO: readImage :: (ColorSpace cs i e, MonadIO m) => FilePath -> m (Image S cs e)
+ Data.Massiv.Array.IO: readImage :: (ColorModel cs e, MonadIO m) => FilePath -> m (Image S cs e)
- Data.Massiv.Array.IO: writeImage :: (Source r Ix2 (Pixel cs e), ColorSpace cs i e, MonadIO m) => FilePath -> Image r cs e -> m ()
+ Data.Massiv.Array.IO: writeImage :: (Source r Ix2 (Pixel cs e), ColorModel cs e, MonadIO m) => FilePath -> Image r cs e -> m ()

Files

CHANGELOG.md view
@@ -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`
LICENSE view
@@ -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.
README.md view
@@ -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)|
massiv-io.cabal view
@@ -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
src/Data/Massiv/Array/IO.hs view
@@ -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 <Image S YCbCr Word8> as <Image S RGB Word8>"+-- *** Exception: ConvertError "Cannot decode JPG image <Image S YCbCr Word8> as <Image S SRGB Word8>" -- -- 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)  
src/Data/Massiv/Array/IO/Base.hs view
@@ -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
src/Data/Massiv/Array/IO/Image.hs view
@@ -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
src/Data/Massiv/Array/IO/Image/JuicyPixels.hs view
@@ -38,6 +38,7 @@   , toJPImageCMYK8   , toJPImageCMYK16   , fromDynamicImage+  , fromDynamicImageM   , fromDynamicImageAuto   ) where 
src/Data/Massiv/Array/IO/Image/JuicyPixels/BMP.hs view
@@ -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       ]  
src/Data/Massiv/Array/IO/Image/JuicyPixels/Base.hs view
@@ -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 
src/Data/Massiv/Array/IO/Image/JuicyPixels/GIF.hs view
@@ -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
src/Data/Massiv/Array/IO/Image/JuicyPixels/HDR.hs view
@@ -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   
src/Data/Massiv/Array/IO/Image/JuicyPixels/JPG.hs view
@@ -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       ]  
src/Data/Massiv/Array/IO/Image/JuicyPixels/PNG.hs view
@@ -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]            ]     ] 
src/Data/Massiv/Array/IO/Image/JuicyPixels/TGA.hs view
@@ -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 ::
src/Data/Massiv/Array/IO/Image/JuicyPixels/TIF.hs view
@@ -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     ]  
src/Data/Massiv/Array/IO/Image/Netpbm.hs view
@@ -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
− tests/Data/Massiv/Array/IOSpec.hs
@@ -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
+ tests/Test/Massiv/Array/IO/Image/AutoSpec.hs view
@@ -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
+ tests/Test/Massiv/Array/IO/Image/Common.hs view
@@ -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])
+ tests/Test/Massiv/Array/IO/Image/JuicyPixelsSpec.hs view
@@ -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