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 +9/−0
- LICENSE +19/−20
- README.md +15/−1
- massiv-io.cabal +9/−7
- src/Data/Massiv/Array/IO.hs +13/−9
- src/Data/Massiv/Array/IO/Base.hs +75/−5
- src/Data/Massiv/Array/IO/Image.hs +20/−19
- src/Data/Massiv/Array/IO/Image/JuicyPixels.hs +1/−0
- src/Data/Massiv/Array/IO/Image/JuicyPixels/BMP.hs +12/−10
- src/Data/Massiv/Array/IO/Image/JuicyPixels/Base.hs +362/−54
- src/Data/Massiv/Array/IO/Image/JuicyPixels/GIF.hs +63/−12
- src/Data/Massiv/Array/IO/Image/JuicyPixels/HDR.hs +5/−6
- src/Data/Massiv/Array/IO/Image/JuicyPixels/JPG.hs +15/−15
- src/Data/Massiv/Array/IO/Image/JuicyPixels/PNG.hs +38/−28
- src/Data/Massiv/Array/IO/Image/JuicyPixels/TGA.hs +16/−15
- src/Data/Massiv/Array/IO/Image/JuicyPixels/TIF.hs +59/−42
- src/Data/Massiv/Array/IO/Image/Netpbm.hs +9/−3
- tests/Data/Massiv/Array/IOSpec.hs +0/−303
- tests/Test/Massiv/Array/IO/Image/AutoSpec.hs +153/−0
- tests/Test/Massiv/Array/IO/Image/Common.hs +125/−0
- tests/Test/Massiv/Array/IO/Image/JuicyPixelsSpec.hs +77/−0
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 |+|:--------:|:------:|:--------:|:---------:|:--------:|+|  | [](https://travis-ci.org/lehins/massiv-io) | [](https://ci.appveyor.com/project/lehins/massiv-io/branch/master) | [](https://coveralls.io/github/lehins/massiv-io?branch=master) | [](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)| [](https://hackage.haskell.org/package/massiv-io)| [](https://www.stackage.org/nightly/package/massiv-io)| [](https://www.stackage.org/lts/package/massiv-io)|+| [`massiv`](https://github.com/lehins/massiv/tree/master/massiv)| [](https://hackage.haskell.org/package/massiv)| [](https://www.stackage.org/nightly/package/massiv)| [](https://www.stackage.org/lts/package/massiv)|+| [`Color`](https://github.com/lehins/Color/tree/master/Color)| [](https://hackage.haskell.org/package/Color)| [](https://www.stackage.org/nightly/package/Color)| [](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