massiv-io 0.4.0.0 → 0.4.1.0

raw patch · 13 files changed

+368/−267 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• massiv-io.cabal +1/−1
• src/Data/Massiv/Array/IO.hs +38/−14
• src/Data/Massiv/Array/IO/Base.hs +31/−7
• src/Data/Massiv/Array/IO/Image.hs +88/−63
• src/Data/Massiv/Array/IO/Image/JuicyPixels/BMP.hs +16/−10
• src/Data/Massiv/Array/IO/Image/JuicyPixels/Base.hs +85/−98
• src/Data/Massiv/Array/IO/Image/JuicyPixels/GIF.hs +11/−6
• src/Data/Massiv/Array/IO/Image/JuicyPixels/JPG.hs +19/−10
• src/Data/Massiv/Array/IO/Image/JuicyPixels/PNG.hs +22/−19
• src/Data/Massiv/Array/IO/Image/JuicyPixels/TGA.hs +15/−10
• src/Data/Massiv/Array/IO/Image/JuicyPixels/TIF.hs +28/−27
• tests/Test/Massiv/Array/IO/Image/Common.hs +2/−2

@@ -1,3 +1,15 @@+# 0.4.1++* Reexport `Default` class.+* Add support for massiv-0.6+* Expose `Encode` and `Decode` cosntructors+* Add `encodeAdhocM` and `decodeAdhocM`+* Add `writableAdhoc` and `readableAdhoc`+* Add `displayImageUsingAdhoc`+* Add `coerceBinaryImage`+* Add instance for writing binary images: `Image S X Bit` without conversions.+* Add `selectFileFormat`+ # 0.4.0  * Adjust insatnces to account for changes in `Color-0.3.0`, namely improvements to Luma

@@ -1,5 +1,5 @@ name:                massiv-io-version:             0.4.0.0+version:             0.4.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

@@ -31,6 +31,7 @@   , ExternalViewer(..)   , displayImage   , displayImageUsing+  , displayImageUsingAdhoc   , displayImageFile   -- ** Common viewers   , defaultViewer@@ -53,8 +54,10 @@                                           DecodeError(..), EncodeError(..),                                           FileFormat(..), MonadThrow(..),                                           Readable(..), Sequence(..),-                                          Writable(..), convertEither,-                                          convertImage, decode', decodeError,+                                          Writable(..), Default(..),+                                          convertEither,+                                          convertImage, coerceBinaryImage,+                                          decode', decodeError,                                           defaultWriteOptions,                                           demoteLumaAlphaImage, demoteLumaImage,                                           encode', encodeError,@@ -67,11 +70,11 @@ import Graphics.Pixel.ColorSpace import Prelude import Prelude as P hiding (readFile, writeFile)-import System.FilePath ((</>))+import System.FilePath ((</>), (<.>)) import System.IO (IOMode(..), hClose, openBinaryTempFile) import UnliftIO.Concurrent (forkIO) import UnliftIO.Directory (createDirectoryIfMissing, getTemporaryDirectory)-import UnliftIO.Exception (bracket)+import UnliftIO.Exception (catchAny, bracket) import UnliftIO.IO.File import UnliftIO.Process (readProcess) @@ -262,16 +265,37 @@           -- closed. Supplying `False` is only safe in the ghci session.   -> Image r cs e -- ^ Image to display   -> m ()-displayImageUsing viewer block img =+displayImageUsing viewer block =+  displayImageUsingAdhoc  viewer block (writableAdhoc (Auto TIF))+++-- | Encode an image using an adhoc into an operating system's temporary+-- directory and passed as an argument to the external viewer program.+--+-- @since 4.1.0+displayImageUsingAdhoc ::+     MonadIO m+  => ExternalViewer -- ^ Image viewer program+  -> Bool -- ^ Should this function block the current thread until viewer is+          -- closed. Supplying `False` is only safe in the ghci session.+  -> Encode img+  -> img -- ^ Image to display+  -> m ()+displayImageUsingAdhoc viewer block adhoc img =   liftIO $ do-    bs <- encodeM (Auto TIF) () img-    (if block then id else void . forkIO) $ display bs+    bs <- encodeAdhocM adhoc img+    -- this function is meant to be used in ghci, therefore it is ok to not cleanup+    -- dangling threads after display is called.+    (if block then id else void . forkIO . reportErrors) $ display bs   where+    reportErrors action =+      catchAny action $ \ exc ->+        putStrLn $ "<displayImageUsingAdhoc>: Failed with: " <> displayException exc     display bs = do       tmpDir <- fmap (</> "massiv-io") getTemporaryDirectory       createDirectoryIfMissing True tmpDir       bracket-        (openBinaryTempFile tmpDir "tmp-img.tiff")+        (openBinaryTempFile tmpDir ("tmp-img" <.> ext adhoc))         (hClose . snd)         (\(imgPath, imgHandle) -> do            BL.hPut imgHandle bs@@ -355,7 +379,7 @@  * 'BMP': -    * __read__: ('PixelY' 'Word8'), ('PixelRGB' 'Word8'), ('PixelRGBA' 'Word8')+    * __read__: ('PixelX' 'Bit'), ('PixelY' 'Word8'), ('PixelRGB' 'Word8'), ('PixelRGBA' 'Word8')     * __write__: ('PixelY' 'Word8'), ('PixelRGB' 'Word8'), ('PixelRGBA' 'Word8')  * 'GIF':@@ -378,14 +402,14 @@  * 'PNG': -    * __read__: ('PixelY' 'Word8'), ('PixelY' 'Word16'), ('PixelYA' 'Word8'), ('PixelYA' 'Word16'),+    * __read__: ('PixelX' 'Bit'), ('PixelY' 'Word8'), ('PixelY' 'Word16'), ('PixelYA' 'Word8'), ('PixelYA' 'Word16'),     ('PixelRGB' 'Word8'), ('PixelRGB' 'Word16'), ('PixelRGBA' 'Word8'), ('PixelRGBA' 'Word16')     * __write__: ('PixelY' 'Word8'), ('PixelY' 'Word16'), ('PixelYA' 'Word8'), ('PixelYA' 'Word16'),     ('PixelRGB' 'Word8'), ('PixelRGB' 'Word16'), ('PixelRGBA' 'Word8'), ('PixelRGBA' 'Word16')  * 'TGA': -    * __read__: ('PixelY' 'Word8'), ('PixelRGB' 'Word8'), ('PixelRGBA' 'Word8')+    * __read__: ('PixelX' 'Bit'), ('PixelY' 'Word8'), ('PixelRGB' 'Word8'), ('PixelRGBA' 'Word8')     * __write__: ('PixelY' 'Word8'), ('PixelRGB' 'Word8'), ('PixelRGBA' 'Word8')  * 'TIF':@@ -404,16 +428,16 @@ * 'PBM':      * __read__: ('PixelY' 'Bit')-    * Also supports sequence of images in one file, when read as @['PBM']@+    * Also supports `Sequence` of images in one file, when read as @['PBM']@  * 'PGM':      * __read__: ('PixelY' 'Word8'), ('PixelY' 'Word16')-    * Also supports sequence of images in one file, when read as @['PGM']@+    * Also supports `Sequence` of images in one file, when read as @['PGM']@  * 'PPM':      * __read__: ('PixelRGB' 'Word8'), ('PixelRGB' 'Word16')-    * Also supports sequence of images in one file, when read as @['PPM']@+    * Also supports `Sequence` of images in one file, when read as @['PPM']@  -}

@@ -11,7 +11,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module      : Data.Massiv.Array.IO.Base--- Copyright   : (c) Alexey Kuleshevich 2018-2020+-- Copyright   : (c) Alexey Kuleshevich 2018-2021 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -19,6 +19,7 @@ -- module Data.Massiv.Array.IO.Base   ( FileFormat(..)+  , selectFileFormat   , Readable(..)   , decode'   , Writable(..)@@ -27,11 +28,13 @@   , EncodeError(..)   , DecodeError(..)   , Sequence(..)+  , Default(..)   , Auto(..)   , Image   , convertImage   , toImageBaseModel   , fromImageBaseModel+  , coerceBinaryImage   , demoteLumaImage   , promoteLumaImage   , demoteLumaAlphaImage@@ -52,31 +55,35 @@ import Control.Monad.Catch (MonadThrow(..)) import qualified Data.ByteString as B (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString)+import Data.Char (toLower) import Data.Default.Class (Default(..)) import qualified Data.Massiv.Array as A import Data.Typeable import qualified Data.Vector.Storable as V import Graphics.Pixel as CM import Graphics.Pixel.ColorSpace+import Prelude as P+import System.FilePath (takeExtension) import Unsafe.Coerce #if !MIN_VERSION_massiv(0,5,0) import Data.Massiv.Array.Manifest.Vector #endif type Image r cs e = A.Array r A.Ix2 (Pixel cs e) --- | Conversion error, which is thrown when there is a mismatch between the--- expected array type and the one supported by the file format. It is also--- thrown upon a failure of automatic conversion between those types, in case--- such conversion is utilized.+-- | Conversion error, which is thrown when there is a mismatch between the expected array+-- type and the one supported by the file format. It is also thrown upon a failure of+-- automatic conversion between those types, in case when such conversion is utilized. newtype ConvertError = ConvertError String deriving Show -instance Exception ConvertError+instance Exception ConvertError where+  displayException (ConvertError str) = "ConvertError: " ++ str  -- | This exception can be thrown while reading/decoding a file and indicates an -- error in the file itself. newtype DecodeError = DecodeError String deriving Show -instance Exception DecodeError+instance Exception DecodeError where+  displayException (DecodeError str) = "DecodeError: " ++ str  -- | This exception can be thrown while writing/encoding into a file and -- indicates an error in an array that is being encoded.@@ -125,7 +132,18 @@   ext (Auto f) = ext f   exts (Auto f) = exts f +-- | Try to select a file format by looking at the file extension and matching it to one+-- of the formats in the list+--+-- @since 0.4.1+selectFileFormat :: (FileFormat f, MonadThrow m) => [f] -> FilePath -> m f+selectFileFormat formats path = do+  let ext' = P.map toLower . takeExtension $ path+  case P.dropWhile (not . isFormat ext') formats of+    []    -> throwM $ EncodeError $ "File format is not supported: " ++ ext'+    (f:_) -> pure f + -- | File formats that can be read into arrays. class FileFormat f => Readable f arr where   {-# MINIMAL (decodeM | decodeWithMetadataM) #-}@@ -162,6 +180,7 @@   -- @since 0.2.0   encodeM :: MonadThrow m => f -> WriteOptions f -> arr -> m BL.ByteString + -- | Helper function to create a `Proxy` from the value. toProxy :: a -> Proxy a toProxy _ = Proxy@@ -278,6 +297,11 @@ fromImageBaseModel :: A.Array A.S A.Ix2 (Pixel (BaseModel cs) e) -> A.Array A.S A.Ix2 (Pixel cs e) fromImageBaseModel = unsafeCoerce +-- | Convert Binary image to its Word8 backed pixel without copy+--+-- @since 0.4.1+coerceBinaryImage :: A.Array A.S A.Ix2 (Pixel CM.X Bit) -> A.Array A.S A.Ix2 (Pixel CM.X Word8)+coerceBinaryImage = unsafeCoerce  -- | Cast an array with Luma pixels to an array with pixels in a plain single channel -- `CM.X` color model

@@ -16,49 +16,65 @@   ( module Data.Massiv.Array.IO.Image.JuicyPixels   , module Data.Massiv.Array.IO.Image.Netpbm   -- ** Helper image functions-  , Encode+  , selectFileFormat+  , Encode(..)   , encodeImageM+  , encodeAdhocM+  , writableAdhoc   , imageWriteFormats   , imageWriteAutoFormats-  , Decode+  , Decode(..)   , decodeImageM+  , decodeAdhocM+  , readableAdhoc   , imageReadFormats   , imageReadAutoFormats   ) where  import qualified Data.ByteString as B (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString)-import Data.Char (toLower) import Data.Massiv.Array import Data.Massiv.Array.IO.Base import Data.Massiv.Array.IO.Image.JuicyPixels import Data.Massiv.Array.IO.Image.Netpbm import Graphics.Pixel.ColorSpace import Prelude as P-import System.FilePath (takeExtension)   +-- | Adhoc encoder data Encode out where-  EncodeAs+  -- | Provide a custom way to encode a particular file format. This is an alternative+  -- approach to `Writable` class+  --+  -- @since 0.4.1+  Encode     :: FileFormat f     => f-    -> (forall m. MonadThrow m =>-                    f -> out -> m BL.ByteString)+    -> (forall m. MonadThrow m => f -> out -> m BL.ByteString)     -> Encode out  instance Show (Encode out) where-  show (EncodeAs f _) = show f+  show (Encode f _) = show f -instance FileFormat (Encode (Image r cs e)) where-  ext (EncodeAs f _) = ext f+instance FileFormat (Encode out) where+  ext (Encode f _) = ext f -  exts (EncodeAs f _) = exts f+  exts (Encode f _) = exts f -instance Writable (Encode (Image r cs e)) (Image r cs e) where-  encodeM (EncodeAs f enc) _ = enc f+-- | Decode binary data without requiring `Readable` instances+--+-- @since 0.4.1+encodeAdhocM :: MonadThrow m => Encode out -> out -> m BL.ByteString+encodeAdhocM (Encode f enc) = enc f +-- | 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) + -- | Encode an image into a lazy `BL.ByteString`, while selecting the appropriate format from the -- file extension. --@@ -71,23 +87,20 @@   -> Image r cs e -- ^ Image to encode   -> m BL.ByteString encodeImageM formats path img = do-  let ext' = P.map toLower . takeExtension $ path-  case P.dropWhile (not . isFormat ext') formats of-    []    -> throwM $ EncodeError $ "File format is not supported: " ++ ext'-    (f:_) -> encodeM f () img-+  f <- selectFileFormat formats path+  encodeAdhocM f img   -- | List of image formats that can be encoded without any color space conversion. imageWriteFormats :: (Source r Ix2 (Pixel cs e), ColorModel cs e) => [Encode (Image r cs e)] imageWriteFormats =-  [ 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)+  [ Encode PNG (\ f -> encodePNG f . computeSource @S)+  , Encode TIF (\ f -> encodeTIF f . computeSource @S)+  , Encode JPG (\ f -> encodeJPG f def . computeSource @S)+  , Encode BMP (\ f -> encodeBMP f def . computeSource @S)+  , Encode GIF (\ f -> encodeGIF f def . computeSource @S)+  , Encode TGA (\ f -> encodeTGA f . computeSource @S)+  , Encode HDR (\ f -> encodeHDR f def . computeSource @S)   ]  -- | List of image formats that can be encoded with any necessary color space conversions.@@ -95,36 +108,50 @@      (Source r Ix2 (Pixel cs e), ColorSpace cs i e, ColorSpace (BaseSpace cs) i e)   => [Encode (Image r cs e)] imageWriteAutoFormats =-  [ EncodeAs (Auto BMP) (\f -> pure . encodeAutoBMP f def)-  , EncodeAs (Auto GIF) (`encodeAutoGIF` def)-  , EncodeAs (Auto HDR) (\f -> pure . encodeAutoHDR f def)-  , EncodeAs (Auto JPG) (\f -> pure . encodeAutoJPG f def)-  , EncodeAs (Auto PNG) (\f -> pure . encodeAutoPNG f)-  , EncodeAs (Auto TGA) (\f -> pure . encodeAutoTGA f)-  , EncodeAs (Auto TIF) (\f -> pure . encodeAutoTIF f)+  [ Encode (Auto PNG) (\f -> pure . encodeAutoPNG f)+  , Encode (Auto TIF) (\f -> pure . encodeAutoTIF f)+  , Encode (Auto JPG) (\f -> pure . encodeAutoJPG f def)+  , Encode (Auto BMP) (\f -> pure . encodeAutoBMP f def)+  , Encode (Auto GIF) (`encodeAutoGIF` def)+  , Encode (Auto HDR) (\f -> pure . encodeAutoHDR f def)+  , Encode (Auto TGA) (\f -> pure . encodeAutoTGA f)   ]  -+-- | Adhoc decoder data Decode out where-  DecodeAs+  -- | Provide a custom way to encode a particular file format. This is an alternative+  -- approach to `Writable` class+  --+  -- @since 0.4.1+  Decode     :: FileFormat f     => f     -> (forall m. MonadThrow m => f -> B.ByteString -> m out)     -> Decode out  instance Show (Decode out) where-  show (DecodeAs f _) = show f+  show (Decode f _) = show f  instance FileFormat (Decode (Image r cs e)) where-  ext (DecodeAs f _) = ext f+  ext (Decode f _) = ext f -  exts (DecodeAs f _) = exts f+  exts (Decode f _) = exts f -instance Readable (Decode (Image r cs e)) (Image r cs e) where-  decodeM (DecodeAs f dec) = dec f+-- | Decode binary data without requiring `Readable` instances+--+-- @since 0.4.1+decodeAdhocM :: MonadThrow m => Decode out -> B.ByteString -> m out+decodeAdhocM (Decode f dec) = dec f  +-- | Utilize a Readable instance in order to construct an adhoc Decode type+--+-- @since 0.4.1+readableAdhoc :: Readable f out => f -> Decode out+readableAdhoc f = Decode f decodeM++ -- | Decode an image from the strict `ByteString` while inferring format the image is encoded in -- from the file extension --@@ -136,24 +163,22 @@   -> B.ByteString -- ^ Encoded image   -> m (Image r cs e) decodeImageM formats path bs = do-  let ext' = P.map toLower . takeExtension $ path-  case P.dropWhile (not . isFormat ext') formats of-    []    -> throwM $ DecodeError $ "File format is not supported: " ++ ext'-    (f:_) -> decodeM f bs+  f <- selectFileFormat formats path+  decodeAdhocM f bs  -- | List of image formats decodable with no color space conversion imageReadFormats :: ColorModel cs e => [Decode (Image S cs e)] imageReadFormats =-  [ 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)+  [ Decode PNG decodePNG+  , Decode TIF decodeTIF+  , Decode JPG decodeJPG+  , Decode BMP decodeBMP+  , Decode GIF decodeGIF+  , Decode HDR decodeHDR+  , Decode TGA decodeTGA+  , Decode PBM (\f -> fmap fst . decodeNetpbmImage f)+  , Decode PGM (\f -> fmap fst . decodeNetpbmImage f)+  , Decode PPM (\f -> fmap fst . decodeNetpbmImage f)   ]  -- | List of image formats decodable with automatic colorspace conversion@@ -161,16 +186,16 @@   :: (Mutable r Ix2 (Pixel cs e), ColorSpace cs i e)   => [Decode (Image r cs e)] imageReadAutoFormats =-  [ DecodeAs (Auto BMP) decodeAutoBMP-  , DecodeAs (Auto GIF) decodeAutoGIF-  , DecodeAs (Auto HDR) decodeAutoHDR-  , DecodeAs (Auto JPG) decodeAutoJPG-  , DecodeAs (Auto PNG) decodeAutoPNG-  , DecodeAs (Auto TGA) decodeAutoTGA-  , DecodeAs (Auto TIF) decodeAutoTIF-  , DecodeAs (Auto PBM) (\f -> fmap fst . decodeAutoNetpbmImage f)-  , DecodeAs (Auto PGM) (\f -> fmap fst . decodeAutoNetpbmImage f)-  , DecodeAs (Auto PPM) (\f -> fmap fst . decodeAutoNetpbmImage f)+  [ Decode (Auto PNG) decodeAutoPNG+  , Decode (Auto TIF) decodeAutoTIF+  , Decode (Auto JPG) decodeAutoJPG+  , Decode (Auto BMP) decodeAutoBMP+  , Decode (Auto GIF) decodeAutoGIF+  , Decode (Auto HDR) decodeAutoHDR+  , Decode (Auto TGA) decodeAutoTGA+  , Decode (Auto PBM) (\f -> fmap fst . decodeAutoNetpbmImage f)+  , Decode (Auto PGM) (\f -> fmap fst . decodeAutoNetpbmImage f)+  , Decode (Auto PPM) (\f -> fmap fst . decodeAutoNetpbmImage f)   ]  

@@ -62,6 +62,9 @@    ext _ = ".bmp" +instance Writable BMP (Image A.S CM.X Bit) where+  encodeM f opts img = encodeM f opts (coerceBinaryImage img)+ instance Writable BMP (Image S CM.X Word8) where   encodeM BMP BitmapOptions {bitmapMetadata} =     pure . JP.encodeBitmapWithMetadata bitmapMetadata . toJPImageY8@@ -91,7 +94,6 @@          Writable (Auto BMP) (Image r cs e) where   encodeM f opts = pure . encodeAutoBMP f opts - instance Readable BMP (Image S CM.X Word8) where   decodeWithMetadataM = decodeWithMetadataBMP @@ -150,15 +152,19 @@   -> BitmapOptions   -> Image S cs e   -> m BL.ByteString-encodeBMP f BitmapOptions {bitmapMetadata} img =-  fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) $ do-    Refl <- eqT :: Maybe (e :~: Word8)-    msum-      [ JP.encodeBitmapWithMetadata bitmapMetadata <$> maybeJPImageY8 img-      , JP.encodeBitmapWithMetadata bitmapMetadata <$> maybeJPImageRGB8 img-      , do Refl <- eqT :: Maybe (cs :~: Alpha (Opaque cs))-           JP.encodeBitmapWithMetadata bitmapMetadata <$> maybeJPImageRGBA8 img-      ]+encodeBMP f opts@BitmapOptions {bitmapMetadata} img =+  fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) encoded+  where+    encoded+      | Just Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CM.X Bit) = encodeM BMP opts img+      | Just Refl <- eqT :: Maybe (e :~: Word8) = do+        msum+          [ JP.encodeBitmapWithMetadata bitmapMetadata <$> maybeJPImageY8 img+          , JP.encodeBitmapWithMetadata bitmapMetadata <$> maybeJPImageRGB8 img+          , do Refl <- eqT :: Maybe (cs :~: Alpha (Opaque cs))+               JP.encodeBitmapWithMetadata bitmapMetadata <$> maybeJPImageRGBA8 img+          ]+      | otherwise = Nothing   

@@ -140,110 +140,97 @@   jpImgs <- decodeError ejpImgs   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.X Word8))-        , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Y' SRGB) 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.X Word16))-        , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Y' SRGB) 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.X Word32))-        , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Y' SRGB) 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.X Float))-        , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Y' SRGB) 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.X) Word8))-        , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha (Y' SRGB)) 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.X) Word16))-        , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha (Y' SRGB)) 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 'NonLinear) Word8))-        , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (AdobeRGB 'NonLinear) 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 'NonLinear) Word16))-        , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (AdobeRGB 'NonLinear) 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 'NonLinear) Float))-        , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (AdobeRGB 'NonLinear) 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 'NonLinear)) Word8))-        , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha (AdobeRGB 'NonLinear)) 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 'NonLinear)) Word16))-        , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha (AdobeRGB 'NonLinear)) Word16))-        ]-    JP.ImageYCbCr8 jimg ->-      sequenceMaybe-        [ fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel CM.YCbCr Word8))-        , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Y'CbCr SRGB) Word8))-        , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (Y'CbCr 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 'NonLinear)) Word8))-        , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (CMYK (AdobeRGB 'NonLinear)) 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 'NonLinear)) Word16))-        , fromJPImageM jimg (eqT :: Maybe (Pixel cs e :~: Pixel (CMYK (AdobeRGB 'NonLinear)) Word16))-        ]+    JP.ImageY8 jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Y' SRGB) Word8)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Y D65) Word8)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel CM.X Word8)) -> justFromJP jimg+      | otherwise -> pure Nothing+    JP.ImageY16 jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Y' SRGB) Word16)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Y D65) Word16)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel CM.X Word16)) -> justFromJP jimg+      | otherwise -> pure Nothing+    JP.ImageY32 jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Y' SRGB) Word32)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Y D65) Word32)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel CM.X Word32)) -> justFromJP jimg+      | otherwise -> pure Nothing+    JP.ImageYF jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Y' SRGB) Float)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Y D65) Float)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel CM.X Float)) -> justFromJP jimg+      | otherwise -> pure Nothing+    JP.ImageYA8 jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha (Y' SRGB)) Word8)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha (Y D65)) Word8)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha CM.X) Word8)) -> justFromJP jimg+      | otherwise -> pure Nothing+    JP.ImageYA16 jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha (Y' SRGB)) Word16)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha (Y D65)) Word16)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha CM.X) Word16)) -> justFromJP jimg+      | otherwise -> pure Nothing+    JP.ImageRGB8 jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (SRGB 'NonLinear) Word8)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (AdobeRGB 'NonLinear) Word8)) ->+        justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel CM.RGB Word8)) -> justFromJP jimg+      | otherwise -> pure Nothing+    JP.ImageRGB16 jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (SRGB 'NonLinear) Word16)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (AdobeRGB 'NonLinear) Word16)) ->+        justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel CM.RGB Word16)) -> justFromJP jimg+      | otherwise -> pure Nothing+    JP.ImageRGBF jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (SRGB 'NonLinear) Float)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (AdobeRGB 'NonLinear) Float)) ->+        justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel CM.RGB Float)) -> justFromJP jimg+      | otherwise -> pure Nothing+    JP.ImageRGBA8 jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha (SRGB 'NonLinear)) Word8)) ->+        justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha (AdobeRGB 'NonLinear)) Word8)) ->+        justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha CM.RGB) Word8)) -> justFromJP jimg+      | otherwise -> pure Nothing+    JP.ImageRGBA16 jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha (SRGB 'NonLinear)) Word16)) ->+        justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha (AdobeRGB 'NonLinear)) Word16)) ->+        justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Alpha CM.RGB) Word16)) -> justFromJP jimg+      | otherwise -> pure Nothing+    JP.ImageYCbCr8 jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Y'CbCr SRGB) Word8)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (Y'CbCr AdobeRGB) Word8)) -> justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel CM.YCbCr Word8)) -> justFromJP jimg+      | otherwise -> pure Nothing+    JP.ImageCMYK8 jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (CMYK (SRGB 'NonLinear)) Word8)) ->+        justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (CMYK (AdobeRGB 'NonLinear)) Word8)) ->+        justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel CM.CMYK Word8)) -> justFromJP jimg+      | otherwise -> pure Nothing+    JP.ImageCMYK16 jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (CMYK (SRGB 'NonLinear)) Word16)) ->+        justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (CMYK (AdobeRGB 'NonLinear)) Word16)) ->+        justFromJP jimg+      | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel CM.CMYK Word16)) -> justFromJP jimg+      | otherwise -> pure Nothing+  where+    justFromJP :: JP.Pixel px => JP.Image px -> m (Maybe (Image S cs e))+    justFromJP = fmap Just . fromJPImageUnsafeM  fromDynamicImage ::      forall cs e. ColorModel cs e@@ -645,7 +632,7 @@   unless (numComponentsPerPixel == numberOfComponentsFromSize) $     throwM $ ConvertError $     concat-      [ "Mismatched sizes beteen JuicyPixels: "+      [ "Mismatched sizes between JuicyPixels: "       , show numComponentsPerPixel       , " and massiv: "       , show numberOfComponentsFromSize

@@ -76,6 +76,9 @@   type Metadata GIF = JP.Metadatas   ext _ = ".gif" +instance Writable GIF (Image A.S CM.X Bit) where+  encodeM f opts img = encodeM f opts (coerceBinaryImage img)+ instance Writable GIF (Image S CM.X Word8) where   encodeM GIF _ =  pure . JP.encodeGifImage . toJPImageY8 @@ -168,13 +171,13 @@       \case         Just bs -> pure bs         Nothing-          | Just Refl <- (eqT :: Maybe (e :~: Word8))-          , Just Refl <- (eqT :: Maybe (cs :~: CM.RGB)) -> encodePalettizedRGB opts img-          | Just Refl <- (eqT :: Maybe (e :~: Word8))-          , Just Refl <- (eqT :: Maybe (cs :~: SRGB 'NonLinear)) ->+          | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel CM.X Bit)) ->+            encodeM f opts img+          | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel CM.RGB Word8)) ->+            encodePalettizedRGB opts img+          | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (SRGB 'NonLinear) Word8)) ->             encodePalettizedRGB opts $ toImageBaseModel img-          | Just Refl <- (eqT :: Maybe (e :~: Word8))-          , Just Refl <- (eqT :: Maybe (cs :~: AdobeRGB 'NonLinear)) ->+          | Just Refl <- (eqT :: Maybe (Pixel cs e :~: Pixel (AdobeRGB 'NonLinear) Word8)) ->             encodePalettizedRGB opts $ toImageBaseModel img         Nothing -> fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) Nothing @@ -270,6 +273,8 @@   delays <- decodeError $ JP.getDelaysGifImages bs   pure (imgs, delays) +instance Writable (Sequence GIF) (NE.NonEmpty (JP.GifDelay, Image S CM.X Bit)) where+  encodeM f opts imgs = encodeM f opts (fmap (fmap coerceBinaryImage) imgs)  instance Writable (Sequence GIF) (NE.NonEmpty (JP.GifDelay, Image S CM.X Word8)) where   encodeM _ SequenceGifOptions {sequenceGifLooping} gifs =

@@ -67,6 +67,9 @@   ext _ = ".jpg"   exts _ = [".jpg", ".jpeg"] +instance Writable JPG (Image A.S CM.X Bit) where+  encodeM f opts img = encodeM f opts (coerceBinaryImage img)+ instance Writable JPG (Image S CM.X Word8) where   encodeM JPG JpegOptions {jpegQuality, jpegMetadata} =     pure . JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata . toJPImageY8@@ -177,16 +180,22 @@   -> JpegOptions   -> Image S cs e   -> m BL.ByteString-encodeJPG f JpegOptions {jpegQuality, jpegMetadata} img =-  fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) $ do-    Refl <- eqT :: Maybe (e :~: Word8)-    msum-      [ JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata <$> maybeJPImageY8 img-      , JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata <$> maybeJPImageRGB8 img-      , JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata <$> maybeJPImageYCbCr8 img-      , JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata <$> maybeJPImageCMYK8 img-      ]-+encodeJPG f opts@JpegOptions {jpegQuality, jpegMetadata} img =+  fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) encoded+  where+    encoded+      | Just Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CM.X Bit) = encodeM JPG opts img+      | Just Refl <- eqT :: Maybe (e :~: Word8) =+        msum+          [ JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata <$> maybeJPImageY8 img+          , JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata <$>+            maybeJPImageRGB8 img+          , JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata <$>+            maybeJPImageYCbCr8 img+          , JP.encodeDirectJpegAtQualityWithMetadata jpegQuality jpegMetadata <$>+            maybeJPImageCMYK8 img+          ]+      | otherwise = Nothing   encodeAutoJPG ::

@@ -52,6 +52,9 @@   type Metadata PNG = JP.Metadatas   ext _ = ".png" +instance Writable PNG (Image A.S CM.X Bit) where+  encodeM f opts img = encodeM f opts (coerceBinaryImage img)+ instance Writable PNG (Image S CM.X Word8) where   encodeM PNG _ img = pure $ JP.encodePng (toJPImageY8 img) @@ -215,25 +218,25 @@   => PNG   -> Image S cs e   -> m BL.ByteString-encodePNG f img =-  fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) $-  msum-    [ do Refl <- eqT :: Maybe (e :~: Word8)-         msum-           [ 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 (e :~: Word16)-         msum-           [ 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]-           ]-    ]+encodePNG f img = fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) encoded+  where+    encoded+      | Just Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CM.X Bit) = encodeM PNG () img+      | Just Refl <- eqT :: Maybe (e :~: Word8) =+        msum+          [ 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]+          ]+      | Just Refl <- eqT :: Maybe (e :~: Word16) =+        msum+          [ 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]+          ]+      | otherwise = Nothing   encodeAutoPNG ::

@@ -53,6 +53,9 @@   type Metadata TGA = JP.Metadatas   ext _ = ".tga" +instance Writable TGA (Image A.S CM.X Bit) where+  encodeM f opts img = encodeM f opts (coerceBinaryImage img)+ instance Writable TGA (Image S CM.X Word8) where   encodeM TGA _ img = pure $ JP.encodeTga (toJPImageY8 img) @@ -139,16 +142,18 @@   => TGA   -> Image S cs e   -> m BL.ByteString-encodeTGA f 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-      ]-+encodeTGA f img = fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) encoded+  where+    encoded+      | Just Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CM.X Bit) = encodeM TGA def img+      | Just Refl <- eqT :: Maybe (e :~: Word8) = do+        msum+          [ JP.encodeTga <$> maybeJPImageY8 img+          , JP.encodeTga <$> maybeJPImageRGB8 img+          , do Refl <- eqT :: Maybe (cs :~: Alpha (Opaque cs))+               JP.encodeTga <$> maybeJPImageRGBA8 img+          ]+      | otherwise = Nothing  encodeAutoTGA ::      forall r cs i e.

@@ -60,6 +60,9 @@   ext _ = ".tif"   exts _ = [".tif", ".tiff"] +instance Writable TIF (Image A.S CM.X Bit) where+  encodeM f opts img = encodeM f opts (coerceBinaryImage img)+ instance Writable TIF (Image S CM.X Word8) where   encodeM TIF _ img = pure $ JP.encodeTiff (toJPImageY8 img) @@ -289,33 +292,31 @@   => TIF   -> Image S cs e   -> m BL.ByteString-encodeTIF f img =-  fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) $-  msum-    [ do Refl <- eqT :: Maybe (e :~: Word8)-         msum-           [ 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 (e :~: Word16)-         msum-           [ 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-    ]+encodeTIF f img = fromMaybeEncode f (Proxy :: Proxy (Image S cs e)) encoded+  where+    encoded+      | Just Refl <- eqT :: Maybe (Pixel cs e :~: Pixel CM.X Bit) = encodeM TIF def img+      | Just Refl <- eqT :: Maybe (e :~: Word8) =+        msum+          [ 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+          ]+      | Just Refl <- eqT :: Maybe (e :~: Word16) =+        msum+          [ 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+          ]+      | Just Refl <- eqT :: Maybe (e :~: Word32) = JP.encodeTiff <$> maybeJPImageY32 img+      | Just Refl <- eqT :: Maybe (e :~: Float) = JP.encodeTiff <$> maybeJPImageYF img+      | otherwise = Nothing   

@@ -6,12 +6,12 @@ {-# LANGUAGE TypeApplications #-} module Test.Massiv.Array.IO.Image.Common where +import qualified Data.ByteString.Lazy as BL import Data.List.NonEmpty as NE (NonEmpty(..)) import Data.Massiv.Array import Data.Massiv.Array.IO-import qualified Data.ByteString.Lazy as BL-import Test.Massiv.Core import System.Random+import Test.Massiv.Core   elevatorGen :: (Random e, Elevator e) => Gen e