massiv-io 1.0.0.0 → 1.0.0.1
raw patch · 19 files changed
+340/−60 lines, 19 filesdep +criteriondep −template-haskelldep ~Colordep ~basedep ~massivPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: criterion
Dependencies removed: template-haskell
Dependency ranges changed: Color, base, massiv
API changes (from Hackage documentation)
- Data.Massiv.Array.IO: decode' :: Readable f arr => f -> ByteString -> arr
+ Data.Massiv.Array.IO: decode' :: (Readable f arr, HasCallStack) => f -> ByteString -> arr
- Data.Massiv.Array.IO: encode' :: Writable f arr => f -> WriteOptions f -> arr -> ByteString
+ Data.Massiv.Array.IO: encode' :: (Writable f arr, HasCallStack) => f -> WriteOptions f -> arr -> ByteString
Files
- CHANGELOG.md +4/−0
- LICENSE +1/−1
- README.md +3/−3
- bench/Convert.hs +95/−0
- massiv-io.cabal +16/−3
- src/Data/Massiv/Array/IO.hs +3/−1
- src/Data/Massiv/Array/IO/Base.hs +24/−7
- src/Data/Massiv/Array/IO/Image.hs +11/−4
- src/Data/Massiv/Array/IO/Image/JuicyPixels.hs +1/−1
- src/Data/Massiv/Array/IO/Image/JuicyPixels/BMP.hs +19/−3
- src/Data/Massiv/Array/IO/Image/JuicyPixels/Base.hs +17/−17
- src/Data/Massiv/Array/IO/Image/JuicyPixels/GIF.hs +19/−4
- src/Data/Massiv/Array/IO/Image/JuicyPixels/HDR.hs +9/−2
- src/Data/Massiv/Array/IO/Image/JuicyPixels/JPG.hs +22/−3
- src/Data/Massiv/Array/IO/Image/JuicyPixels/PNG.hs +31/−3
- src/Data/Massiv/Array/IO/Image/JuicyPixels/TGA.hs +16/−3
- src/Data/Massiv/Array/IO/Image/JuicyPixels/TIF.hs +43/−3
- src/Data/Massiv/Array/IO/Image/Netpbm.hs +5/−1
- src/Graphics/ColorModel.hs +1/−1
CHANGELOG.md view
@@ -1,3 +1,7 @@+# 1.0.0++* Update to support `massiv-1.0`+ # 0.4.1 * Reexport `Default` class.
LICENSE view
@@ -1,6 +1,6 @@ BSD 3-Clause License -Copyright (c) 2013-2020, Alexey Kuleshevich+Copyright (c) 2013-2021, Alexey Kuleshevich All rights reserved. Redistribution and use in source and binary forms, with or without
README.md view
@@ -5,9 +5,9 @@ ## Status -| Language | Github Actions | Azure | Coveralls |Gitter.im |-|:--------:|:--------------:|:-----:|:---------:|:--------:|-|  | [](https://github.com/lehins/massiv-io/actions) | [](https://dev.azure.com/kuleshevich/massiv-io/_build?definitionId=1&branchName=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)+| Language | Github Actions | Coveralls |Gitter.im |+|:--------:|:--------------:|:---------:|:--------:|+|  | [](https://github.com/lehins/massiv-io/actions) | [](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 | |:-------------------|:-------:|:-------:|:---:|
+ bench/Convert.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Main where++import Criterion.Main+import Data.Massiv.Array as A+import Data.Massiv.Array.IO as A+import Data.ByteString as B+import Data.ByteString.Lazy as BL++encodeIO :: Writable f arr => f -> arr -> IO B.ByteString+encodeIO f img =+ BL.toStrict <$> encodeM f def img+{-# INLINE encodeIO #-}++benchDecode ::+ forall fr fw r cs e.+ ( Readable fr (Image S cs e)+ , Writable fw (Image S cs e)+ , Load r Ix2 (Pixel cs e)+ , ColorModel cs e+ )+ => String+ -> fr -- ^ Decode as+ -> fw -- ^ Encode as+ -> Image r cs e+ -> Benchmark+benchDecode name fr fw img =+ env (encodeIO fw (computeAs S img)) $ \bs ->+ bench name $ nfIO (decodeM fr bs :: IO (Image S cs e))+++convertIO ::+ forall cs' e' i' r cs e i. (Source r (Pixel cs e), ColorSpace cs i e, ColorSpace cs' i' e')+ => Image r cs e+ -> IO (Image S cs' e')+convertIO = computeIO . convertImage+{-# INLINE convertIO #-}++main :: IO ()+main = do+ !frog <- readImageAuto "files/frog.jpg" :: IO (Image S (SRGB 'NonLinear) Double)+ defaultMain+ [ bgroup "Convert" [bench "Y'CbCr" $ nfIO (convertIO frog :: IO (Image S (Y'CbCr SRGB) Double))]+ , bgroup+ "Encode"+ [ bgroup+ "PNG"+ [ bgroup+ "Exact"+ [ env (convertIO frog) $ \(f :: Image S (SRGB 'NonLinear) Word8) ->+ bench "SRGB Word8" $ nfIO (encodeIO PNG f)+ , env (convertIO frog) $ \(f :: Image S (SRGB 'NonLinear) Word16) ->+ bench "SRGB Word16" $ nfIO (encodeIO PNG f)+ ]+ , bgroup+ "Auto"+ [ env (convertIO frog) $ \(f :: Image S (SRGB 'NonLinear) Word8) ->+ bench "SRGB Word8" $ nfIO (encodeIO (Auto PNG) f)+ , env (convertIO frog) $ \(f :: Image S (SRGB 'NonLinear) Word16) ->+ bench "SRGB Word16" $ nfIO (encodeIO (Auto PNG) f)+ , env (convertIO frog) $ \(f :: Image S (SRGB 'NonLinear) Word32) ->+ bench "SRGB Word32" $ nfIO (encodeIO (Auto PNG) f)+ ]+ ]+ ]+ , bgroup+ "Decode"+ [ bgroup+ "PNG"+ [ bgroup+ "Exact"+ [ benchDecode "SRGB Word8" PNG PNG $+ (convertImage frog :: Image D (SRGB 'NonLinear) Word8)+ , benchDecode "SRGB Word16" PNG PNG $+ (convertImage frog :: Image D (SRGB 'NonLinear) Word16)+ ]+ , bgroup+ "Auto"+ [ benchDecode "SRGB Word8" (Auto PNG) PNG $+ (convertImage frog :: Image D (SRGB 'NonLinear) Word8)+ , benchDecode "SRGB Word16" (Auto PNG) PNG $+ (convertImage frog :: Image D (SRGB 'NonLinear) Word16)+ , env (encodeIO PNG =<< (convertIO frog :: IO (Image S (SRGB 'NonLinear) Word8))) $ \bs ->+ bench "SRGB Word8 -> Word16" $+ nfIO (decodeM (Auto PNG) bs :: IO (Image S (SRGB 'NonLinear) Word16))+ ]+ ]+ ]+ ]+
massiv-io.cabal view
@@ -1,5 +1,5 @@ name: massiv-io-version: 1.0.0.0+version: 1.0.0.1 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@@ -9,7 +9,7 @@ license-file: LICENSE author: Alexey Kuleshevich maintainer: alexey@kuleshevi.ch-copyright: 2018-2020 Alexey Kuleshevich+copyright: 2018-2021 Alexey Kuleshevich category: Data, Data Structures build-type: Simple extra-doc-files: files/*.jpg@@ -92,9 +92,22 @@ build-depends: base , doctest >=0.15 , QuickCheck- , template-haskell default-language: Haskell2010 +benchmark convert+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: Convert.hs+ ghc-options: -Wall -threaded -O2 -rtsopts -with-rtsopts=-N+ build-depends: base+ , bytestring+ , Color+ , criterion+ , massiv+ , massiv-io+ default-language: Haskell2010+ source-repository head type: git location: https://github.com/lehins/massiv-io+ subdir: massiv-io
src/Data/Massiv/Array/IO.hs view
@@ -6,7 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} -- | -- Module : Data.Massiv.Array.IO--- Copyright : (c) Alexey Kuleshevich 2018-2020+-- Copyright : (c) Alexey Kuleshevich 2018-2021 -- License : BSD3 -- Maintainer : Alexey Kuleshevich <lehins@yandex.ru> -- Stability : experimental@@ -228,6 +228,7 @@ writeImage :: (Source r (Pixel cs e), ColorModel cs e, MonadIO m) => FilePath -> Image r cs e -> m () writeImage path img = liftIO (encodeImageM imageWriteFormats path img >>= writeLazyAtomically path)+{-# INLINE writeImage #-} -- | Write an image encoded in sRGB color space into a file while performing all necessary@@ -249,6 +250,7 @@ -> m () writeImageAuto path img = liftIO (encodeImageM imageWriteAutoFormats path img >>= writeLazyAtomically path)+{-# INLINE writeImageAuto #-} -- | An image is written as a @.tiff@ file into an operating system's temporary
src/Data/Massiv/Array/IO/Base.hs view
@@ -31,6 +31,7 @@ , Auto(..) , Image , convertImage+ , convertImageM , toImageBaseModel , fromImageBaseModel , coerceBinaryImage@@ -46,7 +47,7 @@ , MonadThrow(..) ) where -import Control.Exception (Exception, throw)+import Control.Exception (Exception) import Control.Monad.Catch (MonadThrow(..)) import qualified Data.ByteString as B (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString)@@ -55,6 +56,7 @@ import qualified Data.Massiv.Array as A import Data.Typeable import qualified Data.Vector.Storable as V+import GHC.Stack import Graphics.Pixel as CM import Graphics.Pixel.ColorSpace import Prelude as P@@ -156,13 +158,13 @@ arr <- decodeM f bs pure (arr, ()) --- | Encode an array into a `BL.ByteString`.-encode' :: Writable f arr => f -> WriteOptions f -> arr -> BL.ByteString-encode' f opts = either throw id . encodeM f opts+-- | Encode an array into a lazy `BL.ByteString`.+encode' :: (Writable f arr, HasCallStack) => f -> WriteOptions f -> arr -> BL.ByteString+encode' f opts = A.throwEither . encodeM f opts --- | Decode a `B.ByteString` into an Array.-decode' :: Readable f arr => f -> B.ByteString -> arr-decode' f = either throw id . decodeM f+-- | Decode a strict `B.ByteString` into an Array.+decode' :: (Readable f arr, HasCallStack) => f -> B.ByteString -> arr+decode' f = A.throwEither . decodeM f -- | Arrays that can be written into a file.@@ -274,6 +276,21 @@ => Image r' cs' e' -> Image A.D cs e convertImage = A.map convertPixel+{-# INLINE convertImage #-}+++-- | Convert image to any supported color space and compute the resulting image+--+-- @since 1.0.1+convertImageM ::+ (ColorSpace cs' i' e', ColorSpace cs i e, A.Manifest r (Pixel cs e))+ => Image A.S cs' e'+ -> Image r cs e+convertImageM = A.compute . A.map convertPixel+{-# INLINE [1] convertImageM #-}+{-# RULES+ "convertImageM = id" convertImageM = id+#-} -- | Cast an array. This is theoretically unsafe operation, but for all currently -- available `ColorSpace` instances this function is perfectly safe.
src/Data/Massiv/Array/IO/Image.hs view
@@ -6,7 +6,7 @@ {-# LANGUAGE TypeApplications #-} -- | -- Module : Data.Massiv.Array.IO.Image--- Copyright : (c) Alexey Kuleshevich 2018-2020+-- Copyright : (c) Alexey Kuleshevich 2018-2021 -- License : BSD3 -- Maintainer : Alexey Kuleshevich <lehins@yandex.ru> -- Stability : experimental@@ -41,7 +41,6 @@ import Prelude as P - -- | Adhoc encoder data Encode out where -- | Provide a custom way to encode a particular file format. This is an alternative@@ -67,12 +66,14 @@ -- @since 0.4.1 encodeAdhocM :: MonadThrow m => Encode out -> out -> m BL.ByteString encodeAdhocM (Encode f enc) = enc f+{-# INLINE encodeAdhocM #-} -- | Utilize a Writable instance in order to construct an adhoc Encode type -- -- @since 0.4.1 writableAdhoc :: Writable f out => f -> Encode out writableAdhoc f = Encode f (`encodeM` def)+{-# INLINE writableAdhoc #-} -- | Encode an image into a lazy `BL.ByteString`, while selecting the appropriate format from the@@ -89,6 +90,7 @@ encodeImageM formats path img = do f <- selectFileFormat formats path encodeAdhocM f img+{-# INLINE encodeImageM #-} -- | List of image formats that can be encoded without any color space conversion.@@ -102,6 +104,7 @@ , Encode TGA (\ f -> encodeTGA f . computeSource @S) , Encode HDR (\ f -> encodeHDR f def . computeSource @S) ]+{-# INLINEABLE imageWriteFormats #-} -- | List of image formats that can be encoded with any necessary color space conversions. imageWriteAutoFormats ::@@ -116,6 +119,7 @@ , Encode (Auto HDR) (\f -> pure . encodeAutoHDR f def) , Encode (Auto TGA) (\f -> pure . encodeAutoTGA f) ]+{-# INLINEABLE imageWriteAutoFormats #-} -- | Adhoc decoder@@ -143,6 +147,7 @@ -- @since 0.4.1 decodeAdhocM :: MonadThrow m => Decode out -> B.ByteString -> m out decodeAdhocM (Decode f dec) = dec f+{-# INLINE decodeAdhocM #-} -- | Utilize a Readable instance in order to construct an adhoc Decode type@@ -150,6 +155,7 @@ -- @since 0.4.1 readableAdhoc :: Readable f out => f -> Decode out readableAdhoc f = Decode f decodeM+{-# INLINE readableAdhoc #-} -- | Decode an image from the strict `ByteString` while inferring format the image is encoded in@@ -165,6 +171,7 @@ decodeImageM formats path bs = do f <- selectFileFormat formats path decodeAdhocM f bs+{-# INLINE decodeImageM #-} -- | List of image formats decodable with no color space conversion imageReadFormats :: ColorModel cs e => [Decode (Image S cs e)]@@ -180,6 +187,7 @@ , Decode PGM (\f -> fmap fst . decodeNetpbmImage f) , Decode PPM (\f -> fmap fst . decodeNetpbmImage f) ]+{-# INLINEABLE imageReadFormats #-} -- | List of image formats decodable with automatic colorspace conversion imageReadAutoFormats@@ -197,5 +205,4 @@ , Decode (Auto PGM) (\f -> fmap fst . decodeAutoNetpbmImage f) , Decode (Auto PPM) (\f -> fmap fst . decodeAutoNetpbmImage f) ]--+{-# INLINEABLE imageReadAutoFormats #-}
src/Data/Massiv/Array/IO/Image/JuicyPixels.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Data.Massiv.Array.IO.Image.JuicyPixels--- Copyright : (c) Alexey Kuleshevich 2018-2020+-- Copyright : (c) Alexey Kuleshevich 2018-2021 -- License : BSD3 -- Maintainer : Alexey Kuleshevich <lehins@yandex.ru> -- Stability : experimental
src/Data/Massiv/Array/IO/Image/JuicyPixels/BMP.hs view
@@ -9,7 +9,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module : Data.Massiv.Array.IO.Image.JuicyPixels.BMP--- Copyright : (c) Alexey Kuleshevich 2019-2020+-- Copyright : (c) Alexey Kuleshevich 2019-2021 -- License : BSD3 -- Maintainer : Alexey Kuleshevich <lehins@yandex.ru> -- Stability : experimental@@ -118,12 +118,13 @@ -- | Decode a Bitmap Image decodeBMP :: (ColorModel cs e, MonadThrow m) => BMP -> B.ByteString -> m (Image S cs e) decodeBMP f bs = convertWith f (JP.decodeBitmap bs)+{-# INLINE decodeBMP #-} -- | Decode a Bitmap Image decodeWithMetadataBMP :: (ColorModel cs e, MonadThrow m) => BMP -> B.ByteString -> m (Image S cs e, JP.Metadatas) decodeWithMetadataBMP f bs = convertWithMetadata f (JP.decodeBitmapWithMetadata bs)-+{-# INLINE decodeWithMetadataBMP #-} -- | Decode a Bitmap Image decodeAutoBMP ::@@ -132,6 +133,7 @@ -> B.ByteString -> m (Image r cs e) decodeAutoBMP f bs = convertAutoWith f (JP.decodeBitmap bs)+{-# INLINE decodeAutoBMP #-} -- | Decode a Bitmap Image decodeAutoWithMetadataBMP ::@@ -140,6 +142,7 @@ -> B.ByteString -> m (Image r cs e, JP.Metadatas) decodeAutoWithMetadataBMP f bs = convertAutoWithMetadata f (JP.decodeBitmapWithMetadata bs)+{-# INLINE decodeAutoWithMetadataBMP #-} instance (Manifest r (Pixel cs e), ColorSpace cs i e) => Readable (Auto BMP) (Image r cs e) where@@ -178,7 +181,20 @@ encodeAutoBMP _ BitmapOptions {bitmapMetadata} img = fromMaybe (toBitmap toJPImageRGB8 toSRGB8 img) $ msum- [ do Refl <- eqT :: Maybe (BaseModel cs :~: CM.X)+ [ do Refl <- eqT :: Maybe (r :~: S)+ case eqT :: Maybe (e :~: Word8) of+ Just Refl+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.X)) ->+ pure $+ JP.encodeBitmapWithMetadata bitmapMetadata $ toJPImageY8 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.RGB)) ->+ pure $+ JP.encodeBitmapWithMetadata bitmapMetadata $ toJPImageRGB8 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: Alpha CM.RGB)) ->+ pure $+ JP.encodeBitmapWithMetadata bitmapMetadata $ toJPImageRGBA8 (toImageBaseModel img)+ _ -> Nothing+ , do Refl <- eqT :: Maybe (BaseModel cs :~: CM.X) msum [ do Refl <- eqT :: Maybe (e :~: Bit) pure $ toBitmap toJPImageY8 (toPixel8 . toPixelBaseModel) img
src/Data/Massiv/Array/IO/Image/JuicyPixels/Base.hs view
@@ -10,7 +10,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module : Data.Massiv.Array.IO.Image.JuicyPixels.Base--- Copyright : (c) Alexey Kuleshevich 2019-2020+-- Copyright : (c) Alexey Kuleshevich 2019-2021 -- License : BSD3 -- Maintainer : Alexey Kuleshevich <lehins@yandex.ru> -- Stability : experimental@@ -119,7 +119,7 @@ -> Either String JP.DynamicImage -> m (Image r cs e) convertAutoWith _ = either (throwM . DecodeError) fromDynamicImageAuto-+{-# INLINE convertAutoWith #-} convertSequenceWith :: (MonadThrow m, ColorModel cs e, FileFormat (Sequence f))@@ -289,39 +289,39 @@ fromDynamicImageAuto jpDynImg = case jpDynImg of JP.ImageY8 jimg ->- compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (Y D65) Word8))+ convertImageM <$> (fromJPImageUnsafeM jimg :: m (Image S (Y D65) Word8)) JP.ImageY16 jimg ->- compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (Y D65) Word16))+ convertImageM <$> (fromJPImageUnsafeM jimg :: m (Image S (Y D65) Word16)) JP.ImageY32 jimg ->- compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (Y D65) Word32))+ convertImageM <$> (fromJPImageUnsafeM jimg :: m (Image S (Y D65) Word32)) JP.ImageYF jimg ->- compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (Y D65) Float))+ convertImageM <$> (fromJPImageUnsafeM jimg :: m (Image S (Y D65) Float)) JP.ImageYA8 jimg ->- compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (Alpha (Y D65)) Word8))+ convertImageM <$> (fromJPImageUnsafeM jimg :: m (Image S (Alpha (Y D65)) Word8)) JP.ImageYA16 jimg ->- compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (Alpha (Y D65)) Word16))+ convertImageM <$> (fromJPImageUnsafeM jimg :: m (Image S (Alpha (Y D65)) Word16)) JP.ImageRGB8 jimg ->- compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (SRGB 'NonLinear) Word8))+ convertImageM <$> (fromJPImageUnsafeM jimg :: m (Image S (SRGB 'NonLinear) Word8)) JP.ImageRGB16 jimg ->- compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (SRGB 'NonLinear) Word16))+ convertImageM <$> (fromJPImageUnsafeM jimg :: m (Image S (SRGB 'NonLinear) Word16)) JP.ImageRGBF jimg ->- compute . convertImage <$> (fromJPImageUnsafeM jimg :: m (Image S (SRGB 'NonLinear) Float))+ convertImageM <$> (fromJPImageUnsafeM jimg :: m (Image S (SRGB 'NonLinear) Float)) JP.ImageRGBA8 jimg ->- compute . convertImage <$>+ convertImageM <$> (fromJPImageUnsafeM jimg :: m (Image S (Alpha (SRGB 'NonLinear)) Word8)) JP.ImageRGBA16 jimg ->- compute . convertImage <$>+ convertImageM <$> (fromJPImageUnsafeM jimg :: m (Image S (Alpha (SRGB 'NonLinear)) Word16)) JP.ImageYCbCr8 jimg ->- compute . convertImage <$>+ convertImageM <$> (fromJPImageUnsafeM jimg :: m (Image S (Y'CbCr SRGB) Word8)) JP.ImageCMYK8 jimg ->- compute . convertImage <$>+ convertImageM <$> (fromJPImageUnsafeM jimg :: m (Image S (CMYK (SRGB 'NonLinear)) Word8)) JP.ImageCMYK16 jimg ->- compute . convertImage <$>+ convertImageM <$> (fromJPImageUnsafeM jimg :: m (Image S (CMYK (SRGB 'NonLinear)) Word16))-+{-# INLINE fromDynamicImageAuto #-} showJP :: JP.DynamicImage -> String
src/Data/Massiv/Array/IO/Image/JuicyPixels/GIF.hs view
@@ -10,7 +10,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module : Data.Massiv.Array.IO.Image.JuicyPixels.GIF--- Copyright : (c) Alexey Kuleshevich 2019-2020+-- Copyright : (c) Alexey Kuleshevich 2019-2021 -- License : BSD3 -- Maintainer : Alexey Kuleshevich <lehins@yandex.ru> -- Stability : experimental@@ -43,9 +43,11 @@ import qualified Codec.Picture.ColorQuant as JP import qualified Codec.Picture.Gif as JP import qualified Codec.Picture.Metadata as JP+import Control.Monad (msum) import Data.Bifunctor (first) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL (ByteString)+import Data.List.NonEmpty as NE import Data.Massiv.Array as A import Data.Massiv.Array.IO.Base import Data.Massiv.Array.IO.Image.JuicyPixels.Base@@ -53,7 +55,6 @@ import qualified Graphics.Pixel as CM import Graphics.Pixel.ColorSpace import Prelude as P-import Data.List.NonEmpty as NE -------------------------------------------------------------------------------- -- GIF Format ------------------------------------------------------------------@@ -127,11 +128,13 @@ -- | Decode a Gif Image decodeGIF :: (ColorModel cs e, MonadThrow m) => GIF -> B.ByteString -> m (Image S cs e) decodeGIF f bs = convertWith f (JP.decodeGif bs)+{-# INLINE decodeGIF #-} -- | Decode a Gif Image decodeWithMetadataGIF :: (ColorModel cs e, MonadThrow m) => GIF -> B.ByteString -> m (Image S cs e, JP.Metadatas) decodeWithMetadataGIF f bs = convertWithMetadata f (JP.decodeGifWithMetadata bs)+{-# INLINE decodeWithMetadataGIF #-} -- | Decode a Gif Image@@ -141,6 +144,7 @@ -> B.ByteString -> m (Image r cs e) decodeAutoGIF f bs = convertAutoWith f (JP.decodeGif bs)+{-# INLINE decodeAutoGIF #-} -- | Decode a Gif Image decodeAutoWithMetadataGIF ::@@ -149,6 +153,7 @@ -> B.ByteString -> m (Image r cs e, JP.Metadatas) decodeAutoWithMetadataGIF f bs = convertAutoWithMetadata f (JP.decodeGifWithMetadata bs)+{-# INLINE decodeAutoWithMetadataGIF #-} instance (Manifest r (Pixel cs e), ColorSpace cs i e) =>@@ -190,8 +195,18 @@ -> m BL.ByteString encodeAutoGIF _ opts img = fallbackEncodePalettizedRGB $ do- Refl <- eqT :: Maybe (BaseModel cs :~: CM.X)- pure $ JP.encodeGifImage $ toJPImageY8 $ A.map (toPixel8 . toPixelBaseModel) img+ msum+ [ do Refl <- eqT :: Maybe (r :~: S)+ case eqT :: Maybe (e :~: Word8) of+ Just Refl+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.X)) ->+ pure $ JP.encodeGifImage $ toJPImageY8 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.RGB)) ->+ encodePalettizedRGB opts (toImageBaseModel img)+ _ -> Nothing+ , do Refl <- eqT :: Maybe (BaseModel cs :~: CM.X)+ pure $ JP.encodeGifImage $ toJPImageY8 $ A.map (toPixel8 . toPixelBaseModel) img+ ] where fallbackEncodePalettizedRGB = \case
src/Data/Massiv/Array/IO/Image/JuicyPixels/HDR.hs view
@@ -9,7 +9,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module : Data.Massiv.Array.IO.Image.JuicyPixels.HDR--- Copyright : (c) Alexey Kuleshevich 2019-2020+-- Copyright : (c) Alexey Kuleshevich 2019-2021 -- License : BSD3 -- Maintainer : Alexey Kuleshevich <lehins@yandex.ru> -- Stability : experimental@@ -89,11 +89,13 @@ -- | Decode a HDR Image decodeHDR :: (ColorModel cs e, MonadThrow m) => HDR -> B.ByteString -> m (Image S cs e) decodeHDR f bs = convertWith f (JP.decodeHDR bs)+{-# INLINE decodeHDR #-} -- | Decode a HDR Image decodeWithMetadataHDR :: (ColorModel cs e, MonadThrow m) => HDR -> B.ByteString -> m (Image S cs e, JP.Metadatas) decodeWithMetadataHDR f bs = convertWithMetadata f (JP.decodeHDRWithMetadata bs)+{-# INLINE decodeWithMetadataHDR #-} -- | Decode a HDR Image@@ -103,6 +105,7 @@ -> B.ByteString -> m (Image r cs e) decodeAutoHDR f bs = convertAutoWith f (JP.decodeHDR bs)+{-# INLINE decodeAutoHDR #-} -- | Decode a HDR Image decodeAutoWithMetadataHDR ::@@ -111,6 +114,7 @@ -> B.ByteString -> m (Image r cs e, JP.Metadatas) decodeAutoWithMetadataHDR f bs = convertAutoWithMetadata f (JP.decodeHDRWithMetadata bs)+{-# INLINE decodeAutoWithMetadataHDR #-} instance (Manifest r (Pixel cs e), ColorSpace cs i e) => Readable (Auto HDR) (Image r cs e) where@@ -137,7 +141,10 @@ -> HdrOptions -> Image r cs e -> BL.ByteString-encodeAutoHDR _ opts = toHdr (toPixelBaseModel . toSRGBF)+encodeAutoHDR _ opts img=+ case eqT :: Maybe (Image r cs e :~: Image S (SRGB 'NonLinear) Float) of+ Just Refl -> getHdrEncoder opts $ toJPImageRGBF (toImageBaseModel img)+ Nothing -> toHdr (toPixelBaseModel . toSRGBF) img where toSRGBF = convertPixel :: Pixel cs e -> Pixel (SRGB 'NonLinear) Float toHdr :: Source r a => (a -> Pixel CM.RGB Float) -> Array r Ix2 a -> BL.ByteString
src/Data/Massiv/Array/IO/Image/JuicyPixels/JPG.hs view
@@ -9,7 +9,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module : Data.Massiv.Array.IO.Image.JuicyPixels.JPG--- Copyright : (c) Alexey Kuleshevich 2019-2020+-- Copyright : (c) Alexey Kuleshevich 2019-2021 -- License : BSD3 -- Maintainer : Alexey Kuleshevich <lehins@yandex.ru> -- Stability : experimental@@ -146,12 +146,13 @@ -- | Decode a Jpeg Image decodeJPG :: (ColorModel cs e, MonadThrow m) => JPG -> B.ByteString -> m (Image S cs e) decodeJPG f bs = convertWith f (JP.decodeJpeg bs)+{-# INLINE decodeJPG #-} -- | Decode a Jpeg Image decodeWithMetadataJPG :: (ColorModel cs e, MonadThrow m) => JPG -> B.ByteString -> m (Image S cs e, JP.Metadatas) decodeWithMetadataJPG f bs = convertWithMetadata f (JP.decodeJpegWithMetadata bs)-+{-# INLINE decodeWithMetadataJPG #-} -- | Decode a Jpeg Image decodeAutoJPG ::@@ -160,6 +161,7 @@ -> B.ByteString -> m (Image r cs e) decodeAutoJPG f bs = convertAutoWith f (JP.decodeJpeg bs)+{-# INLINE decodeAutoJPG #-} -- | Decode a Jpeg Image decodeAutoWithMetadataJPG ::@@ -168,6 +170,7 @@ -> B.ByteString -> m (Image r cs e, JP.Metadatas) decodeAutoWithMetadataJPG f bs = convertAutoWithMetadata f (JP.decodeJpegWithMetadata bs)+{-# INLINE decodeAutoWithMetadataJPG #-} instance (Manifest r (Pixel cs e), ColorSpace cs i e) => Readable (Auto JPG) (Image r cs e) where@@ -207,7 +210,23 @@ encodeAutoJPG _ JpegOptions {jpegQuality, jpegMetadata} img = fromMaybe (toJpeg toJPImageYCbCr8 toYCbCr8 img) $ msum- [ do Refl <- eqT :: Maybe (BaseModel cs :~: CM.X)+ [ do Refl <- eqT :: Maybe (r :~: S)+ case eqT :: Maybe (e :~: Word8) of+ Just Refl+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.X)) ->+ pure $+ JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata $+ toJPImageY8 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.RGB)) ->+ pure $+ JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata $+ toJPImageRGB8 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.YCbCr)) ->+ pure $+ JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata $+ toJPImageYCbCr8 (toImageBaseModel img)+ _ -> Nothing+ , do Refl <- eqT :: Maybe (BaseModel cs :~: CM.X) msum [ do Refl <- eqT :: Maybe (e :~: Bit) pure $ toJpeg toJPImageY8 (toPixel8 . toPixelBaseModel) img
src/Data/Massiv/Array/IO/Image/JuicyPixels/PNG.hs view
@@ -8,7 +8,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module : Data.Massiv.Array.IO.Image.JuicyPixels.PNG--- Copyright : (c) Alexey Kuleshevich 2019-2020+-- Copyright : (c) Alexey Kuleshevich 2019-2021 -- License : BSD3 -- Maintainer : Alexey Kuleshevich <lehins@yandex.ru> -- Stability : experimental@@ -185,12 +185,13 @@ -- | Decode a Png Image decodePNG :: (ColorModel cs e, MonadThrow m) => PNG -> B.ByteString -> m (Image S cs e) decodePNG f bs = convertWith f (JP.decodePng bs)+{-# INLINE decodePNG #-} -- | Decode a Png Image decodeWithMetadataPNG :: (ColorModel cs e, MonadThrow m) => PNG -> B.ByteString -> m (Image S cs e, JP.Metadatas) decodeWithMetadataPNG f bs = convertWithMetadata f (JP.decodePngWithMetadata bs)-+{-# INLINE decodeWithMetadataPNG #-} -- | Decode a Png Image decodeAutoPNG ::@@ -199,6 +200,7 @@ -> B.ByteString -> m (Image r cs e) decodeAutoPNG f bs = convertAutoWith f (JP.decodePng bs)+{-# INLINE decodeAutoPNG #-} -- | Decode a Png Image decodeAutoWithMetadataPNG ::@@ -207,6 +209,7 @@ -> B.ByteString -> m (Image r cs e, JP.Metadatas) decodeAutoWithMetadataPNG f bs = convertAutoWithMetadata f (JP.decodePngWithMetadata bs)+{-# INLINE decodeAutoWithMetadataPNG #-} instance (Manifest r (Pixel cs e), ColorSpace cs i e) => Readable (Auto PNG) (Image r cs e) where@@ -247,7 +250,32 @@ encodeAutoPNG _ img = fromMaybe (toPng toJPImageRGB16 toSRGB16 img) $ msum- [ do Refl <- eqT :: Maybe (BaseModel cs :~: CM.X)+ [ do Refl <- eqT :: Maybe (r :~: S)+ msum+ [ case eqT :: Maybe (e :~: Word8) of+ Just Refl+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.X)) ->+ pure $ JP.encodePng $ toJPImageY8 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.RGB)) ->+ pure $ JP.encodePng $ toJPImageRGB8 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: Alpha CM.X)) ->+ pure $ JP.encodePng $ toJPImageYA8 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: Alpha CM.RGB)) ->+ pure $ JP.encodePng $ toJPImageRGBA8 (toImageBaseModel img)+ _ -> Nothing+ , case eqT :: Maybe (e :~: Word16) of+ Just Refl+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.X)) ->+ pure $ JP.encodePng $ toJPImageY16 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.RGB)) ->+ pure $ JP.encodePng $ toJPImageRGB16 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: Alpha CM.X)) ->+ pure $ JP.encodePng $ toJPImageYA16 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: Alpha CM.RGB)) ->+ pure $ JP.encodePng $ toJPImageRGBA16 (toImageBaseModel img)+ _ -> Nothing+ ]+ , do Refl <- eqT :: Maybe (BaseModel cs :~: CM.X) msum [ do Refl <- eqT :: Maybe (e :~: Bit) pure $ toPng toJPImageY8 (toPixel8 . toPixelBaseModel) img
src/Data/Massiv/Array/IO/Image/JuicyPixels/TGA.hs view
@@ -8,7 +8,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module : Data.Massiv.Array.IO.Image.JuicyPixels.TGA--- Copyright : (c) Alexey Kuleshevich 2019-2020+-- Copyright : (c) Alexey Kuleshevich 2019-2021 -- License : BSD3 -- Maintainer : Alexey Kuleshevich <lehins@yandex.ru> -- Stability : experimental@@ -109,12 +109,13 @@ -- | Decode a Tga Image decodeTGA :: (ColorModel cs e, MonadThrow m) => TGA -> B.ByteString -> m (Image S cs e) decodeTGA f bs = convertWith f (JP.decodeTga bs)+{-# INLINE decodeTGA #-} -- | Decode a Tga Image decodeWithMetadataTGA :: (ColorModel cs e, MonadThrow m) => TGA -> B.ByteString -> m (Image S cs e, JP.Metadatas) decodeWithMetadataTGA f bs = convertWithMetadata f (JP.decodeTgaWithMetadata bs)-+{-# INLINE decodeWithMetadataTGA #-} -- | Decode a Tga Image decodeAutoTGA ::@@ -123,6 +124,7 @@ -> B.ByteString -> m (Image r cs e) decodeAutoTGA f bs = convertAutoWith f (JP.decodeTga bs)+{-# INLINE decodeAutoTGA #-} -- | Decode a Tga Image decodeAutoWithMetadataTGA ::@@ -131,6 +133,7 @@ -> B.ByteString -> m (Image r cs e, JP.Metadatas) decodeAutoWithMetadataTGA f bs = convertAutoWithMetadata f (JP.decodeTgaWithMetadata bs)+{-# INLINE decodeAutoWithMetadataTGA #-} instance (Manifest r (Pixel cs e), ColorSpace cs i e) =>@@ -167,7 +170,17 @@ encodeAutoTGA _ img = fromMaybe (toTga toJPImageRGB8 toSRGB8 img) $ msum- [ do Refl <- eqT :: Maybe (BaseModel cs :~: CM.X)+ [ do Refl <- eqT :: Maybe (r :~: S)+ case eqT :: Maybe (e :~: Word8) of+ Just Refl+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.X)) ->+ pure $ JP.encodeTga $ toJPImageY8 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.RGB)) ->+ pure $ JP.encodeTga $ toJPImageRGB8 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: Alpha CM.RGB)) ->+ pure $ JP.encodeTga $ toJPImageRGBA8 (toImageBaseModel img)+ _ -> Nothing+ , do Refl <- eqT :: Maybe (BaseModel cs :~: CM.X) msum [ do Refl <- eqT :: Maybe (e :~: Bit) pure $ toTga toJPImageY8 (toPixel8 . toPixelBaseModel) img
src/Data/Massiv/Array/IO/Image/JuicyPixels/TIF.hs view
@@ -9,7 +9,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module : Data.Massiv.Array.IO.Image.JuicyPixels.TIF--- Copyright : (c) Alexey Kuleshevich 2019-2020+-- Copyright : (c) Alexey Kuleshevich 2019-2021 -- License : BSD3 -- Maintainer : Alexey Kuleshevich <lehins@yandex.ru> -- Stability : experimental@@ -258,12 +258,13 @@ -- | Decode a Tiff Image decodeTIF :: (ColorModel cs e, MonadThrow m) => TIF -> B.ByteString -> m (Image S cs e) decodeTIF f bs = convertWith f (JP.decodeTiff bs)+{-# INLINE decodeTIF #-} -- | Decode a Tiff Image decodeWithMetadataTIF :: (ColorModel cs e, MonadThrow m) => TIF -> B.ByteString -> m (Image S cs e, JP.Metadatas) decodeWithMetadataTIF f bs = convertWithMetadata f (JP.decodeTiffWithMetadata bs)-+{-# INLINE decodeWithMetadataTIF #-} -- | Decode a Tiff Image decodeAutoTIF ::@@ -272,6 +273,7 @@ -> B.ByteString -> m (Image r cs e) decodeAutoTIF f bs = convertAutoWith f (JP.decodeTiff bs)+{-# INLINE decodeAutoTIF #-} -- | Decode a Tiff Image decodeAutoWithMetadataTIF ::@@ -280,6 +282,7 @@ -> B.ByteString -> m (Image r cs e, JP.Metadatas) decodeAutoWithMetadataTIF f bs = convertAutoWithMetadata f (JP.decodeTiffWithMetadata bs)+{-# INLINE decodeAutoWithMetadataTIF #-} instance (Manifest r (Pixel cs e), ColorSpace cs i e) => Readable (Auto TIF) (Image r cs e) where@@ -328,7 +331,44 @@ encodeAutoTIF _ img = fromMaybe (toTiff toJPImageRGB8 toSRGB8 img) $ msum- [ do Refl <- eqT :: Maybe (BaseModel cs :~: CM.X)+ [ do Refl <- eqT :: Maybe (r :~: S)+ msum+ [ case eqT :: Maybe (e :~: Word8) of+ Just Refl+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.X)) ->+ pure $ JP.encodeTiff $ toJPImageY8 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.RGB)) ->+ pure $ JP.encodeTiff $ toJPImageRGB8 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.YCbCr)) ->+ pure $ JP.encodeTiff $ toJPImageYCbCr8 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.CMYK)) ->+ pure $ JP.encodeTiff $ toJPImageCMYK8 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: Alpha CM.X)) ->+ pure $ JP.encodeTiff $ toJPImageYA8 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: Alpha CM.RGB)) ->+ pure $ JP.encodeTiff $ toJPImageRGBA8 (toImageBaseModel img)+ _ -> Nothing+ , case eqT :: Maybe (e :~: Word16) of+ Just Refl+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.X)) ->+ pure $ JP.encodeTiff $ toJPImageY16 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.RGB)) ->+ pure $ JP.encodeTiff $ toJPImageRGB16 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: CM.CMYK)) ->+ pure $ JP.encodeTiff $ toJPImageCMYK16 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: Alpha CM.X)) ->+ pure $ JP.encodeTiff $ toJPImageYA16 (toImageBaseModel img)+ | Just Refl <- (eqT :: Maybe (BaseModel cs :~: Alpha CM.RGB)) ->+ pure $ JP.encodeTiff $ toJPImageRGBA16 (toImageBaseModel img)+ _ -> Nothing+ , do Refl <- eqT :: Maybe (e :~: Word32)+ Refl <- eqT :: Maybe (BaseModel cs :~: CM.X)+ pure $ JP.encodeTiff $ toJPImageY32 (toImageBaseModel img)+ , do Refl <- eqT :: Maybe (e :~: Float)+ Refl <- eqT :: Maybe (BaseModel cs :~: CM.X)+ pure $ JP.encodeTiff $ toJPImageYF (toImageBaseModel img)+ ]+ , do Refl <- eqT :: Maybe (BaseModel cs :~: CM.X) msum [ do Refl <- eqT :: Maybe (e :~: Bit) pure $ toTiff toJPImageY8 (toPixel8 . toPixelBaseModel) img
src/Data/Massiv/Array/IO/Image/Netpbm.hs view
@@ -10,7 +10,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module : Data.Massiv.Array.IO.Image.Netpbm--- Copyright : (c) Alexey Kuleshevich 2018-2020+-- Copyright : (c) Alexey Kuleshevich 2018-2021 -- License : BSD3 -- Maintainer : Alexey Kuleshevich <lehins@yandex.ru> -- Stability : experimental@@ -91,6 +91,7 @@ -> B.ByteString -> m (Image S cs e, Maybe B.ByteString) decodeNetpbmImage = decodePPM fromNetpbmImage+{-# INLINE decodeNetpbmImage #-} -- | Try to decode a Netpbm image sequence --@@ -101,6 +102,7 @@ -> B.ByteString -> m ([Image S cs e], Maybe B.ByteString) decodeNetpbmImageSequence = decodePPMs fromNetpbmImage+{-# INLINE decodeNetpbmImageSequence #-} -- | Try to decode a Netpbm image, while auto converting the colorspace. --@@ -111,6 +113,7 @@ -> B.ByteString -> m (Image r cs e, Maybe B.ByteString) decodeAutoNetpbmImage = decodePPM fromNetpbmImageAuto+{-# INLINE decodeAutoNetpbmImage #-} -- | Try to decode a Netpbm image sequence, while auto converting the colorspace. --@@ -121,6 +124,7 @@ -> B.ByteString -> m ([Image r cs e], Maybe B.ByteString) decodeAutoNetpbmImageSequence = decodePPMs fromNetpbmImageAuto+{-# INLINE decodeAutoNetpbmImageSequence #-} decodePPMs :: (FileFormat f, Manifest r (Pixel cs e), ColorModel cs e, MonadThrow m) => (Netpbm.PPM -> Maybe (Image r cs e))
src/Graphics/ColorModel.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Graphics.ColorModel--- Copyright : (c) Alexey Kuleshevich 2020+-- Copyright : (c) Alexey Kuleshevich 2020-2021 -- License : BSD3 -- Maintainer : Alexey Kuleshevich <lehins@yandex.ru> -- Stability : experimental