{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- |
-- Module      : Data.Massiv.Array.IO.Image.JuicyPixels.TIF
-- Copyright   : (c) Alexey Kuleshevich 2019-2021
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Data.Massiv.Array.IO.Image.JuicyPixels.TIF
  ( TIF(..)
  , decodeTIF
  , decodeWithMetadataTIF
  , decodeAutoTIF
  , decodeAutoWithMetadataTIF
  , encodeTIF
  , encodeAutoTIF
  ) where

import qualified Codec.Picture as JP
import qualified Codec.Picture.Metadata as JP
import qualified Codec.Picture.Tiff 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.Massiv.Array as A
import Data.Massiv.Array.IO.Base
import Data.Massiv.Array.IO.Image.JuicyPixels.Base
import Data.Maybe (fromMaybe)
import Data.Typeable
import qualified Graphics.Pixel as CM
import Graphics.Pixel.ColorSpace
import Prelude as P



--------------------------------------------------------------------------------
-- TIF Format ------------------------------------------------------------------
--------------------------------------------------------------------------------

-- TODOs:
--  * Check on reading in YCbCr
--  * Check on "except for Y32 which is truncated to 16 bits" in `JP.decodeTiff` doc.


-- | Tagged Image File Format image with @.tif@ or @.tiff@ extension.
data TIF = TIF deriving Int -> TIF -> ShowS
[TIF] -> ShowS
TIF -> String
(Int -> TIF -> ShowS)
-> (TIF -> String) -> ([TIF] -> ShowS) -> Show TIF
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TIF] -> ShowS
$cshowList :: [TIF] -> ShowS
show :: TIF -> String
$cshow :: TIF -> String
showsPrec :: Int -> TIF -> ShowS
$cshowsPrec :: Int -> TIF -> ShowS
Show

instance FileFormat TIF where
  type Metadata TIF = JP.Metadatas
  ext :: TIF -> String
ext TIF
_ = String
".tif"
  exts :: TIF -> [String]
exts TIF
_ = [String
".tif", String
".tiff"]

instance Writable TIF (Image A.S CM.X Bit) where
  encodeM :: TIF -> WriteOptions TIF -> Image S X Bit -> m ByteString
encodeM TIF
f WriteOptions TIF
opts Image S X Bit
img = TIF -> WriteOptions TIF -> Matrix S (Pixel X Word8) -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S X Bit -> Matrix S (Pixel X Word8)
coerceBinaryImage Image S X Bit
img)

instance Writable TIF (Image S CM.X Word8) where
  encodeM :: TIF -> WriteOptions TIF -> Matrix S (Pixel X Word8) -> m ByteString
encodeM TIF
TIF WriteOptions TIF
_ Matrix S (Pixel X Word8)
img = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Image Word8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Matrix S (Pixel X Word8) -> Image Word8
forall r.
Source r (Pixel X Word8) =>
Image r X Word8 -> Image Word8
toJPImageY8 Matrix S (Pixel X Word8)
img)

instance Writable TIF (Image S CM.X Word16) where
  encodeM :: TIF -> WriteOptions TIF -> Image S X Word16 -> m ByteString
encodeM TIF
TIF WriteOptions TIF
_ Image S X Word16
img = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Image Word16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image S X Word16 -> Image Word16
forall r.
Source r (Pixel X Word16) =>
Image r X Word16 -> Image Word16
toJPImageY16 Image S X Word16
img)

instance Writable TIF (Image S CM.X Word32) where
  encodeM :: TIF -> WriteOptions TIF -> Image S X Word32 -> m ByteString
encodeM TIF
TIF WriteOptions TIF
_ Image S X Word32
img = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Image Word32 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image S X Word32 -> Image Word32
forall r.
Source r (Pixel X Word32) =>
Image r X Word32 -> Image Word32
toJPImageY32 Image S X Word32
img)

instance Writable TIF (Image S CM.X Float) where
  encodeM :: TIF -> WriteOptions TIF -> Image S X Float -> m ByteString
encodeM TIF
TIF WriteOptions TIF
_ Image S X Float
img = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Image Float -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image S X Float -> Image Float
forall r.
Source r (Pixel X Float) =>
Image r X Float -> Image Float
toJPImageYF Image S X Float
img)

instance Writable TIF (Image S (Alpha CM.X) Word8) where
  encodeM :: TIF -> WriteOptions TIF -> Image S (Alpha X) Word8 -> m ByteString
encodeM TIF
TIF WriteOptions TIF
_ Image S (Alpha X) Word8
img = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYA8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image S (Alpha X) Word8 -> Image PixelYA8
forall r.
Source r (Pixel (Alpha X) Word8) =>
Image r (Alpha X) Word8 -> Image PixelYA8
toJPImageYA8 Image S (Alpha X) Word8
img)

instance Writable TIF (Image S (Alpha CM.X) Word16) where
  encodeM :: TIF -> WriteOptions TIF -> Image S (Alpha X) Word16 -> m ByteString
encodeM TIF
TIF WriteOptions TIF
_ Image S (Alpha X) Word16
img = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYA16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image S (Alpha X) Word16 -> Image PixelYA16
forall r.
Source r (Pixel (Alpha X) Word16) =>
Image r (Alpha X) Word16 -> Image PixelYA16
toJPImageYA16 Image S (Alpha X) Word16
img)

instance Writable TIF (Image S CM.RGB Word8) where
  encodeM :: TIF -> WriteOptions TIF -> Image S RGB Word8 -> m ByteString
encodeM TIF
TIF WriteOptions TIF
_ Image S RGB Word8
img = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGB8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image S RGB Word8 -> Image PixelRGB8
forall r.
Source r (Pixel RGB Word8) =>
Image r RGB Word8 -> Image PixelRGB8
toJPImageRGB8 Image S RGB Word8
img)

instance Writable TIF (Image S CM.RGB Word16) where
  encodeM :: TIF -> WriteOptions TIF -> Image S RGB Word16 -> m ByteString
encodeM TIF
TIF WriteOptions TIF
_ Image S RGB Word16
img = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGB16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image S RGB Word16 -> Image PixelRGB16
forall r.
Source r (Pixel RGB Word16) =>
Image r RGB Word16 -> Image PixelRGB16
toJPImageRGB16 Image S RGB Word16
img)

instance Writable TIF (Image S (Alpha CM.RGB) Word8) where
  encodeM :: TIF
-> WriteOptions TIF -> Image S (Alpha RGB) Word8 -> m ByteString
encodeM TIF
TIF WriteOptions TIF
_ Image S (Alpha RGB) Word8
img = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBA8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image S (Alpha RGB) Word8 -> Image PixelRGBA8
forall r.
Source r (Pixel (Alpha RGB) Word8) =>
Image r (Alpha RGB) Word8 -> Image PixelRGBA8
toJPImageRGBA8 Image S (Alpha RGB) Word8
img)

instance Writable TIF (Image S (Alpha CM.RGB) Word16) where
  encodeM :: TIF
-> WriteOptions TIF -> Image S (Alpha RGB) Word16 -> m ByteString
encodeM TIF
TIF WriteOptions TIF
_ Image S (Alpha RGB) Word16
img = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBA16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image S (Alpha RGB) Word16 -> Image PixelRGBA16
forall r.
Source r (Pixel (Alpha RGB) Word16) =>
Image r (Alpha RGB) Word16 -> Image PixelRGBA16
toJPImageRGBA16 Image S (Alpha RGB) Word16
img)

instance Writable TIF (Image S CM.YCbCr Word8) where
  encodeM :: TIF -> WriteOptions TIF -> Image S YCbCr Word8 -> m ByteString
encodeM TIF
TIF WriteOptions TIF
_ Image S YCbCr Word8
img = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYCbCr8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image S YCbCr Word8 -> Image PixelYCbCr8
forall r.
Source r (Pixel YCbCr Word8) =>
Image r YCbCr Word8 -> Image PixelYCbCr8
toJPImageYCbCr8 Image S YCbCr Word8
img)

instance Writable TIF (Image S CM.CMYK Word8) where
  encodeM :: TIF -> WriteOptions TIF -> Image S CMYK Word8 -> m ByteString
encodeM TIF
TIF WriteOptions TIF
_ Image S CMYK Word8
img = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelCMYK8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image S CMYK Word8 -> Image PixelCMYK8
forall r.
Source r (Pixel CMYK Word8) =>
Image r CMYK Word8 -> Image PixelCMYK8
toJPImageCMYK8 Image S CMYK Word8
img)

instance Writable TIF (Image S CM.CMYK Word16) where
  encodeM :: TIF -> WriteOptions TIF -> Image S CMYK Word16 -> m ByteString
encodeM TIF
TIF WriteOptions TIF
_ Image S CMYK Word16
img = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelCMYK16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image S CMYK Word16 -> Image PixelCMYK16
forall r.
Source r (Pixel CMYK Word16) =>
Image r CMYK Word16 -> Image PixelCMYK16
toJPImageCMYK16 Image S CMYK Word16
img)

instance Writable TIF (Image S (Y' SRGB) Word8) where
  encodeM :: TIF -> WriteOptions TIF -> Image S (Y' SRGB) Word8 -> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Matrix S (Pixel X Word8) -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Matrix S (Pixel X Word8) -> m ByteString)
-> (Image S (Y' SRGB) Word8 -> Matrix S (Pixel X Word8))
-> Image S (Y' SRGB) Word8
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Y' SRGB) Word8 -> Matrix S (Pixel X Word8)
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (Y' SRGB) Word16) where
  encodeM :: TIF -> WriteOptions TIF -> Image S (Y' SRGB) Word16 -> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Image S X Word16 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S X Word16 -> m ByteString)
-> (Image S (Y' SRGB) Word16 -> Image S X Word16)
-> Image S (Y' SRGB) Word16
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Y' SRGB) Word16 -> Image S X Word16
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (Y' SRGB) Word32) where
  encodeM :: TIF -> WriteOptions TIF -> Image S (Y' SRGB) Word32 -> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Image S X Word32 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S X Word32 -> m ByteString)
-> (Image S (Y' SRGB) Word32 -> Image S X Word32)
-> Image S (Y' SRGB) Word32
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Y' SRGB) Word32 -> Image S X Word32
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (Y' SRGB) Float) where
  encodeM :: TIF -> WriteOptions TIF -> Image S (Y' SRGB) Float -> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Image S X Float -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S X Float -> m ByteString)
-> (Image S (Y' SRGB) Float -> Image S X Float)
-> Image S (Y' SRGB) Float
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Y' SRGB) Float -> Image S X Float
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (Alpha (Y' SRGB)) Word8) where
  encodeM :: TIF
-> WriteOptions TIF
-> Image S (Alpha (Y' SRGB)) Word8
-> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Image S (Alpha X) Word8 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S (Alpha X) Word8 -> m ByteString)
-> (Image S (Alpha (Y' SRGB)) Word8 -> Image S (Alpha X) Word8)
-> Image S (Alpha (Y' SRGB)) Word8
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Alpha (Y' SRGB)) Word8 -> Image S (Alpha X) Word8
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (Alpha (Y' SRGB)) Word16) where
  encodeM :: TIF
-> WriteOptions TIF
-> Image S (Alpha (Y' SRGB)) Word16
-> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Image S (Alpha X) Word16 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S (Alpha X) Word16 -> m ByteString)
-> (Image S (Alpha (Y' SRGB)) Word16 -> Image S (Alpha X) Word16)
-> Image S (Alpha (Y' SRGB)) Word16
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Alpha (Y' SRGB)) Word16 -> Image S (Alpha X) Word16
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (Y D65) Word8) where
  encodeM :: TIF -> WriteOptions TIF -> Image S (Y D65) Word8 -> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Matrix S (Pixel X Word8) -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Matrix S (Pixel X Word8) -> m ByteString)
-> (Image S (Y D65) Word8 -> Matrix S (Pixel X Word8))
-> Image S (Y D65) Word8
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Y D65) Word8 -> Matrix S (Pixel X Word8)
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (Y D65) Word16) where
  encodeM :: TIF -> WriteOptions TIF -> Image S (Y D65) Word16 -> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Image S X Word16 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S X Word16 -> m ByteString)
-> (Image S (Y D65) Word16 -> Image S X Word16)
-> Image S (Y D65) Word16
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Y D65) Word16 -> Image S X Word16
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (Y D65) Word32) where
  encodeM :: TIF -> WriteOptions TIF -> Image S (Y D65) Word32 -> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Image S X Word32 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S X Word32 -> m ByteString)
-> (Image S (Y D65) Word32 -> Image S X Word32)
-> Image S (Y D65) Word32
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Y D65) Word32 -> Image S X Word32
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (Y D65) Float) where
  encodeM :: TIF -> WriteOptions TIF -> Image S (Y D65) Float -> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Image S X Float -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S X Float -> m ByteString)
-> (Image S (Y D65) Float -> Image S X Float)
-> Image S (Y D65) Float
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Y D65) Float -> Image S X Float
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (Alpha (Y D65)) Word8) where
  encodeM :: TIF
-> WriteOptions TIF
-> Image S (Alpha (Y D65)) Word8
-> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Image S (Alpha X) Word8 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S (Alpha X) Word8 -> m ByteString)
-> (Image S (Alpha (Y D65)) Word8 -> Image S (Alpha X) Word8)
-> Image S (Alpha (Y D65)) Word8
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Alpha (Y D65)) Word8 -> Image S (Alpha X) Word8
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (Alpha (Y D65)) Word16) where
  encodeM :: TIF
-> WriteOptions TIF
-> Image S (Alpha (Y D65)) Word16
-> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Image S (Alpha X) Word16 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S (Alpha X) Word16 -> m ByteString)
-> (Image S (Alpha (Y D65)) Word16 -> Image S (Alpha X) Word16)
-> Image S (Alpha (Y D65)) Word16
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Alpha (Y D65)) Word16 -> Image S (Alpha X) Word16
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (SRGB 'NonLinear) Word8) where
  encodeM :: TIF
-> WriteOptions TIF
-> Image S (SRGB 'NonLinear) Word8
-> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Image S RGB Word8 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S RGB Word8 -> m ByteString)
-> (Image S (SRGB 'NonLinear) Word8 -> Image S RGB Word8)
-> Image S (SRGB 'NonLinear) Word8
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (SRGB 'NonLinear) Word8 -> Image S RGB Word8
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (SRGB 'NonLinear) Word16) where
  encodeM :: TIF
-> WriteOptions TIF
-> Image S (SRGB 'NonLinear) Word16
-> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Image S RGB Word16 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S RGB Word16 -> m ByteString)
-> (Image S (SRGB 'NonLinear) Word16 -> Image S RGB Word16)
-> Image S (SRGB 'NonLinear) Word16
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (SRGB 'NonLinear) Word16 -> Image S RGB Word16
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (Alpha (SRGB 'NonLinear)) Word8) where
  encodeM :: TIF
-> WriteOptions TIF
-> Image S (Alpha (SRGB 'NonLinear)) Word8
-> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF
-> WriteOptions TIF -> Image S (Alpha RGB) Word8 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S (Alpha RGB) Word8 -> m ByteString)
-> (Image S (Alpha (SRGB 'NonLinear)) Word8
    -> Image S (Alpha RGB) Word8)
-> Image S (Alpha (SRGB 'NonLinear)) Word8
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Alpha (SRGB 'NonLinear)) Word8
-> Image S (Alpha RGB) Word8
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (Alpha (SRGB 'NonLinear)) Word16) where
  encodeM :: TIF
-> WriteOptions TIF
-> Image S (Alpha (SRGB 'NonLinear)) Word16
-> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF
-> WriteOptions TIF -> Image S (Alpha RGB) Word16 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S (Alpha RGB) Word16 -> m ByteString)
-> (Image S (Alpha (SRGB 'NonLinear)) Word16
    -> Image S (Alpha RGB) Word16)
-> Image S (Alpha (SRGB 'NonLinear)) Word16
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Alpha (SRGB 'NonLinear)) Word16
-> Image S (Alpha RGB) Word16
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (Y'CbCr SRGB) Word8) where
  encodeM :: TIF
-> WriteOptions TIF -> Image S (Y'CbCr SRGB) Word8 -> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Image S YCbCr Word8 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S YCbCr Word8 -> m ByteString)
-> (Image S (Y'CbCr SRGB) Word8 -> Image S YCbCr Word8)
-> Image S (Y'CbCr SRGB) Word8
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Y'CbCr SRGB) Word8 -> Image S YCbCr Word8
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (CMYK (SRGB 'NonLinear)) Word8) where
  encodeM :: TIF
-> WriteOptions TIF
-> Image S (CMYK (SRGB 'NonLinear)) Word8
-> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Image S CMYK Word8 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S CMYK Word8 -> m ByteString)
-> (Image S (CMYK (SRGB 'NonLinear)) Word8 -> Image S CMYK Word8)
-> Image S (CMYK (SRGB 'NonLinear)) Word8
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (CMYK (SRGB 'NonLinear)) Word8 -> Image S CMYK Word8
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable TIF (Image S (CMYK (SRGB 'NonLinear)) Word16) where
  encodeM :: TIF
-> WriteOptions TIF
-> Image S (CMYK (SRGB 'NonLinear)) Word16
-> m ByteString
encodeM TIF
f WriteOptions TIF
opts = TIF -> WriteOptions TIF -> Image S CMYK Word16 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
f WriteOptions TIF
opts (Image S CMYK Word16 -> m ByteString)
-> (Image S (CMYK (SRGB 'NonLinear)) Word16 -> Image S CMYK Word16)
-> Image S (CMYK (SRGB 'NonLinear)) Word16
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (CMYK (SRGB 'NonLinear)) Word16 -> Image S CMYK Word16
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel

instance (ColorSpace cs i e, ColorSpace (BaseSpace cs) i e, Source r (Pixel cs e)) =>
         Writable (Auto TIF) (Image r cs e) where
  encodeM :: Auto TIF -> WriteOptions (Auto TIF) -> Image r cs e -> m ByteString
encodeM Auto TIF
f WriteOptions (Auto TIF)
_ = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString)
-> (Image r cs e -> ByteString) -> Image r cs e -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Auto TIF -> Image r cs e -> ByteString
forall r cs i e.
(ColorSpace (BaseSpace cs) i e, ColorSpace cs i e,
 Source r (Pixel cs e)) =>
Auto TIF -> Image r cs e -> ByteString
encodeAutoTIF Auto TIF
f


instance Readable TIF (Image S CM.X Word8) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Matrix S (Pixel X Word8), Metadata TIF)
decodeWithMetadataM = TIF -> ByteString -> m (Matrix S (Pixel X Word8), Metadata TIF)
forall cs e (m :: * -> *).
(ColorModel cs e, MonadThrow m) =>
TIF -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataTIF

instance Readable TIF (Image S CM.X Word16) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S X Word16, Metadata TIF)
decodeWithMetadataM = TIF -> ByteString -> m (Image S X Word16, Metadata TIF)
forall cs e (m :: * -> *).
(ColorModel cs e, MonadThrow m) =>
TIF -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataTIF

instance Readable TIF (Image S CM.X Word32) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S X Word32, Metadata TIF)
decodeWithMetadataM = TIF -> ByteString -> m (Image S X Word32, Metadata TIF)
forall cs e (m :: * -> *).
(ColorModel cs e, MonadThrow m) =>
TIF -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataTIF

instance Readable TIF (Image S CM.X Float) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S X Float, Metadata TIF)
decodeWithMetadataM = TIF -> ByteString -> m (Image S X Float, Metadata TIF)
forall cs e (m :: * -> *).
(ColorModel cs e, MonadThrow m) =>
TIF -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataTIF

instance Readable TIF (Image S (Alpha CM.X) Word8) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S (Alpha X) Word8, Metadata TIF)
decodeWithMetadataM = TIF -> ByteString -> m (Image S (Alpha X) Word8, Metadata TIF)
forall cs e (m :: * -> *).
(ColorModel cs e, MonadThrow m) =>
TIF -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataTIF

instance Readable TIF (Image S (Alpha CM.X) Word16) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S (Alpha X) Word16, Metadata TIF)
decodeWithMetadataM = TIF -> ByteString -> m (Image S (Alpha X) Word16, Metadata TIF)
forall cs e (m :: * -> *).
(ColorModel cs e, MonadThrow m) =>
TIF -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataTIF

instance Readable TIF (Image S CM.RGB Word8) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S RGB Word8, Metadata TIF)
decodeWithMetadataM = TIF -> ByteString -> m (Image S RGB Word8, Metadata TIF)
forall cs e (m :: * -> *).
(ColorModel cs e, MonadThrow m) =>
TIF -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataTIF

instance Readable TIF (Image S CM.RGB Word16) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S RGB Word16, Metadata TIF)
decodeWithMetadataM = TIF -> ByteString -> m (Image S RGB Word16, Metadata TIF)
forall cs e (m :: * -> *).
(ColorModel cs e, MonadThrow m) =>
TIF -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataTIF

instance Readable TIF (Image S (Alpha CM.RGB) Word8) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S (Alpha RGB) Word8, Metadata TIF)
decodeWithMetadataM = TIF -> ByteString -> m (Image S (Alpha RGB) Word8, Metadata TIF)
forall cs e (m :: * -> *).
(ColorModel cs e, MonadThrow m) =>
TIF -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataTIF

instance Readable TIF (Image S (Alpha CM.RGB) Word16) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S (Alpha RGB) Word16, Metadata TIF)
decodeWithMetadataM = TIF -> ByteString -> m (Image S (Alpha RGB) Word16, Metadata TIF)
forall cs e (m :: * -> *).
(ColorModel cs e, MonadThrow m) =>
TIF -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataTIF

instance Readable TIF (Image S CM.CMYK Word8) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S CMYK Word8, Metadata TIF)
decodeWithMetadataM = TIF -> ByteString -> m (Image S CMYK Word8, Metadata TIF)
forall cs e (m :: * -> *).
(ColorModel cs e, MonadThrow m) =>
TIF -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataTIF

instance Readable TIF (Image S CM.CMYK Word16) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S CMYK Word16, Metadata TIF)
decodeWithMetadataM = TIF -> ByteString -> m (Image S CMYK Word16, Metadata TIF)
forall cs e (m :: * -> *).
(ColorModel cs e, MonadThrow m) =>
TIF -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataTIF


instance Readable TIF (Image S (Y' SRGB) Word8) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S (Y' SRGB) Word8, Metadata TIF)
decodeWithMetadataM TIF
f = ((Matrix S (Pixel X Word8), Metadatas)
 -> (Image S (Y' SRGB) Word8, Metadatas))
-> m (Matrix S (Pixel X Word8), Metadatas)
-> m (Image S (Y' SRGB) Word8, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Matrix S (Pixel X Word8) -> Image S (Y' SRGB) Word8)
-> (Matrix S (Pixel X Word8), Metadatas)
-> (Image S (Y' SRGB) Word8, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Matrix S (Pixel X Word8) -> Image S (Y' SRGB) Word8
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Matrix S (Pixel X Word8), Metadatas)
 -> m (Image S (Y' SRGB) Word8, Metadatas))
-> (ByteString -> m (Matrix S (Pixel X Word8), Metadatas))
-> ByteString
-> m (Image S (Y' SRGB) Word8, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Matrix S (Pixel X Word8), Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (Y' SRGB) Word16) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S (Y' SRGB) Word16, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S X Word16, Metadatas)
 -> (Image S (Y' SRGB) Word16, Metadatas))
-> m (Image S X Word16, Metadatas)
-> m (Image S (Y' SRGB) Word16, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S X Word16 -> Image S (Y' SRGB) Word16)
-> (Image S X Word16, Metadatas)
-> (Image S (Y' SRGB) Word16, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S X Word16 -> Image S (Y' SRGB) Word16
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S X Word16, Metadatas)
 -> m (Image S (Y' SRGB) Word16, Metadatas))
-> (ByteString -> m (Image S X Word16, Metadatas))
-> ByteString
-> m (Image S (Y' SRGB) Word16, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S X Word16, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (Y' SRGB) Word32) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S (Y' SRGB) Word32, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S X Word32, Metadatas)
 -> (Image S (Y' SRGB) Word32, Metadatas))
-> m (Image S X Word32, Metadatas)
-> m (Image S (Y' SRGB) Word32, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S X Word32 -> Image S (Y' SRGB) Word32)
-> (Image S X Word32, Metadatas)
-> (Image S (Y' SRGB) Word32, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S X Word32 -> Image S (Y' SRGB) Word32
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S X Word32, Metadatas)
 -> m (Image S (Y' SRGB) Word32, Metadatas))
-> (ByteString -> m (Image S X Word32, Metadatas))
-> ByteString
-> m (Image S (Y' SRGB) Word32, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S X Word32, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (Y' SRGB) Float) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S (Y' SRGB) Float, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S X Float, Metadatas)
 -> (Image S (Y' SRGB) Float, Metadatas))
-> m (Image S X Float, Metadatas)
-> m (Image S (Y' SRGB) Float, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S X Float -> Image S (Y' SRGB) Float)
-> (Image S X Float, Metadatas)
-> (Image S (Y' SRGB) Float, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S X Float -> Image S (Y' SRGB) Float
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S X Float, Metadatas)
 -> m (Image S (Y' SRGB) Float, Metadatas))
-> (ByteString -> m (Image S X Float, Metadatas))
-> ByteString
-> m (Image S (Y' SRGB) Float, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S X Float, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (Alpha (Y' SRGB)) Word8) where
  decodeWithMetadataM :: TIF
-> ByteString -> m (Image S (Alpha (Y' SRGB)) Word8, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S (Alpha X) Word8, Metadatas)
 -> (Image S (Alpha (Y' SRGB)) Word8, Metadatas))
-> m (Image S (Alpha X) Word8, Metadatas)
-> m (Image S (Alpha (Y' SRGB)) Word8, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S (Alpha X) Word8 -> Image S (Alpha (Y' SRGB)) Word8)
-> (Image S (Alpha X) Word8, Metadatas)
-> (Image S (Alpha (Y' SRGB)) Word8, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S (Alpha X) Word8 -> Image S (Alpha (Y' SRGB)) Word8
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S (Alpha X) Word8, Metadatas)
 -> m (Image S (Alpha (Y' SRGB)) Word8, Metadatas))
-> (ByteString -> m (Image S (Alpha X) Word8, Metadatas))
-> ByteString
-> m (Image S (Alpha (Y' SRGB)) Word8, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S (Alpha X) Word8, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (Alpha (Y' SRGB)) Word16) where
  decodeWithMetadataM :: TIF
-> ByteString -> m (Image S (Alpha (Y' SRGB)) Word16, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S (Alpha X) Word16, Metadatas)
 -> (Image S (Alpha (Y' SRGB)) Word16, Metadatas))
-> m (Image S (Alpha X) Word16, Metadatas)
-> m (Image S (Alpha (Y' SRGB)) Word16, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S (Alpha X) Word16 -> Image S (Alpha (Y' SRGB)) Word16)
-> (Image S (Alpha X) Word16, Metadatas)
-> (Image S (Alpha (Y' SRGB)) Word16, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S (Alpha X) Word16 -> Image S (Alpha (Y' SRGB)) Word16
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S (Alpha X) Word16, Metadatas)
 -> m (Image S (Alpha (Y' SRGB)) Word16, Metadatas))
-> (ByteString -> m (Image S (Alpha X) Word16, Metadatas))
-> ByteString
-> m (Image S (Alpha (Y' SRGB)) Word16, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S (Alpha X) Word16, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (Y D65) Word8) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S (Y D65) Word8, Metadata TIF)
decodeWithMetadataM TIF
f = ((Matrix S (Pixel X Word8), Metadatas)
 -> (Image S (Y D65) Word8, Metadatas))
-> m (Matrix S (Pixel X Word8), Metadatas)
-> m (Image S (Y D65) Word8, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Matrix S (Pixel X Word8) -> Image S (Y D65) Word8)
-> (Matrix S (Pixel X Word8), Metadatas)
-> (Image S (Y D65) Word8, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Matrix S (Pixel X Word8) -> Image S (Y D65) Word8
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Matrix S (Pixel X Word8), Metadatas)
 -> m (Image S (Y D65) Word8, Metadatas))
-> (ByteString -> m (Matrix S (Pixel X Word8), Metadatas))
-> ByteString
-> m (Image S (Y D65) Word8, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Matrix S (Pixel X Word8), Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (Y D65) Word16) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S (Y D65) Word16, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S X Word16, Metadatas)
 -> (Image S (Y D65) Word16, Metadatas))
-> m (Image S X Word16, Metadatas)
-> m (Image S (Y D65) Word16, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S X Word16 -> Image S (Y D65) Word16)
-> (Image S X Word16, Metadatas)
-> (Image S (Y D65) Word16, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S X Word16 -> Image S (Y D65) Word16
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S X Word16, Metadatas)
 -> m (Image S (Y D65) Word16, Metadatas))
-> (ByteString -> m (Image S X Word16, Metadatas))
-> ByteString
-> m (Image S (Y D65) Word16, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S X Word16, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (Y D65) Word32) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S (Y D65) Word32, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S X Word32, Metadatas)
 -> (Image S (Y D65) Word32, Metadatas))
-> m (Image S X Word32, Metadatas)
-> m (Image S (Y D65) Word32, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S X Word32 -> Image S (Y D65) Word32)
-> (Image S X Word32, Metadatas)
-> (Image S (Y D65) Word32, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S X Word32 -> Image S (Y D65) Word32
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S X Word32, Metadatas)
 -> m (Image S (Y D65) Word32, Metadatas))
-> (ByteString -> m (Image S X Word32, Metadatas))
-> ByteString
-> m (Image S (Y D65) Word32, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S X Word32, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (Y D65) Float) where
  decodeWithMetadataM :: TIF -> ByteString -> m (Image S (Y D65) Float, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S X Float, Metadatas)
 -> (Image S (Y D65) Float, Metadatas))
-> m (Image S X Float, Metadatas)
-> m (Image S (Y D65) Float, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S X Float -> Image S (Y D65) Float)
-> (Image S X Float, Metadatas)
-> (Image S (Y D65) Float, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S X Float -> Image S (Y D65) Float
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S X Float, Metadatas)
 -> m (Image S (Y D65) Float, Metadatas))
-> (ByteString -> m (Image S X Float, Metadatas))
-> ByteString
-> m (Image S (Y D65) Float, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S X Float, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (Alpha (Y D65)) Word8) where
  decodeWithMetadataM :: TIF
-> ByteString -> m (Image S (Alpha (Y D65)) Word8, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S (Alpha X) Word8, Metadatas)
 -> (Image S (Alpha (Y D65)) Word8, Metadatas))
-> m (Image S (Alpha X) Word8, Metadatas)
-> m (Image S (Alpha (Y D65)) Word8, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S (Alpha X) Word8 -> Image S (Alpha (Y D65)) Word8)
-> (Image S (Alpha X) Word8, Metadatas)
-> (Image S (Alpha (Y D65)) Word8, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S (Alpha X) Word8 -> Image S (Alpha (Y D65)) Word8
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S (Alpha X) Word8, Metadatas)
 -> m (Image S (Alpha (Y D65)) Word8, Metadatas))
-> (ByteString -> m (Image S (Alpha X) Word8, Metadatas))
-> ByteString
-> m (Image S (Alpha (Y D65)) Word8, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S (Alpha X) Word8, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (Alpha (Y D65)) Word16) where
  decodeWithMetadataM :: TIF
-> ByteString -> m (Image S (Alpha (Y D65)) Word16, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S (Alpha X) Word16, Metadatas)
 -> (Image S (Alpha (Y D65)) Word16, Metadatas))
-> m (Image S (Alpha X) Word16, Metadatas)
-> m (Image S (Alpha (Y D65)) Word16, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S (Alpha X) Word16 -> Image S (Alpha (Y D65)) Word16)
-> (Image S (Alpha X) Word16, Metadatas)
-> (Image S (Alpha (Y D65)) Word16, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S (Alpha X) Word16 -> Image S (Alpha (Y D65)) Word16
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S (Alpha X) Word16, Metadatas)
 -> m (Image S (Alpha (Y D65)) Word16, Metadatas))
-> (ByteString -> m (Image S (Alpha X) Word16, Metadatas))
-> ByteString
-> m (Image S (Alpha (Y D65)) Word16, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S (Alpha X) Word16, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (SRGB 'NonLinear) Word8) where
  decodeWithMetadataM :: TIF
-> ByteString -> m (Image S (SRGB 'NonLinear) Word8, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S RGB Word8, Metadatas)
 -> (Image S (SRGB 'NonLinear) Word8, Metadatas))
-> m (Image S RGB Word8, Metadatas)
-> m (Image S (SRGB 'NonLinear) Word8, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S RGB Word8 -> Image S (SRGB 'NonLinear) Word8)
-> (Image S RGB Word8, Metadatas)
-> (Image S (SRGB 'NonLinear) Word8, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S RGB Word8 -> Image S (SRGB 'NonLinear) Word8
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S RGB Word8, Metadatas)
 -> m (Image S (SRGB 'NonLinear) Word8, Metadatas))
-> (ByteString -> m (Image S RGB Word8, Metadatas))
-> ByteString
-> m (Image S (SRGB 'NonLinear) Word8, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S RGB Word8, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (SRGB 'NonLinear) Word16) where
  decodeWithMetadataM :: TIF
-> ByteString -> m (Image S (SRGB 'NonLinear) Word16, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S RGB Word16, Metadatas)
 -> (Image S (SRGB 'NonLinear) Word16, Metadatas))
-> m (Image S RGB Word16, Metadatas)
-> m (Image S (SRGB 'NonLinear) Word16, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S RGB Word16 -> Image S (SRGB 'NonLinear) Word16)
-> (Image S RGB Word16, Metadatas)
-> (Image S (SRGB 'NonLinear) Word16, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S RGB Word16 -> Image S (SRGB 'NonLinear) Word16
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S RGB Word16, Metadatas)
 -> m (Image S (SRGB 'NonLinear) Word16, Metadatas))
-> (ByteString -> m (Image S RGB Word16, Metadatas))
-> ByteString
-> m (Image S (SRGB 'NonLinear) Word16, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S RGB Word16, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (Alpha (SRGB 'NonLinear)) Word8) where
  decodeWithMetadataM :: TIF
-> ByteString
-> m (Image S (Alpha (SRGB 'NonLinear)) Word8, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S (Alpha RGB) Word8, Metadatas)
 -> (Image S (Alpha (SRGB 'NonLinear)) Word8, Metadatas))
-> m (Image S (Alpha RGB) Word8, Metadatas)
-> m (Image S (Alpha (SRGB 'NonLinear)) Word8, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S (Alpha RGB) Word8
 -> Image S (Alpha (SRGB 'NonLinear)) Word8)
-> (Image S (Alpha RGB) Word8, Metadatas)
-> (Image S (Alpha (SRGB 'NonLinear)) Word8, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S (Alpha RGB) Word8
-> Image S (Alpha (SRGB 'NonLinear)) Word8
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S (Alpha RGB) Word8, Metadatas)
 -> m (Image S (Alpha (SRGB 'NonLinear)) Word8, Metadatas))
-> (ByteString -> m (Image S (Alpha RGB) Word8, Metadatas))
-> ByteString
-> m (Image S (Alpha (SRGB 'NonLinear)) Word8, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S (Alpha RGB) Word8, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (Alpha (SRGB 'NonLinear)) Word16) where
  decodeWithMetadataM :: TIF
-> ByteString
-> m (Image S (Alpha (SRGB 'NonLinear)) Word16, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S (Alpha RGB) Word16, Metadatas)
 -> (Image S (Alpha (SRGB 'NonLinear)) Word16, Metadatas))
-> m (Image S (Alpha RGB) Word16, Metadatas)
-> m (Image S (Alpha (SRGB 'NonLinear)) Word16, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S (Alpha RGB) Word16
 -> Image S (Alpha (SRGB 'NonLinear)) Word16)
-> (Image S (Alpha RGB) Word16, Metadatas)
-> (Image S (Alpha (SRGB 'NonLinear)) Word16, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S (Alpha RGB) Word16
-> Image S (Alpha (SRGB 'NonLinear)) Word16
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S (Alpha RGB) Word16, Metadatas)
 -> m (Image S (Alpha (SRGB 'NonLinear)) Word16, Metadatas))
-> (ByteString -> m (Image S (Alpha RGB) Word16, Metadatas))
-> ByteString
-> m (Image S (Alpha (SRGB 'NonLinear)) Word16, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S (Alpha RGB) Word16, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (CMYK (SRGB 'NonLinear)) Word8) where
  decodeWithMetadataM :: TIF
-> ByteString
-> m (Image S (CMYK (SRGB 'NonLinear)) Word8, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S CMYK Word8, Metadatas)
 -> (Image S (CMYK (SRGB 'NonLinear)) Word8, Metadatas))
-> m (Image S CMYK Word8, Metadatas)
-> m (Image S (CMYK (SRGB 'NonLinear)) Word8, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S CMYK Word8 -> Image S (CMYK (SRGB 'NonLinear)) Word8)
-> (Image S CMYK Word8, Metadatas)
-> (Image S (CMYK (SRGB 'NonLinear)) Word8, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S CMYK Word8 -> Image S (CMYK (SRGB 'NonLinear)) Word8
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S CMYK Word8, Metadatas)
 -> m (Image S (CMYK (SRGB 'NonLinear)) Word8, Metadatas))
-> (ByteString -> m (Image S CMYK Word8, Metadatas))
-> ByteString
-> m (Image S (CMYK (SRGB 'NonLinear)) Word8, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S CMYK Word8, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

instance Readable TIF (Image S (CMYK (SRGB 'NonLinear)) Word16) where
  decodeWithMetadataM :: TIF
-> ByteString
-> m (Image S (CMYK (SRGB 'NonLinear)) Word16, Metadata TIF)
decodeWithMetadataM TIF
f = ((Image S CMYK Word16, Metadatas)
 -> (Image S (CMYK (SRGB 'NonLinear)) Word16, Metadatas))
-> m (Image S CMYK Word16, Metadatas)
-> m (Image S (CMYK (SRGB 'NonLinear)) Word16, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S CMYK Word16 -> Image S (CMYK (SRGB 'NonLinear)) Word16)
-> (Image S CMYK Word16, Metadatas)
-> (Image S (CMYK (SRGB 'NonLinear)) Word16, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S CMYK Word16 -> Image S (CMYK (SRGB 'NonLinear)) Word16
forall cs e.
Matrix S (Pixel (BaseModel cs) e) -> Matrix S (Pixel cs e)
fromImageBaseModel) (m (Image S CMYK Word16, Metadatas)
 -> m (Image S (CMYK (SRGB 'NonLinear)) Word16, Metadatas))
-> (ByteString -> m (Image S CMYK Word16, Metadatas))
-> ByteString
-> m (Image S (CMYK (SRGB 'NonLinear)) Word16, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TIF -> ByteString -> m (Image S CMYK Word16, Metadata TIF)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM TIF
f

-- | Decode a Tiff Image
decodeTIF :: (ColorModel cs e, MonadThrow m) => TIF -> B.ByteString -> m (Image S cs e)
decodeTIF :: TIF -> ByteString -> m (Image S cs e)
decodeTIF TIF
f ByteString
bs = TIF -> Either String DynamicImage -> m (Image S cs e)
forall (m :: * -> *) cs e f.
(MonadThrow m, ColorModel cs e, FileFormat f) =>
f -> Either String DynamicImage -> m (Image S cs e)
convertWith TIF
f (ByteString -> Either String DynamicImage
JP.decodeTiff ByteString
bs)
{-# INLINE decodeTIF #-}

-- | Decode a Tiff Image
decodeWithMetadataTIF ::
     (ColorModel cs e, MonadThrow m) => TIF -> B.ByteString -> m (Image S cs e, JP.Metadatas)
decodeWithMetadataTIF :: TIF -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataTIF TIF
f ByteString
bs = TIF
-> Either String (DynamicImage, Metadata TIF)
-> m (Image S cs e, Metadata TIF)
forall (m :: * -> *) cs e f.
(MonadThrow m, ColorModel cs e, FileFormat f) =>
f
-> Either String (DynamicImage, Metadata f)
-> m (Image S cs e, Metadata f)
convertWithMetadata TIF
f (ByteString -> Either String (DynamicImage, Metadatas)
JP.decodeTiffWithMetadata ByteString
bs)
{-# INLINE decodeWithMetadataTIF #-}

-- | Decode a Tiff Image
decodeAutoTIF ::
     (Manifest r (Pixel cs e), ColorSpace cs i e, MonadThrow m)
  => Auto TIF
  -> B.ByteString
  -> m (Image r cs e)
decodeAutoTIF :: Auto TIF -> ByteString -> m (Image r cs e)
decodeAutoTIF Auto TIF
f ByteString
bs = Auto TIF -> Either String DynamicImage -> m (Image r cs e)
forall (m :: * -> *) r cs e i f.
(MonadThrow m, Manifest r (Pixel cs e), ColorSpace cs i e) =>
Auto f -> Either String DynamicImage -> m (Image r cs e)
convertAutoWith Auto TIF
f (ByteString -> Either String DynamicImage
JP.decodeTiff ByteString
bs)
{-# INLINE decodeAutoTIF #-}

-- | Decode a Tiff Image
decodeAutoWithMetadataTIF ::
     (Manifest r (Pixel cs e), ColorSpace cs i e, MonadThrow m)
  => Auto TIF
  -> B.ByteString
  -> m (Image r cs e, JP.Metadatas)
decodeAutoWithMetadataTIF :: Auto TIF -> ByteString -> m (Image r cs e, Metadatas)
decodeAutoWithMetadataTIF Auto TIF
f ByteString
bs = Auto TIF
-> Either String (DynamicImage, Metadata TIF)
-> m (Image r cs e, Metadata TIF)
forall (m :: * -> *) r cs e i f.
(MonadThrow m, Manifest r (Pixel cs e), ColorSpace cs i e) =>
Auto f
-> Either String (DynamicImage, Metadata f)
-> m (Image r cs e, Metadata f)
convertAutoWithMetadata Auto TIF
f (ByteString -> Either String (DynamicImage, Metadatas)
JP.decodeTiffWithMetadata ByteString
bs)
{-# INLINE decodeAutoWithMetadataTIF #-}

instance (Manifest r (Pixel cs e), ColorSpace cs i e) =>
         Readable (Auto TIF) (Image r cs e) where
  decodeM :: Auto TIF -> ByteString -> m (Image r cs e)
decodeM = Auto TIF -> ByteString -> m (Image r cs e)
forall r cs e i (m :: * -> *).
(Manifest r (Pixel cs e), ColorSpace cs i e, MonadThrow m) =>
Auto TIF -> ByteString -> m (Image r cs e)
decodeAutoTIF
  decodeWithMetadataM :: Auto TIF -> ByteString -> m (Image r cs e, Metadata (Auto TIF))
decodeWithMetadataM = Auto TIF -> ByteString -> m (Image r cs e, Metadata (Auto TIF))
forall r cs e i (m :: * -> *).
(Manifest r (Pixel cs e), ColorSpace cs i e, MonadThrow m) =>
Auto TIF -> ByteString -> m (Image r cs e, Metadatas)
decodeAutoWithMetadataTIF

encodeTIF ::
     forall cs e m.
     (ColorModel cs e, MonadThrow m)
  => TIF
  -> Image S cs e
  -> m BL.ByteString
encodeTIF :: TIF -> Image S cs e -> m ByteString
encodeTIF TIF
f Image S cs e
img = TIF -> Proxy (Image S cs e) -> Maybe ByteString -> m ByteString
forall f r cs e b (m :: * -> *).
(ColorModel cs e, FileFormat f, Typeable r, MonadThrow m) =>
f -> Proxy (Image r cs e) -> Maybe b -> m b
fromMaybeEncode TIF
f (Proxy (Image S cs e)
forall k (t :: k). Proxy t
Proxy :: Proxy (Image S cs e)) Maybe ByteString
encoded
  where
    encoded :: Maybe ByteString
encoded
      | Just Pixel cs e :~: Pixel X Bit
Refl <- Maybe (Pixel cs e :~: Pixel X Bit)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (Pixel cs e :~: Pixel CM.X Bit) = TIF -> WriteOptions TIF -> Image S cs e -> Maybe ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM TIF
TIF WriteOptions TIF
forall a. Default a => a
def Image S cs e
img
      | Just e :~: Word8
Refl <- Maybe (e :~: Word8)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Word8) =
        [Maybe ByteString] -> Maybe ByteString
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
          [ Image Word8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image Word8 -> ByteString)
-> Maybe (Image Word8) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S cs Word8 -> Maybe (Image Word8)
forall cs.
(Typeable cs, Storable (Pixel cs Word8)) =>
Image S cs Word8 -> Maybe (Image Word8)
maybeJPImageY8 Image S cs e
Image S cs Word8
img
          , Image PixelRGB8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelRGB8 -> ByteString)
-> Maybe (Image PixelRGB8) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S cs Word8 -> Maybe (Image PixelRGB8)
forall cs.
(Typeable cs, Storable (Pixel cs Word8)) =>
Image S cs Word8 -> Maybe (Image PixelRGB8)
maybeJPImageRGB8 Image S cs e
Image S cs Word8
img
          , do cs :~: Alpha (Opaque cs)
Refl <- Maybe (cs :~: Alpha (Opaque cs))
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (cs :~: Alpha (Opaque cs))
               [Maybe ByteString] -> Maybe ByteString
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Image PixelYA8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelYA8 -> ByteString)
-> Maybe (Image PixelYA8) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S (Alpha (Opaque cs)) Word8 -> Maybe (Image PixelYA8)
forall cs.
(Typeable cs, Storable (Pixel (Alpha cs) Word8)) =>
Image S (Alpha cs) Word8 -> Maybe (Image PixelYA8)
maybeJPImageYA8 Image S cs e
Image S (Alpha (Opaque cs)) Word8
img, Image PixelRGBA8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelRGBA8 -> ByteString)
-> Maybe (Image PixelRGBA8) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S (Alpha (Opaque cs)) Word8 -> Maybe (Image PixelRGBA8)
forall cs.
(Typeable cs, Storable (Pixel (Alpha cs) Word8)) =>
Image S (Alpha cs) Word8 -> Maybe (Image PixelRGBA8)
maybeJPImageRGBA8 Image S cs e
Image S (Alpha (Opaque cs)) Word8
img]
          , Image PixelYCbCr8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelYCbCr8 -> ByteString)
-> Maybe (Image PixelYCbCr8) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S cs Word8 -> Maybe (Image PixelYCbCr8)
forall cs.
(Typeable cs, Storable (Pixel cs Word8)) =>
Image S cs Word8 -> Maybe (Image PixelYCbCr8)
maybeJPImageYCbCr8 Image S cs e
Image S cs Word8
img
          , Image PixelCMYK8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelCMYK8 -> ByteString)
-> Maybe (Image PixelCMYK8) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S cs Word8 -> Maybe (Image PixelCMYK8)
forall cs.
(Typeable cs, Storable (Pixel cs Word8)) =>
Image S cs Word8 -> Maybe (Image PixelCMYK8)
maybeJPImageCMYK8 Image S cs e
Image S cs Word8
img
          ]
      | Just e :~: Word16
Refl <- Maybe (e :~: Word16)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Word16) =
        [Maybe ByteString] -> Maybe ByteString
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
          [ Image Word16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image Word16 -> ByteString)
-> Maybe (Image Word16) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S cs Word16 -> Maybe (Image Word16)
forall cs.
(Typeable cs, Storable (Pixel cs Word16)) =>
Image S cs Word16 -> Maybe (Image Word16)
maybeJPImageY16 Image S cs e
Image S cs Word16
img
          , Image PixelRGB16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelRGB16 -> ByteString)
-> Maybe (Image PixelRGB16) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S cs Word16 -> Maybe (Image PixelRGB16)
forall cs.
(Typeable cs, Storable (Pixel cs Word16)) =>
Image S cs Word16 -> Maybe (Image PixelRGB16)
maybeJPImageRGB16 Image S cs e
Image S cs Word16
img
          , do cs :~: Alpha (Opaque cs)
Refl <- Maybe (cs :~: Alpha (Opaque cs))
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (cs :~: Alpha (Opaque cs))
               [Maybe ByteString] -> Maybe ByteString
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
                 [Image PixelYA16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelYA16 -> ByteString)
-> Maybe (Image PixelYA16) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S (Alpha (Opaque cs)) Word16 -> Maybe (Image PixelYA16)
forall cs.
(Typeable cs, Storable (Pixel (Alpha cs) Word16)) =>
Image S (Alpha cs) Word16 -> Maybe (Image PixelYA16)
maybeJPImageYA16 Image S cs e
Image S (Alpha (Opaque cs)) Word16
img, Image PixelRGBA16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelRGBA16 -> ByteString)
-> Maybe (Image PixelRGBA16) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S (Alpha (Opaque cs)) Word16 -> Maybe (Image PixelRGBA16)
forall cs.
(Typeable cs, Storable (Pixel (Alpha cs) Word16)) =>
Image S (Alpha cs) Word16 -> Maybe (Image PixelRGBA16)
maybeJPImageRGBA16 Image S cs e
Image S (Alpha (Opaque cs)) Word16
img]
          , Image PixelCMYK16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelCMYK16 -> ByteString)
-> Maybe (Image PixelCMYK16) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S cs Word16 -> Maybe (Image PixelCMYK16)
forall cs.
(Typeable cs, Storable (Pixel cs Word16)) =>
Image S cs Word16 -> Maybe (Image PixelCMYK16)
maybeJPImageCMYK16 Image S cs e
Image S cs Word16
img
          ]
      | Just e :~: Word32
Refl <- Maybe (e :~: Word32)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Word32) = Image Word32 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image Word32 -> ByteString)
-> Maybe (Image Word32) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S cs Word32 -> Maybe (Image Word32)
forall cs.
(Typeable cs, Storable (Pixel cs Word32)) =>
Image S cs Word32 -> Maybe (Image Word32)
maybeJPImageY32 Image S cs e
Image S cs Word32
img
      | Just e :~: Float
Refl <- Maybe (e :~: Float)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Float) = Image Float -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image Float -> ByteString)
-> Maybe (Image Float) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S cs Float -> Maybe (Image Float)
forall cs.
(Typeable cs, Storable (Pixel cs Float)) =>
Image S cs Float -> Maybe (Image Float)
maybeJPImageYF Image S cs e
Image S cs Float
img
      | Bool
otherwise = Maybe ByteString
forall a. Maybe a
Nothing



encodeAutoTIF ::
     forall r cs i e. (ColorSpace (BaseSpace cs) i e, ColorSpace cs i e, Source r (Pixel cs e))
  => Auto TIF
  -> Image r cs e
  -> BL.ByteString
encodeAutoTIF :: Auto TIF -> Image r cs e -> ByteString
encodeAutoTIF Auto TIF
_ Image r cs e
img =
  ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ((Array D Ix2 (Pixel RGB Word8) -> Image PixelRGB8)
-> (Pixel cs e -> Pixel RGB Word8) -> Image r cs e -> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel RGB Word8) -> Image PixelRGB8
forall r.
Source r (Pixel RGB Word8) =>
Image r RGB Word8 -> Image PixelRGB8
toJPImageRGB8 Pixel cs e -> Pixel RGB Word8
forall cs i e. ColorSpace cs i e => Pixel cs e -> Pixel RGB Word8
toSRGB8 Image r cs e
img) (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
  [Maybe ByteString] -> Maybe ByteString
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
    [ do r :~: S
Refl <- Maybe (r :~: S)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (r :~: S)
         [Maybe ByteString] -> Maybe ByteString
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
           [ case Maybe (e :~: Word8)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Word8) of
               Just e :~: Word8
Refl
                 | Just BaseModel cs :~: X
Refl <- (Maybe (BaseModel cs :~: X)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: CM.X)) ->
                   ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Image Word8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image Word8 -> ByteString) -> Image Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Matrix S (Pixel X Word8) -> Image Word8
forall r.
Source r (Pixel X Word8) =>
Image r X Word8 -> Image Word8
toJPImageY8 (Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel Image r cs e
Matrix S (Pixel cs e)
img)
                 | Just BaseModel cs :~: RGB
Refl <- (Maybe (BaseModel cs :~: RGB)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: CM.RGB)) ->
                   ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGB8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelRGB8 -> ByteString) -> Image PixelRGB8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image S RGB Word8 -> Image PixelRGB8
forall r.
Source r (Pixel RGB Word8) =>
Image r RGB Word8 -> Image PixelRGB8
toJPImageRGB8 (Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel Image r cs e
Matrix S (Pixel cs e)
img)
                 | Just BaseModel cs :~: YCbCr
Refl <- (Maybe (BaseModel cs :~: YCbCr)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: CM.YCbCr)) ->
                   ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYCbCr8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelYCbCr8 -> ByteString)
-> Image PixelYCbCr8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image S YCbCr Word8 -> Image PixelYCbCr8
forall r.
Source r (Pixel YCbCr Word8) =>
Image r YCbCr Word8 -> Image PixelYCbCr8
toJPImageYCbCr8 (Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel Image r cs e
Matrix S (Pixel cs e)
img)
                 | Just BaseModel cs :~: CMYK
Refl <- (Maybe (BaseModel cs :~: CMYK)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: CM.CMYK)) ->
                   ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelCMYK8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelCMYK8 -> ByteString) -> Image PixelCMYK8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image S CMYK Word8 -> Image PixelCMYK8
forall r.
Source r (Pixel CMYK Word8) =>
Image r CMYK Word8 -> Image PixelCMYK8
toJPImageCMYK8 (Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel Image r cs e
Matrix S (Pixel cs e)
img)
                 | Just BaseModel cs :~: Alpha X
Refl <- (Maybe (BaseModel cs :~: Alpha X)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: Alpha CM.X)) ->
                   ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYA8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelYA8 -> ByteString) -> Image PixelYA8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image S (Alpha X) Word8 -> Image PixelYA8
forall r.
Source r (Pixel (Alpha X) Word8) =>
Image r (Alpha X) Word8 -> Image PixelYA8
toJPImageYA8 (Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel Image r cs e
Matrix S (Pixel cs e)
img)
                 | Just BaseModel cs :~: Alpha RGB
Refl <- (Maybe (BaseModel cs :~: Alpha RGB)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: Alpha CM.RGB)) ->
                   ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBA8 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelRGBA8 -> ByteString) -> Image PixelRGBA8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image S (Alpha RGB) Word8 -> Image PixelRGBA8
forall r.
Source r (Pixel (Alpha RGB) Word8) =>
Image r (Alpha RGB) Word8 -> Image PixelRGBA8
toJPImageRGBA8 (Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel Image r cs e
Matrix S (Pixel cs e)
img)
               Maybe (e :~: Word8)
_ -> Maybe ByteString
forall a. Maybe a
Nothing
           , case Maybe (e :~: Word16)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Word16) of
               Just e :~: Word16
Refl
                 | Just BaseModel cs :~: X
Refl <- (Maybe (BaseModel cs :~: X)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: CM.X)) ->
                   ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Image Word16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image Word16 -> ByteString) -> Image Word16 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image S X Word16 -> Image Word16
forall r.
Source r (Pixel X Word16) =>
Image r X Word16 -> Image Word16
toJPImageY16 (Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel Image r cs e
Matrix S (Pixel cs e)
img)
                 | Just BaseModel cs :~: RGB
Refl <- (Maybe (BaseModel cs :~: RGB)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: CM.RGB)) ->
                   ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGB16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelRGB16 -> ByteString) -> Image PixelRGB16 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image S RGB Word16 -> Image PixelRGB16
forall r.
Source r (Pixel RGB Word16) =>
Image r RGB Word16 -> Image PixelRGB16
toJPImageRGB16 (Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel Image r cs e
Matrix S (Pixel cs e)
img)
                 | Just BaseModel cs :~: CMYK
Refl <- (Maybe (BaseModel cs :~: CMYK)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: CM.CMYK)) ->
                   ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelCMYK16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelCMYK16 -> ByteString)
-> Image PixelCMYK16 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image S CMYK Word16 -> Image PixelCMYK16
forall r.
Source r (Pixel CMYK Word16) =>
Image r CMYK Word16 -> Image PixelCMYK16
toJPImageCMYK16 (Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel Image r cs e
Matrix S (Pixel cs e)
img)
                 | Just BaseModel cs :~: Alpha X
Refl <- (Maybe (BaseModel cs :~: Alpha X)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: Alpha CM.X)) ->
                   ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelYA16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelYA16 -> ByteString) -> Image PixelYA16 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image S (Alpha X) Word16 -> Image PixelYA16
forall r.
Source r (Pixel (Alpha X) Word16) =>
Image r (Alpha X) Word16 -> Image PixelYA16
toJPImageYA16 (Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel Image r cs e
Matrix S (Pixel cs e)
img)
                 | Just BaseModel cs :~: Alpha RGB
Refl <- (Maybe (BaseModel cs :~: Alpha RGB)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: Alpha CM.RGB)) ->
                   ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBA16 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image PixelRGBA16 -> ByteString)
-> Image PixelRGBA16 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image S (Alpha RGB) Word16 -> Image PixelRGBA16
forall r.
Source r (Pixel (Alpha RGB) Word16) =>
Image r (Alpha RGB) Word16 -> Image PixelRGBA16
toJPImageRGBA16 (Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel Image r cs e
Matrix S (Pixel cs e)
img)
               Maybe (e :~: Word16)
_ -> Maybe ByteString
forall a. Maybe a
Nothing
           , do e :~: Word32
Refl <- Maybe (e :~: Word32)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Word32)
                BaseModel cs :~: X
Refl <- Maybe (BaseModel cs :~: X)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: CM.X)
                ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Image Word32 -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image Word32 -> ByteString) -> Image Word32 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image S X Word32 -> Image Word32
forall r.
Source r (Pixel X Word32) =>
Image r X Word32 -> Image Word32
toJPImageY32 (Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel Image r cs e
Matrix S (Pixel cs e)
img)
           , do e :~: Float
Refl <- Maybe (e :~: Float)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Float)
                BaseModel cs :~: X
Refl <- Maybe (BaseModel cs :~: X)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: CM.X)
                ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Image Float -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image Float -> ByteString) -> Image Float -> ByteString
forall a b. (a -> b) -> a -> b
$ Image S X Float -> Image Float
forall r.
Source r (Pixel X Float) =>
Image r X Float -> Image Float
toJPImageYF (Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
forall cs e.
Matrix S (Pixel cs e) -> Matrix S (Pixel (BaseModel cs) e)
toImageBaseModel Image r cs e
Matrix S (Pixel cs e)
img)
           ]
    , do BaseModel cs :~: X
Refl <- Maybe (BaseModel cs :~: X)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: CM.X)
         [Maybe ByteString] -> Maybe ByteString
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
           [ do e :~: Bit
Refl <- Maybe (e :~: Bit)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Bit)
                ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel X Word8) -> Image Word8)
-> (Pixel cs e -> Pixel X Word8) -> Image r cs e -> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel X Word8) -> Image Word8
forall r.
Source r (Pixel X Word8) =>
Image r X Word8 -> Image Word8
toJPImageY8 (Pixel X e -> Pixel X Word8
forall cs e. ColorModel cs e => Pixel cs e -> Pixel cs Word8
toPixel8 (Pixel X e -> Pixel X Word8)
-> (Pixel cs e -> Pixel X e) -> Pixel cs e -> Pixel X Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pixel cs e -> Pixel X e
forall k cs (i :: k) e.
ColorSpace cs i e =>
Pixel cs e -> Pixel (BaseModel cs) e
toPixelBaseModel) Image r cs e
img
           , do e :~: Word8
Refl <- Maybe (e :~: Word8)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Word8)
                ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel X Word8) -> Image Word8)
-> (Pixel cs Word8 -> Pixel X Word8)
-> Array r Ix2 (Pixel cs Word8)
-> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel X Word8) -> Image Word8
forall r.
Source r (Pixel X Word8) =>
Image r X Word8 -> Image Word8
toJPImageY8 Pixel cs Word8 -> Pixel X Word8
forall k cs (i :: k) e.
ColorSpace cs i e =>
Pixel cs e -> Pixel (BaseModel cs) e
toPixelBaseModel Image r cs e
Array r Ix2 (Pixel cs Word8)
img
           , do e :~: Word16
Refl <- Maybe (e :~: Word16)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Word16)
                ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel X Word16) -> Image Word16)
-> (Pixel cs Word16 -> Pixel X Word16)
-> Array r Ix2 (Pixel cs Word16)
-> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel X Word16) -> Image Word16
forall r.
Source r (Pixel X Word16) =>
Image r X Word16 -> Image Word16
toJPImageY16 Pixel cs Word16 -> Pixel X Word16
forall k cs (i :: k) e.
ColorSpace cs i e =>
Pixel cs e -> Pixel (BaseModel cs) e
toPixelBaseModel Image r cs e
Array r Ix2 (Pixel cs Word16)
img
           , do e :~: Word32
Refl <- Maybe (e :~: Word32)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Word32)
                ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel X Word32) -> Image Word32)
-> (Pixel cs Word32 -> Pixel X Word32)
-> Array r Ix2 (Pixel cs Word32)
-> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel X Word32) -> Image Word32
forall r.
Source r (Pixel X Word32) =>
Image r X Word32 -> Image Word32
toJPImageY32 Pixel cs Word32 -> Pixel X Word32
forall k cs (i :: k) e.
ColorSpace cs i e =>
Pixel cs e -> Pixel (BaseModel cs) e
toPixelBaseModel Image r cs e
Array r Ix2 (Pixel cs Word32)
img
           , do e :~: Float
Refl <- Maybe (e :~: Float)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Float)
                ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel X Float) -> Image Float)
-> (Pixel cs Float -> Pixel X Float)
-> Array r Ix2 (Pixel cs Float)
-> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel X Float) -> Image Float
forall r.
Source r (Pixel X Float) =>
Image r X Float -> Image Float
toJPImageYF Pixel cs Float -> Pixel X Float
forall k cs (i :: k) e.
ColorSpace cs i e =>
Pixel cs e -> Pixel (BaseModel cs) e
toPixelBaseModel Image r cs e
Array r Ix2 (Pixel cs Float)
img
           , ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel X Word16) -> Image Word16)
-> (Pixel cs e -> Pixel X Word16) -> Image r cs e -> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel X Word16) -> Image Word16
forall r.
Source r (Pixel X Word16) =>
Image r X Word16 -> Image Word16
toJPImageY16 (Pixel X e -> Pixel X Word16
forall cs e. ColorModel cs e => Pixel cs e -> Pixel cs Word16
toPixel16 (Pixel X e -> Pixel X Word16)
-> (Pixel cs e -> Pixel X e) -> Pixel cs e -> Pixel X Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pixel cs e -> Pixel X e
forall k cs (i :: k) e.
ColorSpace cs i e =>
Pixel cs e -> Pixel (BaseModel cs) e
toPixelBaseModel) Image r cs e
img
           ]
    , do BaseModel cs :~: Alpha X
Refl <- Maybe (BaseModel cs :~: Alpha X)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: Alpha CM.X)
         [Maybe ByteString] -> Maybe ByteString
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
           [ do e :~: Word8
Refl <- Maybe (e :~: Word8)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Word8)
                ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel (Alpha X) Word8) -> Image PixelYA8)
-> (Pixel cs Word8 -> Pixel (Alpha X) Word8)
-> Array r Ix2 (Pixel cs Word8)
-> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel (Alpha X) Word8) -> Image PixelYA8
forall r.
Source r (Pixel (Alpha X) Word8) =>
Image r (Alpha X) Word8 -> Image PixelYA8
toJPImageYA8 Pixel cs Word8 -> Pixel (Alpha X) Word8
forall k cs (i :: k) e.
ColorSpace cs i e =>
Pixel cs e -> Pixel (BaseModel cs) e
toPixelBaseModel Image r cs e
Array r Ix2 (Pixel cs Word8)
img
           , do e :~: Word16
Refl <- Maybe (e :~: Word16)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Word16)
                ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel (Alpha X) Word16) -> Image PixelYA16)
-> (Pixel cs Word16 -> Pixel (Alpha X) Word16)
-> Array r Ix2 (Pixel cs Word16)
-> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel (Alpha X) Word16) -> Image PixelYA16
forall r.
Source r (Pixel (Alpha X) Word16) =>
Image r (Alpha X) Word16 -> Image PixelYA16
toJPImageYA16 Pixel cs Word16 -> Pixel (Alpha X) Word16
forall k cs (i :: k) e.
ColorSpace cs i e =>
Pixel cs e -> Pixel (BaseModel cs) e
toPixelBaseModel Image r cs e
Array r Ix2 (Pixel cs Word16)
img
           , ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel (Alpha X) Word16) -> Image PixelYA16)
-> (Pixel cs e -> Pixel (Alpha X) Word16)
-> Image r cs e
-> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel (Alpha X) Word16) -> Image PixelYA16
forall r.
Source r (Pixel (Alpha X) Word16) =>
Image r (Alpha X) Word16 -> Image PixelYA16
toJPImageYA16 (Pixel (Alpha X) e -> Pixel (Alpha X) Word16
forall cs e. ColorModel cs e => Pixel cs e -> Pixel cs Word16
toPixel16 (Pixel (Alpha X) e -> Pixel (Alpha X) Word16)
-> (Pixel cs e -> Pixel (Alpha X) e)
-> Pixel cs e
-> Pixel (Alpha X) Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pixel cs e -> Pixel (Alpha X) e
forall k cs (i :: k) e.
ColorSpace cs i e =>
Pixel cs e -> Pixel (BaseModel cs) e
toPixelBaseModel) Image r cs e
img
           ]
    , do BaseModel cs :~: YCbCr
Refl <- Maybe (BaseModel cs :~: YCbCr)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: CM.YCbCr)
         ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel YCbCr Word8) -> Image PixelYCbCr8)
-> (Pixel cs e -> Pixel YCbCr Word8) -> Image r cs e -> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel YCbCr Word8) -> Image PixelYCbCr8
forall r.
Source r (Pixel YCbCr Word8) =>
Image r YCbCr Word8 -> Image PixelYCbCr8
toJPImageYCbCr8 Pixel cs e -> Pixel YCbCr Word8
forall cs i e. ColorSpace cs i e => Pixel cs e -> Pixel YCbCr Word8
toYCbCr8 Image r cs e
img
    , do BaseModel cs :~: CMYK
Refl <- Maybe (BaseModel cs :~: CMYK)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: CM.CMYK)
         [Maybe ByteString] -> Maybe ByteString
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
           [ do e :~: Word16
Refl <- Maybe (e :~: Word16)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Word16)
                ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel CMYK Word16) -> Image PixelCMYK16)
-> (Pixel cs e -> Pixel CMYK Word16) -> Image r cs e -> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel CMYK Word16) -> Image PixelCMYK16
forall r.
Source r (Pixel CMYK Word16) =>
Image r CMYK Word16 -> Image PixelCMYK16
toJPImageCMYK16 Pixel cs e -> Pixel CMYK Word16
forall cs i e. ColorSpace cs i e => Pixel cs e -> Pixel CMYK Word16
toCMYK16 Image r cs e
img
             -- for CMYK default is 8bit, instead of 16bit, since many viewers and editors
             -- don't support the latter.
           , ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel CMYK Word8) -> Image PixelCMYK8)
-> (Pixel cs e -> Pixel CMYK Word8) -> Image r cs e -> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel CMYK Word8) -> Image PixelCMYK8
forall r.
Source r (Pixel CMYK Word8) =>
Image r CMYK Word8 -> Image PixelCMYK8
toJPImageCMYK8 Pixel cs e -> Pixel CMYK Word8
forall cs i e. ColorSpace cs i e => Pixel cs e -> Pixel CMYK Word8
toCMYK8 Image r cs e
img
           ]
    , do BaseModel cs :~: RGB
Refl <- Maybe (BaseModel cs :~: RGB)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: CM.RGB)
         [Maybe ByteString] -> Maybe ByteString
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
           [ do e :~: Word8
Refl <- Maybe (e :~: Word8)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Word8)
                ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel RGB Word8) -> Image PixelRGB8)
-> (Pixel cs e -> Pixel RGB Word8) -> Image r cs e -> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel RGB Word8) -> Image PixelRGB8
forall r.
Source r (Pixel RGB Word8) =>
Image r RGB Word8 -> Image PixelRGB8
toJPImageRGB8 Pixel cs e -> Pixel RGB Word8
forall cs i e. ColorSpace cs i e => Pixel cs e -> Pixel RGB Word8
toSRGB8 Image r cs e
img
           , ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel RGB Word16) -> Image PixelRGB16)
-> (Pixel cs e -> Pixel RGB Word16) -> Image r cs e -> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel RGB Word16) -> Image PixelRGB16
forall r.
Source r (Pixel RGB Word16) =>
Image r RGB Word16 -> Image PixelRGB16
toJPImageRGB16 Pixel cs e -> Pixel RGB Word16
forall cs i e. ColorSpace cs i e => Pixel cs e -> Pixel RGB Word16
toSRGB16 Image r cs e
img
           ]
    , do cs :~: Alpha (Opaque cs)
Refl <- Maybe (cs :~: Alpha (Opaque cs))
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (cs :~: Alpha (Opaque cs))
         [Maybe ByteString] -> Maybe ByteString
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
           [ do e :~: Word8
Refl <- Maybe (e :~: Word8)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Word8)
                ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel (Alpha RGB) Word8) -> Image PixelRGBA8)
-> (Pixel cs e -> Pixel (Alpha RGB) Word8)
-> Image r cs e
-> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel (Alpha RGB) Word8) -> Image PixelRGBA8
forall r.
Source r (Pixel (Alpha RGB) Word8) =>
Image r (Alpha RGB) Word8 -> Image PixelRGBA8
toJPImageRGBA8 Pixel cs e -> Pixel (Alpha RGB) Word8
forall cs i e.
ColorSpace cs i e =>
Pixel cs e -> Pixel (Alpha RGB) Word8
toSRGBA8 Image r cs e
img
           , ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel (Alpha RGB) Word16) -> Image PixelRGBA16)
-> (Pixel cs e -> Pixel (Alpha RGB) Word16)
-> Image r cs e
-> ByteString
forall px a ix b.
(TiffSaveable px, Source r a, Index ix) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D Ix2 (Pixel (Alpha RGB) Word16) -> Image PixelRGBA16
forall r.
Source r (Pixel (Alpha RGB) Word16) =>
Image r (Alpha RGB) Word16 -> Image PixelRGBA16
toJPImageRGBA16 Pixel cs e -> Pixel (Alpha RGB) Word16
forall cs i e.
ColorSpace cs i e =>
Pixel cs e -> Pixel (Alpha RGB) Word16
toSRGBA16 Image r cs e
img
           ]
    ]
  where
    toTiff ::
         (JP.TiffSaveable px, Source r a, Index ix)
      => (Array D ix b -> JP.Image px)
      -> (a -> b)
      -> Array r ix a
      -> BL.ByteString
    toTiff :: (Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toTiff Array D ix b -> Image px
toJP a -> b
adjustPixel = Image px -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
JP.encodeTiff (Image px -> ByteString)
-> (Array r ix a -> Image px) -> Array r ix a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array D ix b -> Image px
toJP (Array D ix b -> Image px)
-> (Array r ix a -> Array D ix b) -> Array r ix a -> Image px
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Array r ix a -> Array D ix b
forall ix r e' e.
(Index ix, Source r e') =>
(e' -> e) -> Array r ix e' -> Array D ix e
A.map a -> b
adjustPixel