hip 1.5.1.0 → 1.5.2.0

raw patch · 35 files changed

+2234/−2022 lines, 35 filesbinary-addedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• benchmarks/Canny.hs +1/−0
• hip.cabal +9/−3
• images/downloaded/strawberry.gif binary
• images/strawberry.gif binary
• images/strawberry_backwards.gif too large to diff
• src/Graphics/Image.hs +17/−15
• src/Graphics/Image/ColorSpace.hs +577/−299
• src/Graphics/Image/ColorSpace/Binary.hs +21/−27
• src/Graphics/Image/ColorSpace/CMYK.hs +6/−38
• src/Graphics/Image/ColorSpace/Complex.hs +3/−3
• src/Graphics/Image/ColorSpace/HSI.hs +6/−40
• src/Graphics/Image/ColorSpace/RGB.hs +5/−199
• src/Graphics/Image/ColorSpace/X.hs +33/−8
• src/Graphics/Image/ColorSpace/Y.hs +6/−32
• src/Graphics/Image/ColorSpace/YCbCr.hs +7/−41
• src/Graphics/Image/IO.hs +131/−64
• src/Graphics/Image/IO/Base.hs +19/−0
• src/Graphics/Image/IO/Formats.hs +7/−5
• src/Graphics/Image/IO/Formats/JuicyPixels.hs +0/−1076
• src/Graphics/Image/IO/Formats/JuicyPixels/Common.hs +112/−0
• src/Graphics/Image/IO/Formats/JuicyPixels/Readable.hs +568/−0
• src/Graphics/Image/IO/Formats/JuicyPixels/Writable.hs +305/−0
• src/Graphics/Image/IO/Formats/Netpbm.hs +33/−99
• src/Graphics/Image/Interface.hs +7/−40
• src/Graphics/Image/Interface/Elevator.hs +317/−0
• src/Graphics/Image/Interface/Repa/Generic.hs +6/−4
• src/Graphics/Image/Interface/Repa/Storable.hs +6/−4
• src/Graphics/Image/Interface/Repa/Unboxed.hs +6/−4
• src/Graphics/Image/Interface/Vector/Generic.hs +5/−3
• src/Graphics/Image/Interface/Vector/Storable.hs +3/−1
• src/Graphics/Image/Interface/Vector/Unboxed.hs +3/−1
• src/Graphics/Image/Processing/Convolution.hs +3/−3
• tests/Graphics/Image/ColorSpaceSpec.hs +1/−13
• tests/Graphics/Image/IO/FormatsSpec.hs +1/−0

@@ -1,3 +1,11 @@+1.5.2.0+=======++* Fixed `Storable` instance for some Pixel types.+* Fixed reading/writing animated GIFs. Added a detailed example to documentation.+* Improved encodeing/decoding of images.+* Improved coversion between `ColorSpace`s. + 1.5.1.0 ======= @@ -102,3 +110,5 @@  * Made it compatible with GHC >= 7.4 (#1) * Added histogram plotting using Charts++

@@ -78,6 +78,7 @@ main = do   -- img' <- readImageRGB RPU "images/frog.jpg"   -- let !imgU = compute img'+  let _foo = GIFALooping   let !imgU = compute $ makeImage (1024, 768)               (\(i, j) -> fromIntegral ((min i j) `div` (1 + max i j )))               :: Image RPU Y Word8

@@ -1,5 +1,5 @@ Name:              hip-Version:           1.5.1.0+Version:           1.5.2.0 License:           BSD3 License-File:      LICENSE Author:            Alexey Kuleshevich@@ -20,6 +20,8 @@ Build-Type:        Simple Extra-Doc-Files:   images/*.jpg                  , images/*.png+                 , images/*.gif+                 , images/downloaded/*.gif                  , images/*.svg                  , README.md                    CHANGELOG.md@@ -74,8 +76,11 @@                  , Graphics.Image.ColorSpace.Y                  , Graphics.Image.ColorSpace.YCbCr                  , Graphics.Image.IO.Base-                 , Graphics.Image.IO.Formats.JuicyPixels+                 , Graphics.Image.IO.Formats.JuicyPixels.Common+                 , Graphics.Image.IO.Formats.JuicyPixels.Readable+                 , Graphics.Image.IO.Formats.JuicyPixels.Writable                  , Graphics.Image.IO.Formats.Netpbm+                 , Graphics.Image.Interface.Elevator                  , Graphics.Image.Interface.Repa.Generic                  , Graphics.Image.Interface.Repa.Storable                  , Graphics.Image.Interface.Repa.Unboxed@@ -118,7 +123,7 @@   GHC-Options:        -Wall -threaded -with-rtsopts=-N  -benchmark convolution-benchmarks+benchmark convolution   type:                exitcode-stdio-1.0   hs-source-dirs:      benchmarks   main-is:             Canny.hs@@ -131,6 +136,7 @@                      , hip   default-language:    Haskell2010 +                        Source-Repository head   Type:     git   Location: https://github.com/lehins/hip.git

binary file changed (absent → 984646 bytes)

binary file changed (absent → 1865329 bytes)

file too large to diff

@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-duplicate-exports #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} -- |@@ -65,27 +65,28 @@   --   makeImageR, makeImage, fromListsR, fromLists, toLists,   -- * IO+  module Graphics.Image.IO,   -- ** Reading   -- | Read supported files into an 'Image' with pixels in 'Double'   -- precision. In order to read an image in a different representation, color   -- space or precision, use 'readImage' or 'readImageExact' from-  -- <Graphics-Image-IO.html Graphics.Image.IO> instead. While reading an-  -- image, it's underlying representation can be specified by passing one of-  -- `VU`, `RSU` or `RPU` as the first argument to @readImage*@ functions. Here is-  -- a quick demonstration of how two images can be read as different-  -- representations and later easily combined as their average.+  -- <Graphics-Image-IO.html Graphics.Image.IO> instead. While reading an image,+  -- it's underlying representation can be specified by passing one of `VU`,+  -- `VS`, `RSU`, `RPU`, `RSS` or `RSU` as the first argument to @readImage*@+  -- functions. Here is a quick demonstration of how two images can be read as+  -- different representations and later easily combined as their average.   ---  -- >>> cluster <- readImageRGB RPU "images/cluster.jpg"+  -- >>> cluster <- readImageRGB VU "images/cluster.jpg"   -- >>> displayImage cluster   -- >>> centaurus <- readImageRGB VU "images/centaurus.jpg"   -- >>> displayImage centaurus-  -- >>> displayImage ((cluster + exchange RPU centaurus) / 2)+  -- >>> displayImage ((cluster + centaurus) / 2)   --   -- <<images/cluster.jpg>> <<images/centaurus.jpg>> <<images/centaurus_and_cluster.jpg>>   ---  readImageY, readImageYA, readImageRGB, readImageRGBA, readImageExact,+  readImageY, readImageYA, readImageRGB, readImageRGBA,   -- ** Writing-  writeImage, writeImageExact, displayImage,+  writeImage, displayImage,   -- * Accessors   -- ** Dimensions   rows, cols, dims,@@ -109,7 +110,7 @@ import qualified Data.Foldable as F import Graphics.Image.ColorSpace import Graphics.Image.IO-import Graphics.Image.Interface as I+import Graphics.Image.Interface as I hiding (Pixel) import Graphics.Image.Types as IP  import Graphics.Image.Processing as IP@@ -150,25 +151,25 @@  -- | Read image as luma (brightness). readImageY :: Array arr Y Double => arr -> FilePath -> IO (Image arr Y Double)-readImageY _ = fmap (either error id) . readImage+readImageY _ = readImage' {-# INLINE readImageY #-}   -- | Read image as luma with 'Alpha' channel. readImageYA :: Array arr YA Double => arr -> FilePath -> IO (Image arr YA Double)-readImageYA _ = fmap (either error id) . readImage+readImageYA _ = readImage' {-# INLINE readImageYA #-}   -- | Read image in RGB colorspace. readImageRGB :: Array arr RGB Double => arr -> FilePath -> IO (Image arr RGB Double)-readImageRGB _ = fmap (either error id) . readImage+readImageRGB _ = readImage' {-# INLINE readImageRGB #-}   -- | Read image in RGB colorspace with 'Alpha' channel. readImageRGBA :: Array arr RGBA Double => arr -> FilePath -> IO (Image arr RGBA Double)-readImageRGBA _ = fmap (either error id) . readImage+readImageRGBA _ = readImage' {-# INLINE readImageRGBA #-}  @@ -247,6 +248,7 @@ -- supplied representation. fromListsR :: Array arr cs e => arr -> [[Pixel cs e]] -> Image arr cs e fromListsR _ = fromLists+{-# INLINE fromListsR #-}  -- | Generates a nested list of pixels from an image. --

@@ -5,6 +5,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-} #if __GLASGOW_HASKELL__ >= 800   {-# OPTIONS_GHC -Wno-redundant-constraints #-} #endif@@ -17,36 +19,100 @@ -- Portability : non-portable -- module Graphics.Image.ColorSpace (-  -- * ColorSpace-  ColorSpace, Pixel(..), AlphaSpace(..), Elevator(..),-  -- * Operations on Pixels-  eqTolPx,-  -- * Luma-  module Graphics.Image.ColorSpace.Y,-  -- * RGB-  module Graphics.Image.ColorSpace.RGB,-  -- * HSI-  module Graphics.Image.ColorSpace.HSI,-  -- * CMYK-  module Graphics.Image.ColorSpace.CMYK,-  -- * YCbCr-  module Graphics.Image.ColorSpace.YCbCr,-  -- * Gray level-  module Graphics.Image.ColorSpace.X,-  -- * Binary-  Binary, Bit, on, off, isOn, isOff, fromBool, complement,+  -- * Pixels+  -- ** Family of Pixels+  -- | Pixel is a type family for all available color spaces. Below will be+  -- listed all class instances pixels are installed in, as well as all pixel+  -- constructors.+  --+  -- >>> :t (PixelY 0) -- Black pixel in Luma+  -- (PixelY 0) :: Num e => Pixel Y e+  -- >>> PixelRGB 255 0 0 :: Pixel RGB Word8 -- Red pixel in RGB+  -- <RGB:(255|0|0)>+  -- >>> PixelRGB 1 0 0 :: Pixel RGB Double -- Same red pixel in RGB with Double precision.+  -- <RGB:(1.0|0.0|0.0)>+  -- >>> (PixelRGB 255 0 0 :: Pixel RGB Word8) == (toWord8 <$> (PixelRGB 1 0 0 :: Pixel RGB Double))+  -- True+  --+  Pixel(..),+  -- ** Luma (gray scale)+  -- | Conversion to Luma from other color spaces.+  toPixelY, toImageY,+  toPixelYA, toImageYA,+  -- ** RGB+  -- | Conversion to RGB from other color spaces.+  toPixelRGB, toImageRGB,+  toPixelRGBA, toImageRGBA,+  -- ** HSI+  -- | Conversion to HSI from other color spaces.+  toPixelHSI, toImageHSI,+  toPixelHSIA, toImageHSIA,+  -- ** CMYK+  -- | Conversion to CMYK from other color spaces.+  toPixelCMYK, toImageCMYK,+  toPixelCMYKA, toImageCMYKA,+  -- ** YCbCr+  -- | Conversion to YCbCr from other color spaces.+  toPixelYCbCr, toImageYCbCr,+  toPixelYCbCrA, toImageYCbCrA,+  -- ** Binary+  -- | This is a Binary colorspace, pixel's of which can be created using+  -- these __/constructors/__:+  --+  --   [@'on'@] Represents value @1@ or 'True'. It's a foreground pixel and is+  --   displayed in black.+  --+  --   [@'off'@] Represents value @0@ or 'False'. It's a background pixel and is+  --   displayed in white.+  --+  -- Note, that values are inverted before writing to or reading from file, since+  -- grayscale images represent black as a @0@ value and white as @1@ on a+  -- @[0,1]@ scale.+  --+  -- Binary pixels also behave as binary numbers with a size of 1-bit, for instance:+  --+  -- >>> on + on -- equivalent to: 1 .|. 1+  -- <Binary:(1)>+  -- >>> (on + on) * off -- equivalent to: (1 .|. 1) .&. 0+  -- <Binary:(0)>+  -- >>> (on + on) - on+  -- <Binary:(0)>+  --+  on, off, isOn, isOff, one, zero, fromBool, complement,   toPixelBinary, fromPixelBinary, toImageBinary, fromImageBinary,-  -- * Complex+  -- ** Complex   module Graphics.Image.ColorSpace.Complex,-  -- * Re-exports+  -- ** X+  toPixelsX, fromPixelsX,+  toImagesX, fromImagesX,+  -- * ColorSpace+  -- ** Operations on Pixels+  eqTolPx,+  -- ** Luma+  Y(..), YA(..),+  ToY, ToYA,+  -- ** RGB+  RGB(..), RGBA(..),+  ToRGB, ToRGBA,+  -- ** HSI+  HSI(..), HSIA(..),+  ToHSI, ToHSIA,+  -- ** CMYK+  CMYK(..), CMYKA(..),+  ToCMYK, ToCMYKA,+  -- ** YCbCr+  YCbCr(..), YCbCrA(..),+  ToYCbCr, ToYCbCrA,+  -- ** Binary+  Binary(..), Bit, +  -- ** X+  X(..),+  -- * Useful re-exports   Word8, Word16, Word32, Word64   ) where -import qualified Data.Complex as C import Data.Word-import Data.Int-import GHC.Float-import Graphics.Image.Interface hiding (map)+import Graphics.Image.Interface as I import Graphics.Image.ColorSpace.Binary import Graphics.Image.ColorSpace.RGB import Graphics.Image.ColorSpace.HSI@@ -55,16 +121,16 @@ import Graphics.Image.ColorSpace.Y import Graphics.Image.ColorSpace.YCbCr import Graphics.Image.ColorSpace.Complex-import qualified Graphics.Image.Interface as I (map)   -- Binary: --- | Convert any pixel to binary pixel.-toPixelBinary :: (Eq (Pixel cs e), Num (Pixel cs e))-                 => Pixel cs e -> Pixel Binary Bit-toPixelBinary px = if px == 0 then on else off-{-# INLINE toPixelBinary #-}+-- | Convert to a `Binary` image.+toImageBinary :: (Array arr cs e, Array arr Binary Bit) =>+                 Image arr cs e+              -> Image arr Binary Bit+toImageBinary = I.map toPixelBinary+{-# INLINE toImageBinary #-}  -- | Convert a Binary pixel to Luma pixel fromPixelBinary :: Pixel Binary Bit -> Pixel Y Word8@@ -72,14 +138,6 @@ {-# INLINE fromPixelBinary #-}  --- | Convert any image to binary image.-toImageBinary :: (Array arr cs e, Array arr Binary Bit, Eq (Pixel cs e)) =>-                 Image arr cs e-              -> Image arr Binary Bit-toImageBinary = I.map toPixelBinary-{-# INLINE toImageBinary #-}-- -- | Convert a Binary image to Luma image fromImageBinary :: (Array arr Binary Bit, Array arr Y Word8) =>                    Image arr Binary Bit@@ -97,43 +155,163 @@         {-# INLINE comp #-} {-# INLINE eqTolPx #-} +-- ToY -instance ToY X where-  toPixelY (PixelX y) = PixelY y+-- | Conversion to Luma color space.+class ColorSpace cs e => ToY cs e where++  -- | Convert a pixel to Luma pixel.+  toPixelY :: Pixel cs e -> Pixel Y Double++-- | Convert an image to Luma image.+toImageY :: (ToY cs e, Array arr cs e, Array arr Y Double) =>+            Image arr cs e+         -> Image arr Y Double+toImageY = I.map toPixelY+{-# INLINE toImageY #-}+++instance Elevator e => ToY X e where+  toPixelY (PixelX y) = PixelY $ toDouble y   {-# INLINE toPixelY #-} +instance ToY Binary Bit where+  toPixelY (PixelBinary b) = PixelY $ toDouble b+  {-# INLINE toPixelY #-}++instance Elevator e => ToY Y e where+  toPixelY (PixelY y) = PixelY $ toDouble y+  {-# INLINE toPixelY #-}++instance Elevator e => ToY YA e where+  toPixelY (PixelYA y _) = PixelY $ toDouble y+  {-# INLINE toPixelY #-}+ -- | Computes Luma: @ Y' = 0.299 * R' + 0.587 * G' + 0.114 * B' @-instance ToY RGB where-  toPixelY (PixelRGB r g b) = PixelY (0.299*r + 0.587*g + 0.114*b)+instance Elevator e => ToY RGB e where+  toPixelY (fmap toDouble -> (PixelRGB r g b)) = PixelY (0.299*r + 0.587*g + 0.114*b)   {-# INLINE toPixelY #-} -instance ToYA RGBA where+instance Elevator e => ToY RGBA e where+  toPixelY = toPixelY . dropAlpha+  {-# INLINE toPixelY #-} -instance ToY HSI where-  toPixelY = toPixelY . toPixelRGB+instance Elevator e => ToY HSI e where+  toPixelY = toPixelY . toPixelRGB . fmap toDouble   {-# INLINE toPixelY #-} -instance ToYA HSIA where+instance Elevator e => ToY HSIA e where+  toPixelY = toPixelY . dropAlpha+  {-# INLINE toPixelY #-} -instance ToY CMYK where-  toPixelY = toPixelY . toPixelRGB+instance Elevator e => ToY CMYK e where+  toPixelY = toPixelY . toPixelRGB . fmap toDouble   {-# INLINE toPixelY #-} -  -instance ToY YCbCr where-  toPixelY (PixelYCbCr y _ _) = PixelY y+instance Elevator e => ToY CMYKA e where+  toPixelY = toPixelY . toPixelRGB . fmap toDouble . dropAlpha   {-# INLINE toPixelY #-}-  -instance ToYA YCbCrA where-  -instance ToRGB Y where-  toPixelRGB (PixelY g) = promote g++instance Elevator e => ToY YCbCr e where+  toPixelY (PixelYCbCr y _ _) = PixelY $ toDouble y+  {-# INLINE toPixelY #-}++instance Elevator e => ToY YCbCrA e where+  toPixelY (PixelYCbCrA y _ _ _) = PixelY $ toDouble y+  {-# INLINE toPixelY #-}+++-- ToYA++-- | Conversion to Luma from another color space.+class ToY cs e => ToYA cs e where++  -- | Convert a pixel to Luma pixel with Alpha.+  toPixelYA :: Pixel cs e -> Pixel YA Double+  toPixelYA = addAlpha 1 . toPixelY+  {-# INLINE toPixelYA #-}++-- | Convert an image to Luma image with Alpha.+toImageYA :: (ToYA cs e, Array arr cs e, Array arr YA Double) =>+             Image arr cs e+          -> Image arr YA Double+toImageYA = I.map toPixelYA+{-# INLINE toImageYA #-}++                                +instance ToY Y e => ToYA Y e++instance ToYA Binary Bit where+  toPixelYA(PixelBinary b) = PixelYA (toDouble b) 1+  {-# INLINE toPixelYA #-}++instance Elevator e => ToYA YA e where+  toPixelYA = fmap toDouble+  {-# INLINE toPixelYA #-}++instance ToY RGB e => ToYA RGB e++instance Elevator e => ToYA RGBA e where+  toPixelYA !px = addAlpha (toDouble $ getAlpha px) (toPixelY (dropAlpha px))+  {-# INLINE toPixelYA #-}++instance ToY HSI e => ToYA HSI e++instance Elevator e => ToYA HSIA e where+  toPixelYA !px = addAlpha (toDouble $ getAlpha px) (toPixelY (dropAlpha px))+  {-# INLINE toPixelYA #-}++instance ToY CMYK e => ToYA CMYK e++instance Elevator e => ToYA CMYKA e where+  toPixelYA !px = addAlpha (toDouble $ getAlpha px) (toPixelY (dropAlpha px))+  {-# INLINE toPixelYA #-}++instance ToY YCbCr e => ToYA YCbCr e++instance Elevator e => ToYA YCbCrA e where+  toPixelYA !px = addAlpha (toDouble $ getAlpha px) (toPixelY (dropAlpha px))+  {-# INLINE toPixelYA #-}++-- ToRGB+++-- | Conversion to `RGB` color space.+class ColorSpace cs e => ToRGB cs e where++  -- | Convert to an `RGB` pixel.+  toPixelRGB :: Pixel cs e -> Pixel RGB Double++-- | Convert to an `RGB` image.+toImageRGB :: (ToRGB cs e, Array arr cs e, Array arr RGB Double) =>+              Image arr cs e+           -> Image arr RGB Double+toImageRGB = I.map toPixelRGB+{-# INLINE toImageRGB #-}+++instance ToRGB Binary Bit where+  toPixelRGB (PixelBinary b) = pure $ toDouble b   {-# INLINE toPixelRGB #-} -instance ToRGBA YA where+instance Elevator e => ToRGB Y e where+  toPixelRGB (PixelY g) = promote $ toDouble g+  {-# INLINE toPixelRGB #-} -instance ToRGB HSI where-  toPixelRGB (PixelHSI h' s i) = getRGB (h'*2*pi) where+instance Elevator e => ToRGB YA e where+  toPixelRGB = toPixelRGB . dropAlpha+  {-# INLINE toPixelRGB #-}++instance Elevator e => ToRGB RGB e where+  toPixelRGB = fmap toDouble+  {-# INLINE toPixelRGB #-}++instance Elevator e => ToRGB RGBA e where+  toPixelRGB = fmap toDouble . dropAlpha+  {-# INLINE toPixelRGB #-}++instance Elevator e => ToRGB HSI e where+  toPixelRGB (fmap toDouble -> PixelHSI h' s i) = getRGB (h'*2*pi) where     !is = i*s     !second = i - is     getFirst !a !b = i + is*cos a/cos b@@ -158,38 +336,111 @@     {-# INLINE getRGB #-}   {-# INLINE toPixelRGB #-} -instance ToRGBA HSIA where+instance Elevator e => ToRGB HSIA e where+  toPixelRGB = toPixelRGB . dropAlpha+  {-# INLINE toPixelRGB #-}  -instance ToRGB YCbCr where--  toPixelRGB (PixelYCbCr y cb cr) = PixelRGB r g b where+instance Elevator e => ToRGB YCbCr e where+  toPixelRGB (fmap toDouble -> PixelYCbCr y cb cr) = PixelRGB r g b where     !r = y                      +   1.402*(cr - 0.5)     !g = y - 0.34414*(cb - 0.5) - 0.71414*(cr - 0.5)     !b = y +   1.772*(cb - 0.5)   {-# INLINE toPixelRGB #-} -instance ToRGBA YCbCrA where--instance ToRGB CMYK where+instance Elevator e => ToRGB YCbCrA e where+  toPixelRGB = toPixelRGB . dropAlpha+  {-# INLINE toPixelRGB #-} -  toPixelRGB (PixelCMYK c m y k) = PixelRGB r g b where+instance Elevator e => ToRGB CMYK e where+  toPixelRGB (fmap toDouble -> PixelCMYK c m y k) = PixelRGB r g b where     !r = (1-c)*(1-k)     !g = (1-m)*(1-k)     !b = (1-y)*(1-k)   {-# INLINE toPixelRGB #-}-  -instance ToRGBA CMYKA where +instance Elevator e => ToRGB CMYKA e where+  toPixelRGB = toPixelRGB . dropAlpha+  {-# INLINE toPixelRGB #-}+++-- ToRGBA++-- | Conversion to `RGBA` from another color space with Alpha channel.+class ToRGB cs e => ToRGBA cs e where++  -- | Convert to an `RGBA` pixel.+  toPixelRGBA :: Pixel cs e -> Pixel RGBA Double+  toPixelRGBA = addAlpha 1 . toPixelRGB+  {-# INLINE toPixelRGBA #-}++-- | Convert to an `RGBA` image.+toImageRGBA :: (ToRGBA cs e, Array arr cs e, Array arr RGBA Double) =>+              Image arr cs e+           -> Image arr RGBA Double+toImageRGBA = I.map toPixelRGBA+{-# INLINE toImageRGBA #-}+++instance ToRGBA Binary Bit++instance ToRGB Y e => ToRGBA Y e++instance Elevator e => ToRGBA YA e where+  toPixelRGBA !px = addAlpha (toDouble $ getAlpha px) (toPixelRGB (dropAlpha px))+  {-# INLINE toPixelRGBA #-}++instance ToRGB RGB e => ToRGBA RGB e++instance Elevator e => ToRGBA RGBA e where+  toPixelRGBA = fmap toDouble+  {-# INLINE toPixelRGBA #-}++instance ToRGB HSI e => ToRGBA HSI e++instance Elevator e => ToRGBA HSIA e where+  toPixelRGBA !px = addAlpha (toDouble $ getAlpha px) (toPixelRGB (dropAlpha px))+  {-# INLINE toPixelRGBA #-}++instance ToRGB CMYK e => ToRGBA CMYK e++instance Elevator e => ToRGBA CMYKA e where+  toPixelRGBA !px = addAlpha (toDouble $ getAlpha px) (toPixelRGB (dropAlpha px))+  {-# INLINE toPixelRGBA #-}++instance ToRGB YCbCr e => ToRGBA YCbCr e++instance Elevator e => ToRGBA YCbCrA e where+  toPixelRGBA !px = addAlpha (toDouble $ getAlpha px) (toPixelRGB (dropAlpha px))+  {-# INLINE toPixelRGBA #-}+++-- ToHSI++-- | Conversion to `HSI` color space.+class ColorSpace cs e => ToHSI cs e where++  -- | Convert to an `HSI` pixel.+  toPixelHSI :: Pixel cs e -> Pixel HSI Double++-- | Convert to an `HSI` image.+toImageHSI :: (ToHSI cs e, Array arr cs e, Array arr HSI Double) =>+              Image arr cs e+           -> Image arr HSI Double+toImageHSI = I.map toPixelHSI+{-# INLINE toImageHSI #-}+   -instance ToHSI Y where-  toPixelHSI (PixelY g) = PixelHSI 0 0 g+instance Elevator e => ToHSI Y e where+  toPixelHSI (PixelY y) = PixelHSI 0 0 $ toDouble y   {-# INLINE toPixelHSI #-} -instance ToHSIA YA where-  -instance ToHSI RGB where-  toPixelHSI (PixelRGB r g b) = PixelHSI h s i where+instance Elevator e => ToHSI YA e where+  toPixelHSI = toPixelHSI . dropAlpha+  {-# INLINE toPixelHSI #-}++instance Elevator e => ToHSI RGB e where+  toPixelHSI (fmap toDouble -> PixelRGB r g b) = PixelHSI h s i where     !h' = atan2 y x     !h = (if h' < 0 then h' + 2*pi else h') / (2*pi)     !s = if i == 0 then 0 else 1 - minimum [r, g, b] / i@@ -197,281 +448,308 @@     !x = (2*r - g - b) / 2.449489742783178     !y = (g - b) / 1.4142135623730951   {-# INLINE toPixelHSI #-}-    -instance ToHSIA RGBA where +instance Elevator e => ToHSI RGBA e where+  toPixelHSI = toPixelHSI . dropAlpha+  {-# INLINE toPixelHSI #-} -instance ToYCbCr RGB where+instance Elevator e => ToHSI HSI e where+  toPixelHSI = fmap toDouble+  {-# INLINE toPixelHSI #-} -  toPixelYCbCr (PixelRGB r g b) = PixelYCbCr y cb cr where-    !y  =          0.299*r +    0.587*g +    0.114*b-    !cb = 0.5 - 0.168736*r - 0.331264*g +      0.5*b-    !cr = 0.5 +      0.5*r - 0.418688*g - 0.081312*b-  {-# INLINE toPixelYCbCr #-}+instance Elevator e => ToHSI HSIA e where+  toPixelHSI = toPixelHSI . dropAlpha+  {-# INLINE toPixelHSI #-} -instance ToYCbCrA RGBA where-  +instance Elevator e => ToHSI YCbCr e where+  toPixelHSI = toPixelHSI . toPixelRGB+  {-# INLINE toPixelHSI #-} -instance ToCMYK RGB where+instance Elevator e => ToHSI YCbCrA e where+  toPixelHSI = toPixelHSI . dropAlpha+  {-# INLINE toPixelHSI #-} -  toPixelCMYK (PixelRGB r g b) = PixelCMYK c m y k where+instance Elevator e => ToHSI CMYK e where+  toPixelHSI = toPixelHSI . toPixelRGB+  {-# INLINE toPixelHSI #-}++instance Elevator e => ToHSI CMYKA e where+  toPixelHSI = toPixelHSI . dropAlpha+  {-# INLINE toPixelHSI #-}+++-- ToHSIA++-- | Conversion to `HSIA` from another color space with Alpha channel.+class ToHSI cs e => ToHSIA cs e where++  -- | Convert to an `HSIA` pixel.+  toPixelHSIA :: Pixel cs e -> Pixel HSIA Double+  toPixelHSIA = addAlpha 1 . toPixelHSI+  {-# INLINE toPixelHSIA #-}++-- | Convert to an `HSIA` image.+toImageHSIA :: (ToHSIA cs e, Array arr cs e, Array arr HSIA Double) =>+               Image arr cs e+            -> Image arr HSIA Double+toImageHSIA = I.map toPixelHSIA+{-# INLINE toImageHSIA #-}+++instance ToHSI Y e => ToHSIA Y e++instance Elevator e => ToHSIA YA e where+  toPixelHSIA !px = addAlpha (toDouble $ getAlpha px) (toPixelHSI (dropAlpha px))+  {-# INLINE toPixelHSIA #-}++instance ToHSI RGB e => ToHSIA RGB e++instance Elevator e => ToHSIA RGBA e where+  toPixelHSIA !px = addAlpha (toDouble $ getAlpha px) (toPixelHSI (dropAlpha px))+  {-# INLINE toPixelHSIA #-}++instance ToHSI HSI e => ToHSIA HSI e++instance Elevator e => ToHSIA HSIA e where+  toPixelHSIA = fmap toDouble+  {-# INLINE toPixelHSIA #-}++instance ToHSI CMYK e => ToHSIA CMYK e++instance Elevator e => ToHSIA CMYKA e where+  toPixelHSIA !px = addAlpha (toDouble $ getAlpha px) (toPixelHSI (dropAlpha px))+  {-# INLINE toPixelHSIA #-}++instance ToHSI YCbCr e => ToHSIA YCbCr e++instance Elevator e => ToHSIA YCbCrA e where+  toPixelHSIA !px = addAlpha (toDouble $ getAlpha px) (toPixelHSI (dropAlpha px))+  {-# INLINE toPixelHSIA #-}++++-- ToCMYK++-- | Conversion to `CMYK` color space.+class ColorSpace cs e => ToCMYK cs e where++  -- | Convert to a `CMYK` pixel.+  toPixelCMYK :: Pixel cs e -> Pixel CMYK Double++-- | Convert to a `CMYK` image.+toImageCMYK :: (ToCMYK cs e, Array arr cs e, Array arr CMYK Double) =>+               Image arr cs e+            -> Image arr CMYK Double+toImageCMYK = I.map toPixelCMYK+{-# INLINE toImageCMYK #-}+++instance Elevator e => ToCMYK Y e where+  toPixelCMYK = toPixelCMYK . toPixelRGB+  {-# INLINE toPixelCMYK #-}++instance Elevator e => ToCMYK YA e where+  toPixelCMYK = toPixelCMYK . dropAlpha+  {-# INLINE toPixelCMYK #-}++instance Elevator e => ToCMYK RGB e where+  toPixelCMYK (fmap toDouble -> PixelRGB r g b) = PixelCMYK c m y k where     !c = (1 - r - k)/(1 - k)     !m = (1 - g - k)/(1 - k)     !y = (1 - b - k)/(1 - k)     !k = 1 - max r (max g b)+  {-# INLINE toPixelCMYK #-} -instance ToCMYKA RGBA where+instance Elevator e => ToCMYK RGBA e where+  toPixelCMYK = toPixelCMYK . dropAlpha+  {-# INLINE toPixelCMYK #-} +instance Elevator e => ToCMYK HSI e where+  toPixelCMYK = toPixelCMYK . toPixelRGB+  {-# INLINE toPixelCMYK #-} -dropDown :: forall a b. (Integral a, Bounded a, Integral b, Bounded b) => a -> b-dropDown !e = fromIntegral $ fromIntegral e `div` ((maxBound :: a) `div`-                                                   fromIntegral (maxBound :: b)) -{-# INLINE dropDown #-}+instance Elevator e => ToCMYK HSIA e where+  toPixelCMYK = toPixelCMYK . dropAlpha+  {-# INLINE toPixelCMYK #-} -raiseUp :: forall a b. (Integral a, Bounded a, Integral b, Bounded b) => a -> b-raiseUp !e = fromIntegral e * ((maxBound :: b) `div` fromIntegral (maxBound :: a))-{-# INLINE raiseUp #-}+instance Elevator e => ToCMYK CMYK e where+  toPixelCMYK = fmap toDouble+  {-# INLINE toPixelCMYK #-} +instance Elevator e => ToCMYK CMYKA e where+  toPixelCMYK = toPixelCMYK . dropAlpha+  {-# INLINE toPixelCMYK #-} -squashTo1 :: forall a b. (Fractional b, Integral a, Bounded a) => a -> b-squashTo1 !e = fromIntegral e / fromIntegral (maxBound :: a)-{-# INLINE squashTo1 #-}+instance Elevator e => ToCMYK YCbCr e where+  toPixelCMYK = toPixelCMYK . toPixelRGB+  {-# INLINE toPixelCMYK #-} -stretch :: forall a b. (RealFrac a, Floating a, Integral b, Bounded b) => a -> b-stretch !e = round (fromIntegral (maxBound :: b) * clamp01 e)+instance Elevator e => ToCMYK YCbCrA e where+  toPixelCMYK = toPixelCMYK . dropAlpha+  {-# INLINE toPixelCMYK #-}  --- | Clamp a value to @[0, 1]@ range.-clamp01 :: (Ord a, Floating a) => a -> a-clamp01 !x = min (max 0 x) 1-{-# INLINE clamp01 #-}+-- ToCMYKA +-- | Conversion to `CMYKA`.+class ToCMYK cs e => ToCMYKA cs e where -instance Elevator Word8 where+  -- | Convert to a `CMYKA` pixel.+  toPixelCMYKA :: Pixel cs e -> Pixel CMYKA Double+  toPixelCMYKA = addAlpha 1 . toPixelCMYK+  {-# INLINE toPixelCMYKA #-} -  toWord8 = id-  {-# INLINE toWord8 #-}-  toWord16 = raiseUp-  {-# INLINE toWord16 #-}-  toWord32 = raiseUp-  {-# INLINE toWord32 #-}-  toWord64 = raiseUp-  {-# INLINE toWord64 #-}-  toFloat = squashTo1-  {-# INLINE toFloat #-}-  toDouble = squashTo1-  {-# INLINE toDouble #-}-  fromDouble = toWord8-  {-# INLINE fromDouble #-}+-- | Convert to a `CMYKA` image.+toImageCMYKA :: (ToCMYKA cs e, Array arr cs e, Array arr CMYKA Double) =>+                Image arr cs e+             -> Image arr CMYKA Double+toImageCMYKA = I.map toPixelCMYKA+{-# INLINE toImageCMYKA #-}  -instance Elevator Word16 where+instance ToCMYK Y e => ToCMYKA Y e -  toWord8 = dropDown-  {-# INLINE toWord8 #-}-  toWord16 = id-  {-# INLINE toWord16 #-}-  toWord32 = raiseUp-  {-# INLINE toWord32 #-}-  toWord64 = raiseUp-  {-# INLINE toWord64 #-}-  toFloat = squashTo1-  {-# INLINE toFloat #-}-  toDouble = squashTo1-  {-# INLINE toDouble #-}-  fromDouble = toWord16-  {-# INLINE fromDouble #-}+instance Elevator e => ToCMYKA YA e where+  toPixelCMYKA !px = addAlpha (toDouble $ getAlpha px) (toPixelCMYK (dropAlpha px))+  {-# INLINE toPixelCMYKA #-} +instance ToCMYK RGB e => ToCMYKA RGB e -instance Elevator Word32 where+instance Elevator e => ToCMYKA RGBA e where+  toPixelCMYKA !px = addAlpha (toDouble $ getAlpha px) (toPixelCMYK (dropAlpha px))+  {-# INLINE toPixelCMYKA #-} -  toWord8 = dropDown-  {-# INLINE toWord8 #-}-  toWord16 = dropDown-  {-# INLINE toWord16 #-}-  toWord32 = id-  {-# INLINE toWord32 #-}-  toWord64 = raiseUp-  {-# INLINE toWord64 #-}-  toFloat = squashTo1-  {-# INLINE toFloat #-}-  toDouble = squashTo1-  {-# INLINE toDouble #-}-  fromDouble = toWord32-  {-# INLINE fromDouble #-}+instance ToCMYK HSI e => ToCMYKA HSI e +instance Elevator e => ToCMYKA HSIA e where+  toPixelCMYKA !px = addAlpha (toDouble $ getAlpha px) (toPixelCMYK (dropAlpha px))+  {-# INLINE toPixelCMYKA #-} -instance Elevator Word64 where+instance ToCMYK CMYK e => ToCMYKA CMYK e -  toWord8 = dropDown-  {-# INLINE toWord8 #-}-  toWord16 = dropDown-  {-# INLINE toWord16 #-}-  toWord32 = dropDown-  {-# INLINE toWord32 #-}-  toWord64 = id-  {-# INLINE toWord64 #-}-  toFloat = squashTo1-  {-# INLINE toFloat #-}-  toDouble = squashTo1-  {-# INLINE toDouble #-}-  fromDouble = toWord64-  {-# INLINE fromDouble #-}+instance Elevator e => ToCMYKA CMYKA e where+  toPixelCMYKA = fmap toDouble+  {-# INLINE toPixelCMYKA #-} +instance ToCMYK YCbCr e => ToCMYKA YCbCr e -instance Elevator Word where+instance Elevator e => ToCMYKA YCbCrA e where+  toPixelCMYKA !px = addAlpha (toDouble $ getAlpha px) (toPixelCMYK (dropAlpha px))+  {-# INLINE toPixelCMYKA #-} -  toWord8 = dropDown-  {-# INLINE toWord8 #-}-  toWord16 = dropDown-  {-# INLINE toWord16 #-}-  toWord32 = dropDown-  {-# INLINE toWord32 #-}-  toWord64 = fromIntegral-  {-# INLINE toWord64 #-}-  toFloat = squashTo1-  {-# INLINE toFloat #-}-  toDouble = squashTo1-  {-# INLINE toDouble #-}-  fromDouble = stretch . clamp01-  {-# INLINE fromDouble #-}  -instance Elevator Int8 where -  toWord8 = fromIntegral . (max 0)-  {-# INLINE toWord8 #-}-  toWord16 = raiseUp . (max 0)-  {-# INLINE toWord16 #-}-  toWord32 = raiseUp . (max 0)-  {-# INLINE toWord32 #-}-  toWord64 = raiseUp . (max 0)-  {-# INLINE toWord64 #-}-  toFloat = squashTo1 . (max 0)-  {-# INLINE toFloat #-}-  toDouble = squashTo1 . (max 0)-  {-# INLINE toDouble #-}-  fromDouble = stretch . clamp01-  {-# INLINE fromDouble #-}+-- ToYCbCr +-- | Conversion to `YCbCr` color space.+class ColorSpace cs e => ToYCbCr cs e where -instance Elevator Int16 where+  -- | Convert to an `YCbCr` pixel.+  toPixelYCbCr :: Pixel cs e -> Pixel YCbCr Double -  toWord8 = dropDown . (max 0)-  {-# INLINE toWord8 #-}-  toWord16 = fromIntegral . (max 0)-  {-# INLINE toWord16 #-}-  toWord32 = raiseUp . (max 0)-  {-# INLINE toWord32 #-}-  toWord64 = raiseUp . (max 0)-  {-# INLINE toWord64 #-}-  toFloat = squashTo1 . (max 0)-  {-# INLINE toFloat #-}-  toDouble = squashTo1 . (max 0)-  {-# INLINE toDouble #-}-  fromDouble = stretch . clamp01-  {-# INLINE fromDouble #-}+-- | Convert to an `YCbCr` image.+toImageYCbCr :: (ToYCbCr cs e, Array arr cs e, Array arr YCbCr Double) =>+                Image arr cs e+             -> Image arr YCbCr Double+toImageYCbCr = I.map toPixelYCbCr+{-# INLINE toImageYCbCr #-}  -instance Elevator Int32 where -  toWord8 = dropDown . (max 0)-  {-# INLINE toWord8 #-}-  toWord16 = dropDown . (max 0)-  {-# INLINE toWord16 #-}-  toWord32 = fromIntegral . (max 0)-  {-# INLINE toWord32 #-}-  toWord64 = raiseUp . (max 0)-  {-# INLINE toWord64 #-}-  toFloat = squashTo1 . (max 0)-  {-# INLINE toFloat #-}-  toDouble = squashTo1 . (max 0)-  {-# INLINE toDouble #-}-  fromDouble = stretch . clamp01-  {-# INLINE fromDouble #-}+instance Elevator e => ToYCbCr Y e where+  toPixelYCbCr = toPixelYCbCr . toPixelRGB+  {-# INLINE toPixelYCbCr #-} +instance Elevator e => ToYCbCr YA e where+  toPixelYCbCr = toPixelYCbCr . dropAlpha+  {-# INLINE toPixelYCbCr #-} -instance Elevator Int64 where+instance Elevator e => ToYCbCr RGB e where+  toPixelYCbCr (fmap toDouble -> PixelRGB r g b) = PixelYCbCr y cb cr where+    !y  =          0.299*r +    0.587*g +    0.114*b+    !cb = 0.5 - 0.168736*r - 0.331264*g +      0.5*b+    !cr = 0.5 +      0.5*r - 0.418688*g - 0.081312*b+  {-# INLINE toPixelYCbCr #-} -  toWord8 = dropDown . (max 0)-  {-# INLINE toWord8 #-}-  toWord16 = dropDown . (max 0)-  {-# INLINE toWord16 #-}-  toWord32 = dropDown . (max 0)-  {-# INLINE toWord32 #-}-  toWord64 = fromIntegral . (max 0)-  {-# INLINE toWord64 #-}-  toFloat = squashTo1 . (max 0)-  {-# INLINE toFloat #-}-  toDouble = squashTo1 . (max 0)-  {-# INLINE toDouble #-}-  fromDouble = stretch . clamp01-  {-# INLINE fromDouble #-}+instance Elevator e => ToYCbCr RGBA e where+  toPixelYCbCr = toPixelYCbCr . dropAlpha+  {-# INLINE toPixelYCbCr #-} +instance Elevator e => ToYCbCr HSI e where+  toPixelYCbCr = toPixelYCbCr . toPixelRGB+  {-# INLINE toPixelYCbCr #-} -instance Elevator Int where+instance Elevator e => ToYCbCr HSIA e where+  toPixelYCbCr = toPixelYCbCr . dropAlpha+  {-# INLINE toPixelYCbCr #-} -  toWord8 = dropDown . (max 0)-  {-# INLINE toWord8 #-}-  toWord16 = dropDown . (max 0)-  {-# INLINE toWord16 #-}-  toWord32 = dropDown . (max 0)-  {-# INLINE toWord32 #-}-  toWord64 = fromIntegral . (max 0)-  {-# INLINE toWord64 #-}-  toFloat = squashTo1 . (max 0)-  {-# INLINE toFloat #-}-  toDouble = squashTo1 . (max 0)-  {-# INLINE toDouble #-}-  fromDouble = stretch . clamp01-  {-# INLINE fromDouble #-}+instance Elevator e => ToYCbCr YCbCr e where+  toPixelYCbCr = fmap toDouble+  {-# INLINE toPixelYCbCr #-} +instance Elevator e => ToYCbCr YCbCrA e where+  toPixelYCbCr = toPixelYCbCr . dropAlpha+  {-# INLINE toPixelYCbCr #-} -instance Elevator Float where-  toWord8 = stretch . clamp01-  {-# INLINE toWord8 #-}-  toWord16 = stretch . clamp01-  {-# INLINE toWord16 #-}-  toWord32 = stretch . clamp01-  {-# INLINE toWord32 #-}-  toWord64 = stretch . clamp01-  {-# INLINE toWord64 #-}-  toFloat = id-  {-# INLINE toFloat #-}-  toDouble = float2Double-  {-# INLINE toDouble #-}-  fromDouble = toFloat-  {-# INLINE fromDouble #-}+instance Elevator e => ToYCbCr CMYK e where+  toPixelYCbCr = toPixelYCbCr . toPixelRGB+  {-# INLINE toPixelYCbCr #-} -instance Elevator Double where-  toWord8 = stretch . clamp01-  {-# INLINE toWord8 #-}-  toWord16 = stretch . clamp01-  {-# INLINE toWord16 #-}-  toWord32 = stretch . clamp01-  {-# INLINE toWord32 #-}-  toWord64 = stretch . clamp01-  {-# INLINE toWord64 #-}-  toFloat = double2Float-  {-# INLINE toFloat #-}-  toDouble = id-  {-# INLINE toDouble #-}-  fromDouble = id-  {-# INLINE fromDouble #-}+instance Elevator e => ToYCbCr CMYKA e where+  toPixelYCbCr = toPixelYCbCr . dropAlpha+  {-# INLINE toPixelYCbCr #-}  -instance (Num e, Elevator e, RealFloat e) => Elevator (C.Complex e) where-  toWord8 = toWord8 . C.realPart-  {-# INLINE toWord8 #-}-  toWord16 = toWord16 . C.realPart-  {-# INLINE toWord16 #-}-  toWord32 = toWord32 . C.realPart-  {-# INLINE toWord32 #-}-  toWord64 = toWord64 . C.realPart-  {-# INLINE toWord64 #-}-  toFloat = toFloat . C.realPart-  {-# INLINE toFloat #-}-  toDouble = toDouble . C.realPart-  {-# INLINE toDouble #-}-  fromDouble = (C.:+ 0) . fromDouble-  {-# INLINE fromDouble #-}+-- ToYCbCrA+++-- | Conversion to `YCbCrA` from another color space with Alpha channel.+class ToYCbCr cs e => ToYCbCrA cs e where++  -- | Convert to an `YCbCrA` pixel.+  toPixelYCbCrA :: Pixel cs e -> Pixel YCbCrA Double+  toPixelYCbCrA = addAlpha 1 . toPixelYCbCr+  {-# INLINE toPixelYCbCrA #-}++-- | Convert to an `YCbCrA` image.+toImageYCbCrA :: (ToYCbCrA cs e, Array arr cs e, Array arr YCbCrA Double) =>+                 Image arr cs e+              -> Image arr YCbCrA Double+toImageYCbCrA = I.map toPixelYCbCrA+{-# INLINE toImageYCbCrA #-}++ ++instance ToYCbCr Y e => ToYCbCrA Y e++instance Elevator e => ToYCbCrA YA e where+  toPixelYCbCrA !px = addAlpha (toDouble $ getAlpha px) (toPixelYCbCr (dropAlpha px))+  {-# INLINE toPixelYCbCrA #-}++instance ToYCbCr RGB e => ToYCbCrA RGB e+++instance ToYCbCr HSI e => ToYCbCrA HSI e++instance Elevator e => ToYCbCrA HSIA e where+  toPixelYCbCrA !px = addAlpha (toDouble $ getAlpha px) (toPixelYCbCr (dropAlpha px))+  {-# INLINE toPixelYCbCrA #-}++instance Elevator e => ToYCbCrA RGBA e where+  toPixelYCbCrA !px = addAlpha (toDouble $ getAlpha px) (toPixelYCbCr (dropAlpha px))+  {-# INLINE toPixelYCbCrA #-}++instance ToYCbCr CMYK e => ToYCbCrA CMYK e++instance Elevator e => ToYCbCrA CMYKA e where+  toPixelYCbCrA !px = addAlpha (toDouble $ getAlpha px) (toPixelYCbCr (dropAlpha px))+  {-# INLINE toPixelYCbCrA #-}++instance ToYCbCr YCbCr e => ToYCbCrA YCbCr e++instance Elevator e => ToYCbCrA YCbCrA e where+  toPixelYCbCrA = fmap toDouble+  {-# INLINE toPixelYCbCrA #-}++

@@ -15,7 +15,8 @@ -- Portability : non-portable -- module Graphics.Image.ColorSpace.Binary (-  Binary(..), Bit(..), on, off, isOn, isOff, fromBool,+  Binary(..), Bit(..), Pixel(..), on, off, isOn, isOff, fromBool, zero, one,+  toPixelBinary,   module Data.Bits   ) where @@ -23,37 +24,16 @@ import Control.Monad import Data.Bits import Data.Word (Word8)-import Graphics.Image.Interface import Data.Typeable (Typeable) import Foreign.Ptr import Foreign.Storable import qualified Data.Vector.Generic            as V import qualified Data.Vector.Generic.Mutable    as M import qualified Data.Vector.Unboxed            as U+import Graphics.Image.Interface  --- | This is a Binary colorspace, pixel's of which can be created using--- these __/constructors/__:------   [@'on'@] Represents value @1@ or 'True'. It's a foreground pixel and is---   displayed in black.------   [@'off'@] Represents value @0@ or 'False'. It's a background pixel and is---   displayed in white.------ Note, that values are inverted before writing to or reading from file, since--- grayscale images represent black as a @0@ value and white as @1@ on a--- @[0,1]@ scale.------ Binary pixels also behave as binary numbers with a size of 1-bit, for instance:------ >>> on + on -- equivalent to: 1 .|. 1--- <Binary:(1)>--- >>> (on + on) * off -- equivalent to: (1 .|. 1) .&. 0--- <Binary:(0)>--- >>> (on + on) - on--- <Binary:(0)>---+-- | Binary Color Space, also known as bi-tonal. data Binary = Binary deriving (Eq, Enum, Bounded, Show, Typeable)  @@ -63,6 +43,12 @@  newtype instance Pixel Binary Bit = PixelBinary Bit deriving (Ord, Eq) ++-- | Convert to a `Binary` pixel.+toPixelBinary :: ColorSpace cs e => Pixel cs e -> Pixel Binary Bit+toPixelBinary px = if px == 0 then on else off++ instance Show (Pixel Binary Bit) where   show (PixelBinary (Bit 0)) = "<Binary:(0)>"   show _                     = "<Binary:(1)>"@@ -140,17 +126,25 @@   popCount _                     = 1  +zero :: Bit+zero = Bit 0+{-# INLINE zero #-}++one :: Bit+one = Bit 1+{-# INLINE one #-}+ -- | Represents value 'True' or @1@ in binary. Often also called a foreground -- pixel of an object. on :: Pixel Binary Bit-on = PixelBinary (Bit 1)+on = PixelBinary one {-# INLINE on #-}   -- | Represents value 'False' or @0@ in binary. Often also called a background -- pixel. off :: Pixel Binary Bit-off = PixelBinary (Bit 0)+off = PixelBinary zero {-# INLINE off #-}  @@ -203,7 +197,7 @@   foldlPx2 f !z (PixelBinary b1) (PixelBinary b2) = f z b1 b2   {-# INLINE foldlPx2 #-} -+-- | Values: @0@ and @1@ instance Elevator Bit where   toWord8 (Bit 0) = 0   toWord8 _       = maxBound

@@ -14,8 +14,7 @@ -- Portability : non-portable -- module Graphics.Image.ColorSpace.CMYK (-  CMYK(..), CMYKA(..), Pixel(..), -  ToCMYK(..), ToCMYKA(..)+  CMYK(..), CMYKA(..), Pixel(..)   ) where  import Prelude hiding (map)@@ -24,7 +23,6 @@ import Data.Typeable (Typeable) import Foreign.Ptr import Foreign.Storable- import Graphics.Image.Interface  ------------@@ -45,7 +43,7 @@  data instance Pixel CMYK e = PixelCMYK !e !e !e !e deriving Eq -instance (Elevator e, Typeable e) => ColorSpace CMYK e where+instance Elevator e => ColorSpace CMYK e where   type Components CMYK e = (e, e, e, e)      fromComponents !(c, m, y, k) = PixelCMYK c m y k@@ -98,7 +96,7 @@  instance Storable e => Storable (Pixel CMYK e) where -  sizeOf _ = 3 * sizeOf (undefined :: e)+  sizeOf _ = 4 * sizeOf (undefined :: e)   alignment _ = alignment (undefined :: e)   peek p = do     q <- return $ castPtr p@@ -127,36 +125,6 @@            deriving (Eq, Enum, Show, Bounded, Typeable)  --- | Conversion to `CMYK` color space.-class ColorSpace cs Double => ToCMYK cs where--  -- | Convert to a `CMYK` pixel.-  toPixelCMYK :: Pixel cs Double -> Pixel CMYK Double--  -- | Convert to a `CMYK` image.-  toImageCMYK :: (Array arr cs Double, Array arr CMYK Double) =>-                 Image arr cs Double-              -> Image arr CMYK Double-  toImageCMYK = map toPixelCMYK-  {-# INLINE toImageCMYK #-}------ | Conversion to `CMYKA` from another color space with Alpha channel.-class (ToCMYK (Opaque cs), AlphaSpace cs Double) => ToCMYKA cs where--  -- | Convert to a `CMYKA` pixel.-  toPixelCMYKA :: Pixel cs Double -> Pixel CMYKA Double-  toPixelCMYKA px = addAlpha (getAlpha px) (toPixelCMYK (dropAlpha px))-  {-# INLINE toPixelCMYKA #-}--  -- | Convert to a `CMYKA` image.-  toImageCMYKA :: (Array arr cs Double, Array arr CMYKA Double) =>-                  Image arr cs Double-               -> Image arr CMYKA Double-  toImageCMYKA = map toPixelCMYKA-  {-# INLINE toImageCMYKA #-}- data instance Pixel CMYKA e = PixelCMYKA !e !e !e !e !e deriving Eq  @@ -165,7 +133,7 @@     "<CMYKA:("++show c++"|"++show m++"|"++show y++"|"++show k++"|"++show a++")>"  -instance (Elevator e, Typeable e) => ColorSpace CMYKA e where+instance Elevator e => ColorSpace CMYKA e where   type Components CMYKA e = (e, e, e, e, e)      fromComponents !(c, m, y, k, a) = PixelCMYKA c m y k a@@ -200,7 +168,7 @@   {-# INLINE foldlPx2 #-}  -instance (Elevator e, Typeable e) => AlphaSpace CMYKA e where+instance Elevator e => AlphaSpace CMYKA e where   type Opaque CMYKA = CMYK    getAlpha (PixelCMYKA _ _ _ _ a) = a@@ -233,7 +201,7 @@  instance Storable e => Storable (Pixel CMYKA e) where -  sizeOf _ = 3 * sizeOf (undefined :: e)+  sizeOf _ = 5 * sizeOf (undefined :: e)   alignment _ = alignment (undefined :: e)   peek p = do     q <- return $ castPtr p

@@ -13,11 +13,11 @@ -- Portability : non-portable -- module Graphics.Image.ColorSpace.Complex (-  -- ** Rectangular form+  -- *** Rectangular form   Complex(..), (+:), realPart, imagPart,-  -- ** Polar form+  -- *** Polar form   mkPolar, cis, polar, magnitude, phase,-  -- ** Conjugate+  -- *** Conjugate   conjugate   ) where 

@@ -14,8 +14,7 @@ -- Portability : non-portable -- module Graphics.Image.ColorSpace.HSI (-  HSI(..), HSIA(..), Pixel(..), -  ToHSI(..), ToHSIA(..)+  HSI(..), HSIA(..), Pixel(..)   ) where  import Prelude hiding (map)@@ -24,7 +23,6 @@ import Data.Typeable (Typeable) import Foreign.Ptr import Foreign.Storable- import Graphics.Image.Interface  -----------@@ -39,12 +37,12 @@  data instance Pixel HSI e = PixelHSI !e !e !e deriving Eq -  + instance Show e => Show (Pixel HSI e) where   show (PixelHSI h s i) = "<HSI:("++show h++"|"++show s++"|"++show i++")>"  -instance (Elevator e, Typeable e) => ColorSpace HSI e where+instance Elevator e => ColorSpace HSI e where   type Components HSI e = (e, e, e)    toComponents (PixelHSI h s i) = (h, s, i)@@ -122,26 +120,11 @@ data instance Pixel HSIA e = PixelHSIA !e !e !e !e deriving Eq  --- | Conversion to `HSI` color space.-class ColorSpace cs Double => ToHSI cs where--  -- | Convert to an `HSI` pixel.-  toPixelHSI :: Pixel cs Double -> Pixel HSI Double--  -- | Convert to an `HSI` image.-  toImageHSI :: (Array arr cs Double, Array arr HSI Double) =>-                Image arr cs Double-             -> Image arr HSI Double-  toImageHSI = map toPixelHSI-  {-# INLINE toImageHSI #-}---  instance Show e => Show (Pixel HSIA e) where   show (PixelHSIA h s i a) = "<HSIA:("++show h++"|"++show s++"|"++show i++"|"++show a++")>"  -instance (Elevator e, Typeable e) => ColorSpace HSIA e where+instance Elevator e => ColorSpace HSIA e where   type Components HSIA e = (e, e, e, e)    toComponents (PixelHSIA h s i a) = (h, s, i, a)@@ -174,7 +157,7 @@   {-# INLINE foldlPx2 #-}  -instance (Elevator e, Typeable e) => AlphaSpace HSIA e where+instance Elevator e => AlphaSpace HSIA e where   type Opaque HSIA = HSI    getAlpha (PixelHSIA _ _ _ a) = a@@ -185,22 +168,6 @@   {-# INLINE dropAlpha #-}  --- | Conversion to `HSIA` from another color space with Alpha channel.-class (ToHSI (Opaque cs), AlphaSpace cs Double) => ToHSIA cs where--  -- | Convert to an `HSIA` pixel.-  toPixelHSIA :: Pixel cs Double -> Pixel HSIA Double-  toPixelHSIA px = addAlpha (getAlpha px) (toPixelHSI (dropAlpha px))-  {-# INLINE toPixelHSIA #-}--  -- | Convert to an `HSIA` image.-  toImageHSIA :: (Array arr cs Double, Array arr HSIA Double) =>-                 Image arr cs Double-              -> Image arr HSIA Double-  toImageHSIA = map toPixelHSIA-  {-# INLINE toImageHSIA #-}-- instance Functor (Pixel HSIA) where   fmap f (PixelHSIA h s i a) = PixelHSIA (f h) (f s) (f i) (f a)   {-# INLINE fmap #-}@@ -219,8 +186,7 @@   instance Storable e => Storable (Pixel HSIA e) where--  sizeOf _ = 3 * sizeOf (undefined :: e)+  sizeOf _ = 4 * sizeOf (undefined :: e)   alignment _ = alignment (undefined :: e)   peek p = do     q <- return $ castPtr p

@@ -14,8 +14,7 @@ -- Portability : non-portable -- module Graphics.Image.ColorSpace.RGB (-  RGB(..), RGBA(..), Pixel(..),-  ToRGB(..), ToRGBA(..),+  RGB(..), RGBA(..), Pixel(..)   ) where  import Prelude hiding (map)@@ -24,7 +23,6 @@ import Foreign.Storable import Data.Foldable import Data.Typeable (Typeable)- import Graphics.Image.Interface  -----------@@ -43,22 +41,7 @@   show (PixelRGB r g b) = "<RGB:("++show r++"|"++show g++"|"++show b++")>"  --- | Conversion to `RGB` color space.-class ColorSpace cs Double => ToRGB cs where--  -- | Convert to an `RGB` pixel.-  toPixelRGB :: Pixel cs Double -> Pixel RGB Double--  -- | Convert to an `RGB` image.-  toImageRGB :: (Array arr cs Double, Array arr RGB Double) =>-                Image arr cs Double-             -> Image arr RGB Double-  toImageRGB = map toPixelRGB-  {-# INLINE toImageRGB #-}----instance (Elevator e, Typeable e) => ColorSpace RGB e where+instance Elevator e => ColorSpace RGB e where   type Components RGB e = (e, e, e)    toComponents (PixelRGB r g b) = (r, g, b)@@ -88,8 +71,6 @@   {-# INLINE foldlPx2 #-}  -- instance Functor (Pixel RGB) where   fmap f (PixelRGB r g b) = PixelRGB (f r) (f g) (f b)   {-# INLINE fmap #-}@@ -107,10 +88,7 @@   {-# INLINE foldr #-}  -- instance Storable e => Storable (Pixel RGB e) where-   sizeOf _ = 3 * sizeOf (undefined :: e)   alignment _ = alignment (undefined :: e)   peek !p = do@@ -126,8 +104,6 @@     pokeElemOff q 2 b  -- ------------ --- RGBA --- ------------@@ -146,23 +122,7 @@   show (PixelRGBA r g b a) = "<RGBA:("++show r++"|"++show g++"|"++show b++"|"++show a++")>"  --- | Conversion to `RGBA` from another color space with Alpha channel.-class (ToRGB (Opaque cs), AlphaSpace cs Double) => ToRGBA cs where--  -- | Convert to an `RGBA` pixel.-  toPixelRGBA :: Pixel cs Double -> Pixel RGBA Double-  toPixelRGBA px = addAlpha (getAlpha px) (toPixelRGB (dropAlpha px))-  {-# INLINE toPixelRGBA #-}--  -- | Convert to an `RGBA` image.-  toImageRGBA :: (Array arr cs Double, Array arr RGBA Double) =>-                Image arr cs Double-             -> Image arr RGBA Double-  toImageRGBA = map toPixelRGBA-  {-# INLINE toImageRGBA #-}---instance (Elevator e, Typeable e) => ColorSpace RGBA e where+instance Elevator e => ColorSpace RGBA e where   type Components RGBA e = (e, e, e, e)    toComponents (PixelRGBA r g b a) = (r, g, b, a)@@ -195,7 +155,7 @@   {-# INLINE foldlPx2 #-}  -instance (Elevator e, Typeable e) => AlphaSpace RGBA e where+instance Elevator e => AlphaSpace RGBA e where   type Opaque RGBA = RGB    getAlpha (PixelRGBA _ _ _ a) = a@@ -206,7 +166,6 @@   {-# INLINE dropAlpha #-}  - instance Functor (Pixel RGBA) where   fmap f (PixelRGBA r g b a) = PixelRGBA (f r) (f g) (f b) (f a)   {-# INLINE fmap #-}@@ -221,11 +180,9 @@   foldr f !z (PixelRGBA r g b a) = f r (f g (f b (f a z)))   {-# INLINE foldr #-} -   instance Storable e => Storable (Pixel RGBA e) where--  sizeOf _ = 3 * sizeOf (undefined :: e)+  sizeOf _ = 4 * sizeOf (undefined :: e)   alignment _ = alignment (undefined :: e)   peek p = do     q <- return $ castPtr p@@ -240,154 +197,3 @@     pokeElemOff q 1 g     pokeElemOff q 2 b     pokeElemOff q 3 a---------------------------------------------------------- -- | Red, Green and Blue color space.--- data RGB16 = RedRGB16---           | GreenRGB16---           | BlueRGB16 deriving (Eq, Enum, Typeable, Show)----- --data instance Pixel RGB16 Word16 = PixelRGB16 !Word16 !Word16 !Word16 deriving Eq--- data instance Pixel RGB16 Word16 = PixelRGB16---                                    {-# UNPACK #-} !Word16---                                    {-# UNPACK #-} !Word16---                                    {-# UNPACK #-} !Word16 deriving Eq--- --data instance Pixel RGB16 Word16 = PixelRGB16 ---- instance ColorSpace RGB16 Word16 where---   type Components RGB16 Word16 = (Word16, Word16, Word16)----   promote !e = PixelRGB16 e e e---   {-# INLINE promote #-}----   toComponents (PixelRGB16 r g b) = (r, g, b)---   {-# INLINE toComponents #-}-  ---   fromComponents !(r, g, b) = PixelRGB16 r g b---   {-# INLINE fromComponents #-}-----   getPxC (PixelRGB16 r _ _) RedRGB16   = r---   getPxC (PixelRGB16 _ g _) GreenRGB16 = g---   getPxC (PixelRGB16 _ _ b) BlueRGB16  = b---   {-# INLINE getPxC #-}----   setPxC (PixelRGB16 _ g b) RedRGB16   r = PixelRGB16 r g b---   setPxC (PixelRGB16 r _ b) GreenRGB16 g = PixelRGB16 r g b---   setPxC (PixelRGB16 r g _) BlueRGB16  b = PixelRGB16 r g b---   {-# INLINE setPxC #-}----   mapPxC f (PixelRGB16 r g b) = PixelRGB16 (f RedRGB16 r) (f GreenRGB16 g) (f BlueRGB16 b)---   {-# INLINE mapPxC #-}----   liftPx f (PixelRGB16 r g b) = PixelRGB16 (f r) (f g) (f b)---   {-# INLINE liftPx #-}----   liftPx2 f (PixelRGB16 r1 g1 b1) (PixelRGB16 r2 g2 b2) =---     PixelRGB16 (f r1 r2) (f g1 g2) (f b1 b2)---   {-# INLINE liftPx2 #-}----   foldlPx f !acc (PixelRGB16 r g b) = f (f (f acc r) g) b----- instance Num (Pixel RGB16 Word16) where---   (+)         = liftPx2 (+)-  ---   (-)         = liftPx2 (-)---   {-# INLINE (-) #-}-  ---   (*)         = liftPx2 (*)---   {-# INLINE (*) #-}-  ---   abs         = liftPx abs---   {-# INLINE abs #-}-  ---   signum      = liftPx signum---   {-# INLINE signum #-}-  ---   fromInteger = promote . fromInteger---   {-# INLINE fromInteger #-}----- -- instance Fractional (Pixel RGB16 Word16) where--- --   (/)          = liftPx2 (/)--- --   {-# INLINE (/) #-}-  --- --   recip        = liftPx recip--- --   {-# INLINE recip #-}---- --   fromRational = promote . fromRational--- --   {-# INLINE fromRational #-}----- -- instance Floating (Pixel RGB16 Word16) where--- --   pi      = promote pi--- --   {-# INLINE pi #-}---- --   exp     = liftPx exp--- --   {-# INLINE exp #-}---- --   log     = liftPx log--- --   {-# INLINE log #-}-  --- --   sin     = liftPx sin--- --   {-# INLINE sin #-}-  --- --   cos     = liftPx cos--- --   {-# INLINE cos #-}-  --- --   asin    = liftPx asin--- --   {-# INLINE asin #-}-  --- --   atan    = liftPx atan--- --   {-# INLINE atan #-}-  --- --   acos    = liftPx acos--- --   {-# INLINE acos #-}-  --- --   sinh    = liftPx sinh--- --   {-# INLINE sinh #-}-  --- --   cosh    = liftPx cosh--- --   {-# INLINE cosh #-}-  --- --   asinh   = liftPx asinh--- --   {-# INLINE asinh #-}-  --- --   atanh   = liftPx atanh--- --   {-# INLINE atanh #-}-  --- --   acosh   = liftPx acosh--- --   {-# INLINE acosh #-}----- -- instance Show RGB16 where--- --   show RedRGB16   = "Red"--- --   show GreenRGB16 = "Green"--- --   show BlueRGB16  = "Blue"---- -- instance Show (Pixel RGB16 Word16) where--- --   show (PixelRGB16 r g b) = "<RGB:("++show r++"|"++show g++"|"++show b++")>"----- -- instance Storable (Pixel RGB16 Word16) where---- --   sizeOf _ = 3 * sizeOf (undefined :: Word16)--- --   alignment _ = alignment (undefined :: Word16)--- --   peek p = do--- --     q <- return $ castPtr p--- --     r <- peek q--- --     g <- peekElemOff q 1--- --     b <- peekElemOff q 2--- --     return (PixelRGB16 r g b)--- --   poke p (PixelRGB16 r g b) = do--- --     q <- return $ castPtr p--- --     poke q r--- --     pokeElemOff q 1 g--- --     pokeElemOff q 2 b

@@ -14,7 +14,9 @@ -- Portability : non-portable -- module Graphics.Image.ColorSpace.X (-  X(..), Pixel(..), toImagesX, fromImagesX+  X(..), Pixel(..),+  toPixelsX, toImagesX,+  fromPixelsX, fromImagesX   ) where  import Prelude as P@@ -23,7 +25,6 @@ import Data.Typeable (Typeable) import Foreign.Ptr import Foreign.Storable- import Graphics.Image.Interface as I  -- ^ This is a single channel colorspace, that is designed to separate Gray@@ -41,7 +42,7 @@   show (PixelX g) = "<X:("++show g++")>"  -instance (Elevator e, Typeable e) => ColorSpace X e where+instance Elevator e => ColorSpace X e where   type Components X e = e    promote = PixelX@@ -104,6 +105,30 @@     q <- return $ castPtr p     poke q g ++-- | Separate a Pixel into a list of components with 'X' pixels containing every+-- component from the pixel.+--+-- >>> toPixelsX (PixelRGB 4 5 6)+-- [<X:(4)>,<X:(5)>,<X:(6)>]+--+toPixelsX :: ColorSpace cs e => Pixel cs e -> [Pixel X e]+toPixelsX = foldrPx ((:) . PixelX) []++-- | Combine a list of `X` pixels into a Pixel with a specified channel+-- order. Not the most efficient way to construct a pixel, but might prove+-- useful to someone.+--+-- >>> fromPixelsX [(RedRGB, 3), (BlueRGB, 5), (GreenRGB, 4)]+-- <RGB:(3.0|4.0|5.0)>+-- >>> fromPixelsX $ zip (enumFrom RedRGB) (toPixelsX $ PixelRGB 4 5 6)+-- <RGB:(4.0|5.0|6.0)>+--+fromPixelsX :: ColorSpace cs e => [(cs, Pixel X e)] -> Pixel cs e+fromPixelsX = foldl' f (promote 0) where+  f !px (c, PixelX x) = setPxC px c x++ -- | Separate an image into a list of images with 'X' pixels containing every -- channel from the source image. --@@ -127,7 +152,7 @@ -- -- For example here is a frog with swapped 'BlueRGB' and 'GreenRGB' channels. ----- >>> writeImage "images/frog_rbg.jpg" $ fromImagesX [frog_red, frog_green, frog_blue] [RedRGB, BlueRGB, GreenRGB]+-- >>> writeImage "images/frog_rbg.jpg" $ fromImagesX [(RedRGB, frog_red), (BlueRGB, frog_green), (GreenRGB, frog_blue)] -- -- <<images/frog.jpg>> <<images/frog_rbg.jpg>> --@@ -135,12 +160,12 @@ -- sometimes pretty useful, exactly the same effect as in example above can be -- achieved in a much simpler and a more efficient way: ----- @ map (\(PixelRGB r g b) -> PixelRGB r b g) frog @+-- @ `I.map` (\\(PixelRGB r g b) -> PixelRGB r b g) frog @ ---fromImagesX :: forall arr cs e . (Array arr X e, Array arr cs e) =>-                  [(cs, Image arr X e)] -> Image arr cs e+fromImagesX :: (Array arr X e, Array arr cs e) =>+               [(cs, Image arr X e)] -> Image arr cs e fromImagesX = fromXs 0 where-  updateCh ch px (PixelX e) = setPxC px ch e+  updateCh !ch !px (PixelX e) = setPxC px ch e   {-# INLINE updateCh #-}   fromXs img []      = img   fromXs img ((c, i):xs) = fromXs (I.zipWith (updateCh c) img i) xs

@@ -14,8 +14,7 @@ -- Portability : non-portable -- module Graphics.Image.ColorSpace.Y (-  Y(..), YA(..), Pixel(..), -  ToY(..), ToYA(..)+  Y(..), YA(..), Pixel(..)   ) where  import Prelude hiding (map)@@ -24,7 +23,6 @@ import Data.Typeable (Typeable) import Foreign.Ptr import Foreign.Storable- import Graphics.Image.Interface  ---------@@ -37,23 +35,10 @@  newtype instance Pixel Y e = PixelY e deriving (Ord, Eq) --- | Conversion to Luma color space.-class ColorSpace cs Double => ToY cs where--  -- | Convert a pixel to Luma pixel.-  toPixelY :: Pixel cs Double -> Pixel Y Double--  -- | Convert an image to Luma image.-  toImageY :: (Array arr cs Double, Array arr Y Double) =>-              Image arr cs Double-           -> Image arr Y Double-  toImageY = map toPixelY-  {-# INLINE toImageY #-}- instance Show e => Show (Pixel Y e) where   show (PixelY g) = "<Luma:("++show g++")>" -instance (Elevator e, Typeable e) => ColorSpace Y e where+instance Elevator e => ColorSpace Y e where   type Components Y e = e   promote = PixelY   {-# INLINE promote #-}@@ -130,23 +115,12 @@  data instance Pixel YA e = PixelYA !e !e deriving Eq --- | Conversion to Luma from another color space with Alpha channel.-class (ToY (Opaque cs), AlphaSpace cs Double) => ToYA cs where -  -- | Convert a pixel to Luma pixel with Alpha.-  toPixelYA :: Pixel cs Double -> Pixel YA Double-  toPixelYA px = addAlpha (getAlpha px) (toPixelY (dropAlpha px))-  {-# INLINE toPixelYA #-}--  -- | Convert an image to Luma image with Alpha.-  toImageYA :: (Array arr cs Double, Array arr YA Double) =>-               Image arr cs Double-            -> Image arr YA Double-  toImageYA = map toPixelYA-  {-# INLINE toImageYA #-}+instance Show e => Show (Pixel YA e) where+  show (PixelYA y a) = "<LumaAlpha:("++show y++"|"++show a++")>"  -instance (Elevator e, Typeable e) => ColorSpace YA e where+instance Elevator e => ColorSpace YA e where   type Components YA e = (e, e)   promote e = PixelYA e e   {-# INLINE promote #-}@@ -172,7 +146,7 @@   {-# INLINE foldlPx2 #-}    -instance (Elevator e, Typeable e) => AlphaSpace YA e where+instance Elevator e => AlphaSpace YA e where   type Opaque YA = Y    getAlpha (PixelYA _ a) = a

@@ -14,8 +14,7 @@ -- Portability : non-portable -- module Graphics.Image.ColorSpace.YCbCr (-  YCbCr(..), YCbCrA(..), Pixel(..), -  ToYCbCr(..), ToYCbCrA(..)+  YCbCr(..), YCbCrA(..), Pixel(..)   ) where  import Prelude hiding (map)@@ -24,10 +23,8 @@ import Data.Typeable (Typeable) import Foreign.Ptr import Foreign.Storable- import Graphics.Image.Interface - ------------- --- YCbCr --- -------------@@ -41,12 +38,12 @@  data instance Pixel YCbCr e = PixelYCbCr !e !e !e deriving Eq -+   instance Show e => Show (Pixel YCbCr e) where   show (PixelYCbCr y b r) = "<YCbCr:("++show y++"|"++show b++"|"++show r++")>"  -instance (Elevator e, Typeable e) => ColorSpace YCbCr e where+instance Elevator e => ColorSpace YCbCr e where   type Components YCbCr e = (e, e, e)    promote !e = PixelYCbCr e e e@@ -124,12 +121,12 @@  data instance Pixel YCbCrA e = PixelYCbCrA !e !e !e !e deriving Eq - + instance Show e => Show (Pixel YCbCrA e) where   show (PixelYCbCrA y b r a) = "<YCbCrA:("++show y++"|"++show b++"|"++show r++"|"++show a++")>"  -instance (Elevator e, Typeable e) => ColorSpace YCbCrA e where+instance Elevator e => ColorSpace YCbCrA e where   type Components YCbCrA e = (e, e, e, e)    promote !e = PixelYCbCrA e e e e@@ -161,39 +158,8 @@     f (f (f (f z y1 y2) b1 b2) r1 r2) a1 a2   {-# INLINE foldlPx2 #-} -  --- | Conversion to `YCbCr` color space.-class ColorSpace cs Double => ToYCbCr cs where -  -- | Convert to an `YCbCr` pixel.-  toPixelYCbCr :: Pixel cs Double -> Pixel YCbCr Double--  -- | Convert to an `YCbCr` image.-  toImageYCbCr :: (Array arr cs Double, Array arr YCbCr Double) =>-                  Image arr cs Double-               -> Image arr YCbCr Double-  toImageYCbCr = map toPixelYCbCr-  {-# INLINE toImageYCbCr #-}----- | Conversion to `YCbCrA` from another color space with Alpha channel.-class (ToYCbCr (Opaque cs), AlphaSpace cs Double) => ToYCbCrA cs where--  -- | Convert to an `YCbCrA` pixel.-  toPixelYCbCrA :: Pixel cs Double -> Pixel YCbCrA Double-  toPixelYCbCrA px = addAlpha (getAlpha px) (toPixelYCbCr (dropAlpha px))-  {-# INLINE toPixelYCbCrA #-}--  -- | Convert to an `YCbCrA` image.-  toImageYCbCrA :: (Array arr cs Double, Array arr YCbCrA Double) =>-                   Image arr cs Double-                -> Image arr YCbCrA Double-  toImageYCbCrA = map toPixelYCbCrA-  {-# INLINE toImageYCbCrA #-}--  --instance (Elevator e, Typeable e) => AlphaSpace YCbCrA e where+instance Elevator e => AlphaSpace YCbCrA e where   type Opaque YCbCrA = YCbCr    getAlpha (PixelYCbCrA _ _ _ a) = a@@ -223,7 +189,7 @@  instance Storable e => Storable (Pixel YCbCrA e) where -  sizeOf _ = 3 * sizeOf (undefined :: e)+  sizeOf _ = 4 * sizeOf (undefined :: e)   alignment _ = alignment (undefined :: e)   peek p = do     q <- return $ castPtr p

@@ -1,6 +1,7 @@ {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | -- Module      : Graphics.Image.IO -- Copyright   : (c) Alexey Kuleshevich 2017@@ -11,15 +12,16 @@ -- module Graphics.Image.IO (   -- * Reading-  readImage, readImageExact,+  readImage, readImage',+  readImageExact, readImageExact',   -- * Writing   writeImage, writeImageExact,   -- * Displaying   ExternalViewer(..),   displayImage,   displayImageUsing,-  displayImageFile,   -- ** Common viewers+  displayImageFile,   defaultViewer,   eogViewer,   gpicviewViewer,@@ -29,7 +31,11 @@   module Graphics.Image.IO.Formats      -- $supported-  ++  -- * Hands on examples+  -- ** Animated GIF++  -- $animation   ) where  import Prelude as P hiding (readFile, writeFile)@@ -73,54 +79,75 @@         headMaybe ls = if null ls then Nothing else Just $ head ls  -- | This function will try to guess an image format from file's extension,--- then it will attempt to read it as such. It will fall back onto the rest of+-- then it will attempt to decode it as such. It will fall back onto the rest of -- the supported formats and will try to read them regarless of file's -- extension. Whenever image cannot be decoded, 'Left' containing all errors for -- each attempted format will be returned, and 'Right' containing an image--- otherwise. Image will be read into a type signature specified 'ColorSpace'--- ('Graphics.Image.ColorSpace.Y', 'Graphics.Image.ColorSpace.YA',--- 'Graphics.Image.ColorSpace.RGB' and 'Graphics.Image.ColorSpace.RGBA' only)--- with 'Double' precision, while doing all necessary conversions.-readImage :: Readable (Image arr cs Double) InputFormat =>-             FilePath-          -> IO (Either String (Image arr cs Double))+-- otherwise. Image will be read with a type signature specified:+--+--  >>> frog <- readImage "images/frog.jpg" :: IO (Either String (Image VS RGB Word8))+--  >>> displayImage frog+--+readImage :: forall arr cs e .+             (Array VS cs e, Array arr cs e,+              Readable (Image VS cs e) InputFormat) =>+             FilePath -- ^ File path for an image+          -> IO (Either String (Image arr cs e)) readImage path = do   imgstr <- B.readFile path   let maybeFormat = guessFormat path :: Maybe InputFormat       formats = enumFrom . toEnum $ 0       orderedFormats = maybe formats (\f -> f:P.filter (/=f) formats) maybeFormat+      reader :: Either String (Image VS cs e) -> InputFormat -> IO (Either String (Image VS cs e))       reader (Left err) format =          return $ either (Left . ((err++"\n")++)) Right (decode format imgstr)       reader img         _     = return img-  M.foldM reader (Left "") orderedFormats+  imgE <- M.foldM reader (Left "") orderedFormats+  return $ fmap (exchange (undefined :: arr)) imgE --- | This function allows for reading any supported image in the exact colorspace--- and precision it is currently encoded in. For instance, frog image can be--- read into it's 'Graphics.Image.ColorSpace.YCbCr' colorspace with--- 'Graphics.Image.ColorSpace.Word8' precision and into any supported array--- representation.++-- | Just like `readImage`, but will throw an exception if incorrect format is+-- detected.+readImage' :: (Array VS cs e, Array arr cs e,+               Readable (Image VS cs e) InputFormat) =>+              FilePath -> IO (Image arr cs e)+readImage' path = either error id <$> readImage path+++-- | This function allows for reading all supported image in their exact+-- colorspace and precision. Only `VS` image representation can be read+-- natively, but `Graphics.Image.exchange` can be use later to switch to a+-- different representation. For instance, "frog.jpg" image can be read into+-- it's 'Graphics.Image.ColorSpace.YCbCr' colorspace with+-- 'Graphics.Image.ColorSpace.Word8' precision: ----- >>> readImageExact JPG "images/frog.jpg" :: IO (Either String (Image RP YCbCr Word8))--- Right <Image RepaParallel YCbCr (Word8): 200x320>+-- >>> readImageExact JPG "images/frog.jpg" :: IO (Either String (Image VS YCbCr Word8))+-- Right <Image VS YCbCr (Word8): 200x320> -- -- The drawback here is that colorspace and precision has to match exactly, -- otherwise it will return an error: ----- >>> readImageExact JPG "images/frog.jpg" :: IO (Either String (Image RP RGB Word8))+-- >>> readImageExact JPG "images/frog.jpg" :: IO (Either String (Image VS RGB Word8)) -- Left "JuicyPixel decoding error: Input image is in YCbCr8 (Pixel YCbCr Word8), cannot convert it to RGB8 (Pixel RGB Word8) colorspace." ----- Attempt to read an image in a particular color space that is not supported by--- the format, will result in a compile error. Refer to 'Readable' class for all--- images that can be decoded.-readImageExact :: Readable (Image arr cs e) format =>+-- Any attempt to read an image in a color space, which is not supported by+-- supplied format, will result in a compile error. Refer to 'Readable' class+-- for all images that can be decoded.+readImageExact :: Readable img format =>                   format                   -- ^ A file format that an image should be read as. See                    -- <#g:4 Supported Image Formats>                -> FilePath -- ^ Location of an image.-               -> IO (Either String (Image arr cs e))+               -> IO (Either String img) readImageExact format path = fmap (decode format) (B.readFile path)  +-- | Just like `readImageExact`, but will throw an exception if incorrect format+-- is detected.+readImageExact' :: Readable b format => format -> FilePath -> IO b+readImageExact' format path = either error id <$> readImageExact format path++ -- | Just like 'readImage', this function will guess an output file format from the -- extension and write to file any image that is in one of 'Y', 'YA', 'RGB' or -- 'RGBA' color spaces with 'Double' precision. While doing necessary@@ -138,7 +165,7 @@            -> IO () writeImage path = BL.writeFile path . encode format [] . exchange VS where   format = fromMaybe (error ("Could not guess output format. Use 'writeImageExact' "++-                         "or supply a filename with supported format."))+                             "or supply a filename with supported format."))            (guessFormat path :: Maybe OutputFormat)  @@ -146,13 +173,13 @@ -- options. Precision and color space, that an image will be written as, is decided -- from image's type. Attempt to write image file in a format that does not -- support color space and precision combination will result in a compile error.-writeImageExact :: Writable (Image arr cs e) format =>+writeImageExact :: Writable img format =>                    format                    -- ^ A file format that an image should be saved in. See                    -- <#g:4 Supported Image Formats>                 -> [SaveOption format] -- ^ A list of format specific options.                 -> FilePath -- ^ Location where an image should be written.-                -> (Image arr cs e) -- ^ An image to write. Can be a list of images in case+                -> img -- ^ An image to write. Can be a list of images in case                        -- of formats supporting animation.                 -> IO () writeImageExact format opts path = BL.writeFile path . encode format opts@@ -160,7 +187,8 @@  -- | An image is written as a @.tiff@ file into an operating system's temporary -- directory and passed as an argument to the external viewer program.-displayImageUsing :: Writable (Image arr cs e) TIF =>+displayImageUsing :: (Array VS cs e, Array arr cs e,+                      Writable (Image VS cs e) TIF) =>                      ExternalViewer -- ^ External viewer to use                   -> Bool -- ^ Should the call be blocking                   -> Image arr cs e -- ^ Image to display@@ -172,7 +200,7 @@         bracket (openBinaryTempFile tmpDir "tmp-img.tiff")           (hClose . snd)           (\ (imgPath, imgHandle) -> do-              BL.hPut imgHandle $ encode TIF [] img+              BL.hPut imgHandle $ encode TIF [] $ exchange VS img               hClose imgHandle               displayImageFile viewer imgPath)   if block@@ -188,21 +216,16 @@   where (argsBefore, argsAfter) = splitAt ix args  -{- | Makes a call to an external viewer that is set as a default image viewer by-the OS. This is a non-blocking function call, so it will take some time before-an image will appear.--  >>> frog <- readImageRGB VU "images/frog.jpg"-  >>> displayImage frog---}+-- | Makes a call to an external viewer that is set as a default image viewer by+-- the OS. This is a non-blocking function call, so it might take some time+-- before an image will appear. displayImage :: (Array VS cs e, Array arr cs e,                  Writable (Image VS cs e) TIF) =>                 Image arr cs e -- ^ Image to be displayed              -> IO ()-displayImage = displayImageUsing defaultViewer False . exchange VS-+displayImage = displayImageUsing defaultViewer False +-- | Default viewer is inferred from the operating system. defaultViewer :: ExternalViewer defaultViewer = #if defined(OS_Win32)@@ -216,82 +239,86 @@ #endif  --- | @eog /tmp/hip/img.tiff@+-- | @eog \/tmp\/hip\/img.tiff@+-- -- <https://help.gnome.org/users/eog/stable/ Eye of GNOME> eogViewer :: ExternalViewer eogViewer = ExternalViewer "eog" [] 0  --- | @feh --fullscreen --auto-zoom /tmp/hip/img.tiff@+-- | @feh --fullscreen --auto-zoom \/tmp\/hip\/img.tiff@+-- -- <https://feh.finalrewind.org/ FEH> fehViewer :: ExternalViewer fehViewer = ExternalViewer "feh" ["--fullscreen", "--auto-zoom"] 2  --- | @gpicview /tmp/hip/img.tiff@+-- | @gpicview \/tmp\/hip\/img.tiff@+-- -- <http://lxde.sourceforge.net/gpicview/ GPicView> gpicviewViewer :: ExternalViewer gpicviewViewer = ExternalViewer "gpicview" [] 0  --- | @gimp /tmp/hip/img.tiff@+-- | @gimp \/tmp\/hip\/img.tiff@+-- -- <https://www.gimp.org/ GIMP> gimpViewer :: ExternalViewer gimpViewer = ExternalViewer "gimp" [] 0  - {- $supported Encoding and decoding of images is done using <http://hackage.haskell.org/package/JuicyPixels JuicyPixels> and <http://hackage.haskell.org/package/netpbm netpbm> packages.     List of image formats that are currently supported, and their exact-'ColorSpace's and precision for reading and writing:+'ColorSpace's and precision for reading and writing without an implicit+conversion:    * 'BMP': -    * __read__: ('Y' 'Word8'), ('RGB'  'Word8'), ('RGBA'  'Word8')-    * __write__: ('Y' 'Word8'), ('RGB'  'Word8'), ('RGBA'  'Word8')+    * __read__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8')+    * __write__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8')  * 'GIF': -    * __read__: ('RGB'  'Word8'), ('RGBA'  'Word8')-    * __write__: ('RGB'  'Word8')-    * Also supports reading and writing animated images, when used as @['GIF']@+    * __read__: ('RGB' 'Word8'), ('RGBA' 'Word8')+    * __write__: ('RGB' 'Word8')+    * Also supports reading and writing animated images, when used as @'GIFA'@  * 'HDR': -    * __read__: ('RGB'  'Float')-    * __write__: ('RGB'  'Float')+    * __read__: ('RGB' 'Float')+    * __write__: ('RGB' 'Float')  * 'JPG': -    * __read__: ('Y' 'Word8'), ('YA' 'Word8'), ('RGB'  'Word8'), ('CMYK'  'Word8'),+    * __read__: ('Y' 'Word8'), ('YA' 'Word8'), ('RGB' 'Word8'), ('CMYK' 'Word8'),     ('YCbCr', 'Word8')-    * __write__: ('Y' 'Word8'), ('YA', 'Word8'), ('RGB'  'Word8'), ('CMYK'  'Word8'),+    * __write__: ('Y' 'Word8'), ('YA', 'Word8'), ('RGB' 'Word8'), ('CMYK' 'Word8'),     ('YCbCr', 'Word8')  * 'PNG':      * __read__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'),-    ('RGB'  'Word8'), ('RGB'  'Word16'), ('RGBA'  'Word8'), ('RGBA'  'Word16')+    ('RGB' 'Word8'), ('RGB' 'Word16'), ('RGBA' 'Word8'), ('RGBA' 'Word16')     * __write__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'),-    ('RGB'  'Word8'), ('RGB'  'Word16'), ('RGBA'  'Word8'), ('RGBA'  'Word16')+    ('RGB' 'Word8'), ('RGB' 'Word16'), ('RGBA' 'Word8'), ('RGBA' 'Word16')  * 'TGA': -    * __read__: ('Y' 'Word8'), ('RGB'  'Word8'), ('RGBA'  'Word8')-    * __write__: ('Y' 'Word8'), ('RGB'  'Word8'), ('RGBA'  'Word8')+    * __read__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8')+    * __write__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8')  * 'TIF':      * __read__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'),-    ('RGB'  'Word8'), ('RGB'  'Word16'), ('RGBA'  'Word8'), ('RGBA'  'Word16'),-    ('CMYK'  'Word8'), ('CMYK'  'Word16')+    ('RGB' 'Word8'), ('RGB' 'Word16'), ('RGBA' 'Word8'), ('RGBA' 'Word16'),+    ('CMYK' 'Word8'), ('CMYK' 'Word16')     * __write__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'),-    ('RGB'  'Word8'), ('RGB'  'Word16'), ('RGBA'  'Word8'), ('RGBA'  'Word16')-    ('CMYK'  'Word8'), ('CMYK'  'Word16'), ('YCbCr'  'Word8')+    ('RGB' 'Word8'), ('RGB' 'Word16'), ('RGBA' 'Word8'), ('RGBA' 'Word16')+    ('CMYK' 'Word8'), ('CMYK' 'Word16'), ('YCbCr' 'Word8')  * 'PBM': @@ -305,8 +332,48 @@  * 'PPM': -    * __read__: ('RGB'  'Word8'), ('RGB'  'Word16')+    * __read__: ('RGB' 'Word8'), ('RGB' 'Word16')     * Also supports sequence of images in one file, when read as @['PPM']@  -} +++{- $animation++JuicyPixels is capable of encoding/decoding all sorts of poular formats, one of+which is animated GIFs. Here I would like to present a short demonstration on+how it is possible to work with image seqences.++<<images/downloaded/strawberry.gif>>++So, we download and image, but it's a little bit too big, and it's in RGBA+colorspace.++* Read an animated GIF as a list of images:++>>> imgs <- readImageExact' GIFA "images/downloaded/strawberry.gif" :: IO [(GifDelay, Image VS RGBA Word8)]++* convert to `RGB` colorspace by dropping alpha channel and increasing precision,+since we cannot write GIFs in RGBA colorspace:++>>> let imgsRGB = fmap (fmap toImageRGB) imgs++* if `toImageRGB` hadn't increased the precision to `Double` in the previous+  step, `Bilinear` interpolation would have simply destroyed the image quality+  in this step. Scale all images in the sequence by a half:++>>> let imgsRGBsmall = fmap (fmap (scale Bilinear Edge (0.5, 0.5))) imgsRGB++* Here we save the sequence as a new animated image. We don't need to drop+  precision back to `Word8`, it will be taken care for us:++>>> writeImageExact GIFA [GIFALooping LoopingForever] "images/strawberry.gif" imgsRGBsmall++* Now lets extend the animation a bit:++>>> writeImageExact GIFA [GIFALooping LoopingForever] "images/strawberry_backwards.gif" (imgsRGBsmall ++ reverse imgsRGBsmall)++<<images/strawberry.gif>> <<images/strawberry_backwards.gif>>++-}

@@ -17,10 +17,29 @@ import qualified Data.ByteString as B (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString) +import Graphics.Image.ColorSpace  -- | Used during converting pixels between libraries. class Convertible a b where   convert :: a -> b++--  Y (Double)++instance ToY cs e => Convertible (Pixel cs e) (Pixel Y Double) where+  convert = toPixelY++instance ToYA cs e => Convertible (Pixel cs e) (Pixel YA Double) where+  convert = toPixelYA++-- RGB -> RGB (Double)++instance ToRGB cs e => Convertible (Pixel cs e) (Pixel RGB Double) where+  convert = toPixelRGB++instance ToRGBA cs e => Convertible (Pixel cs e) (Pixel RGBA Double) where+  convert = toPixelRGBA++  -- | Image file format. Helps in guessing image format using a file extension, -- as well as supplying format specific options during saving an image.

@@ -6,17 +6,18 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module      : Graphics.Image.IO.Formats--- Copyright   : (c) Alexey Kuleshevich 2016+-- Copyright   : (c) Alexey Kuleshevich 2017 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental -- Portability : non-portable -- module Graphics.Image.IO.Formats (-  module Graphics.Image.IO.Formats.JuicyPixels,+  module Graphics.Image.IO.Formats.JuicyPixels.Common,   module Graphics.Image.IO.Formats.Netpbm,   InputFormat(..), OutputFormat(..),   Readable(..), Writable(..), ImageFormat(..),+  Convertible(..)   ) where  import Graphics.Image.ColorSpace@@ -24,12 +25,13 @@ import Graphics.Image.Processing import Graphics.Image.Processing.Complex import Graphics.Image.IO.Base-import Graphics.Image.IO.Formats.JuicyPixels+import Graphics.Image.IO.Formats.JuicyPixels.Common+import Graphics.Image.IO.Formats.JuicyPixels.Readable()+import Graphics.Image.IO.Formats.JuicyPixels.Writable() import Graphics.Image.IO.Formats.Netpbm  --- | A collection of all image formats that can be read into HIP images with--- 'Double' precision pixel channels.+-- | A collection of all image formats that can be read into HIP images. data InputFormat = InputBMP                  | InputGIF                  | InputHDR

@@ -1,1076 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ViewPatterns #-}--- |--- Module      : Graphics.Image.IO.Formats.JuicyPixels--- Copyright   : (c) Alexey Kuleshevich 2016--- License     : BSD3--- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>--- Stability   : experimental--- Portability : non-portable----module Graphics.Image.IO.Formats.JuicyPixels (-  BMP(..),-  GIF(..), JP.GifDelay, JP.GifLooping(..), JP.PaletteOptions(..), JP.PaletteCreationMethod(..),-  HDR(..),-  JPG(..),-  PNG(..),-  TGA(..),-  TIF(..),-  SaveOption(..),-  ) where--import Prelude as P-import GHC.Float-import Data.Either-import qualified Data.Monoid as M (mempty)-import Graphics.Image.ColorSpace-import Graphics.Image.Interface as I-import Graphics.Image.Interface.Vector-import Graphics.Image.IO.Base-import qualified Data.ByteString as B (ByteString)-import qualified Data.ByteString.Lazy as BL (ByteString)-import qualified Codec.Picture as JP-import qualified Codec.Picture.Jpg as JP-import qualified Codec.Picture.Types as JP-import qualified Codec.Picture.ColorQuant as JP-import qualified Data.Vector.Storable as V---- | Bitmap image with @.bmp@ extension.-data BMP = BMP--instance ImageFormat BMP where-  data SaveOption BMP--  ext _ = ".bmp"----- | Graphics Interchange Format image with @.gif@ extension.-data GIF = GIF--instance ImageFormat GIF where-  data SaveOption GIF = GIFPalette JP.PaletteOptions-  -  ext _ = ".gif"--instance ImageFormat [GIF] where-  data SaveOption [GIF] = GIFsPalette JP.PaletteOptions-                        | GIFsLooping JP.GifLooping--  ext _ = ext GIF---- | High-dynamic-range image with @.hdr@ or @.pic@ extension.-data HDR = HDR--instance ImageFormat HDR where-  data SaveOption HDR--  ext _ = ".hdr"--  exts _ = [".hdr", ".pic"]----- | Joint Photographic Experts Group image with @.jpg@ or @.jpeg@ extension.-data JPG = JPG--instance ImageFormat JPG where-  data SaveOption JPG = JPGQuality Word8--  ext _ = ".jpg"--  exts _ = [".jpg", ".jpeg"]----- | Portable Network Graphics image with @.png@ extension.-data PNG = PNG--instance ImageFormat PNG where-  data SaveOption PNG--  ext _ = ".png"----- | Truevision Graphics Adapter image with .tga extension.-data TGA = TGA--instance ImageFormat TGA where-  data SaveOption TGA--  ext _ = ".tga"----- | Tagged Image File Format image with @.tif@ or @.tiff@ extension.-data TIF = TIF--instance ImageFormat TIF where-  data SaveOption TIF  --  ext _ = ".tif"--  exts _ = [".tif", ".tiff"]-------------------------------------------------------------------------------------- Converting to and from JuicyPixels ------------------------------------------------------------------------------------------------------------------------------- Y -> Y (Double)--instance Convertible JP.Pixel8 (Pixel Y Double) where-  convert = fmap toDouble . PixelY--instance Convertible JP.Pixel16 (Pixel Y Double) where-  convert = fmap toDouble . PixelY--instance Convertible JP.PixelF (Pixel Y Double) where-  convert = fmap toDouble . PixelY--instance Convertible JP.PixelYA8 (Pixel Y Double) where-  convert = convert . JP.dropTransparency--instance Convertible JP.PixelYA16 (Pixel Y Double) where-  convert = convert . JP.dropTransparency--instance Convertible JP.Pixel8 (Pixel YA Double) where-  convert = addAlpha 1 . convert--instance Convertible JP.Pixel16 (Pixel YA Double) where-  convert = addAlpha 1 . convert-  -instance Convertible JP.PixelF (Pixel YA Double) where-  convert = addAlpha 1 . convert--instance Convertible JP.PixelYA8 (Pixel YA Double) where-  convert (JP.PixelYA8 y a) = fmap toDouble (PixelYA y a)--instance Convertible JP.PixelYA16 (Pixel YA Double) where-  convert (JP.PixelYA16 y a) = fmap toDouble (PixelYA y a)----- Color -> Y (Double)--instance Convertible JP.PixelRGB8 (Pixel Y Double) where-  convert = toPixelY . (convert :: JP.PixelRGB8 -> Pixel RGB Double)--instance Convertible JP.PixelRGB16 (Pixel Y Double) where-  convert = toPixelY . (convert :: JP.PixelRGB16 -> Pixel RGB Double)--instance Convertible JP.PixelRGBA8 (Pixel Y Double) where-  convert = toPixelY . (convert :: JP.PixelRGBA8 -> Pixel RGB Double)--instance Convertible JP.PixelRGBA16 (Pixel Y Double) where-  convert = toPixelY . (convert :: JP.PixelRGBA16 -> Pixel RGB Double)--instance Convertible JP.PixelRGBF (Pixel Y Double) where-  convert = toPixelY . (convert :: JP.PixelRGBF -> Pixel RGB Double)--instance Convertible JP.PixelCMYK8 (Pixel Y Double) where-  convert = toPixelY . fmap toDouble . (convert :: JP.PixelCMYK8 -> Pixel CMYK Word8)--instance Convertible JP.PixelCMYK16 (Pixel Y Double) where-  convert = toPixelY . fmap toDouble . (convert :: JP.PixelCMYK16 -> Pixel CMYK Word16)--instance Convertible JP.PixelYCbCr8 (Pixel Y Double) where-  convert = convert . JP.computeLuma---- Color -> YA (Double)  --instance Convertible JP.PixelRGB8 (Pixel YA Double) where-  convert = addAlpha 1 . convert--instance Convertible JP.PixelRGB16 (Pixel YA Double) where-  convert = addAlpha 1 . convert-  -instance Convertible JP.PixelRGBF (Pixel YA Double) where-  convert = addAlpha 1 . convert-  -instance Convertible JP.PixelCMYK8 (Pixel YA Double) where-  convert = addAlpha 1 . convert--instance Convertible JP.PixelCMYK16 (Pixel YA Double) where-  convert = addAlpha 1 . convert-  -instance Convertible JP.PixelYCbCr8 (Pixel YA Double) where-  convert = addAlpha 1 . convert--instance Convertible JP.PixelRGBA8 (Pixel YA Double) where-  convert = toPixelYA . (convert :: JP.PixelRGBA8 -> Pixel RGBA Double)--instance Convertible JP.PixelRGBA16 (Pixel YA Double) where-  convert = toPixelYA . (convert :: JP.PixelRGBA16 -> Pixel RGBA Double)-  -  ---- Y -> RGB (Double)--instance Convertible JP.Pixel8 (Pixel RGB Double) where-  convert = promote . toDouble--instance Convertible JP.Pixel16 (Pixel RGB Double) where-  convert = promote . toDouble--instance Convertible JP.PixelF (Pixel RGB Double) where-  convert = promote . toDouble--instance Convertible JP.PixelYA8 (Pixel RGB Double) where-  convert = convert . JP.dropTransparency--instance Convertible JP.PixelYA16 (Pixel RGB Double) where-  convert = convert . JP.dropTransparency---- Color -> RGB (Double)--instance Convertible JP.PixelRGB8 (Pixel RGB Double) where-  convert (JP.PixelRGB8 r g b) = fmap toDouble $ PixelRGB r g b--instance Convertible JP.PixelRGB16 (Pixel RGB Double) where-  convert (JP.PixelRGB16 r g b) = fmap toDouble $ PixelRGB r g b--instance Convertible JP.PixelRGBA8 (Pixel RGB Double) where-  convert = convert . JP.dropTransparency--instance Convertible JP.PixelRGBA16 (Pixel RGB Double) where-  convert = convert . JP.dropTransparency--instance Convertible JP.PixelRGBF (Pixel RGB Double) where-  convert (JP.PixelRGBF r g b) = -    PixelRGB (float2Double r) (float2Double g) (float2Double b)--instance Convertible JP.PixelYCbCr8 (Pixel RGB Double) where-  convert = convert . (JP.convertPixel :: JP.PixelYCbCr8 -> JP.PixelRGB8)--instance Convertible JP.PixelCMYK8 (Pixel RGB Double) where-  convert = convert . (JP.convertPixel :: JP.PixelCMYK8 -> JP.PixelRGB8)--instance Convertible JP.PixelCMYK16 (Pixel RGB Double) where-  convert = convert . (JP.convertPixel :: JP.PixelCMYK16 -> JP.PixelRGB16)---- Y -> RGBA (Double)--instance Convertible JP.Pixel8 (Pixel RGBA Double) where-  convert = addAlpha 1 . convert--instance Convertible JP.Pixel16 (Pixel RGBA Double) where-  convert = addAlpha 1 . convert--instance Convertible JP.PixelF (Pixel RGBA Double) where-  convert = addAlpha 1 . convert--instance Convertible JP.PixelYA8 (Pixel RGBA Double) where-  convert = toPixelRGBA . (convert :: JP.PixelYA8 -> Pixel YA Double)--instance Convertible JP.PixelYA16 (Pixel RGBA Double) where-  convert = toPixelRGBA . (convert :: JP.PixelYA16 -> Pixel YA Double)---- Color -> RGBA (Double)--instance Convertible JP.PixelRGB8 (Pixel RGBA Double) where-  convert = addAlpha 1 . convert-  -instance Convertible JP.PixelRGB16 (Pixel RGBA Double) where-  convert = addAlpha 1 . convert--instance Convertible JP.PixelRGBF (Pixel RGBA Double) where-  convert = addAlpha 1 . convert--instance Convertible JP.PixelCMYK8 (Pixel RGBA Double) where-  convert = addAlpha 1 . convert-  -instance Convertible JP.PixelCMYK16 (Pixel RGBA Double) where-  convert = addAlpha 1 . convert--instance Convertible JP.PixelYCbCr8 (Pixel RGBA Double) where-  convert = addAlpha 1 . convert-  -instance Convertible JP.PixelRGBA8 (Pixel RGBA Double) where-  convert (JP.PixelRGBA8 r g b a) = fmap toDouble $ PixelRGBA r g b a-  -instance Convertible JP.PixelRGBA16 (Pixel RGBA Double) where-  convert (JP.PixelRGBA16 r g b a) = fmap toDouble $ PixelRGBA r g b a------- to JuicyPixels ----------- Exact precision conversions--instance Convertible JP.Pixel8 (Pixel Y Word8) where-  convert = PixelY-  -instance Convertible JP.Pixel16 (Pixel Y Word16) where-  convert = PixelY--instance Convertible JP.Pixel32 (Pixel Y Word32) where-  convert = PixelY--instance Convertible JP.PixelF (Pixel Y Float) where-  convert = PixelY--instance Convertible JP.PixelYA8 (Pixel YA Word8) where-  convert (JP.PixelYA8 g a) = PixelYA g a-  -instance Convertible JP.PixelYA16 (Pixel YA Word16) where-  convert (JP.PixelYA16 g a) = PixelYA g a--instance Convertible JP.PixelRGB8 (Pixel RGB Word8) where-  convert (JP.PixelRGB8 r g b) = PixelRGB r g b-  -instance Convertible JP.PixelRGB16 (Pixel RGB Word16) where-  convert (JP.PixelRGB16 r g b) = PixelRGB r g b--instance Convertible JP.PixelRGBF (Pixel RGB Float) where-  convert (JP.PixelRGBF r g b) = PixelRGB r g b--instance Convertible JP.PixelRGBA8 (Pixel RGBA Word8) where-  convert (JP.PixelRGBA8 r g b a) = PixelRGBA r g b a-  -instance Convertible JP.PixelRGBA16 (Pixel RGBA Word16) where-  convert (JP.PixelRGBA16 r g b a) = PixelRGBA r g b a--instance Convertible JP.PixelYCbCr8 (Pixel YCbCr Word8) where-  convert (JP.PixelYCbCr8 y cb cr) = PixelYCbCr y cb cr--instance Convertible JP.PixelCMYK8 (Pixel CMYK Word8) where-  convert (JP.PixelCMYK8 c m y k) = PixelCMYK c m y k--instance Convertible JP.PixelCMYK16 (Pixel CMYK Word16) where-  convert (JP.PixelCMYK16 c m y k) = PixelCMYK c m y k----instance Convertible (Pixel Y Word8) JP.Pixel8 where-  convert (PixelY g) = g-  -instance Convertible (Pixel Y Word16) JP.Pixel16 where-  convert (PixelY g) = g--instance Convertible (Pixel Y Word32) JP.Pixel32 where-  convert (PixelY g) = g--instance Convertible (Pixel Y Float) JP.PixelF where-  convert (PixelY g) = g--instance Convertible (Pixel YA Word8) JP.PixelYA8 where-  convert (PixelYA g a) = JP.PixelYA8 g a-  -instance Convertible (Pixel YA Word16) JP.PixelYA16 where-  convert (PixelYA g a) = JP.PixelYA16 g a--instance Convertible (Pixel RGB Word8) JP.PixelRGB8 where-  convert (PixelRGB r g b) = JP.PixelRGB8 r g b-  -instance Convertible (Pixel RGB Word16) JP.PixelRGB16 where-  convert (PixelRGB r g b) = JP.PixelRGB16 r g b--instance Convertible (Pixel RGB Float) JP.PixelRGBF where-  convert (PixelRGB r g b) = JP.PixelRGBF r g b--instance Convertible (Pixel RGBA Word8) JP.PixelRGBA8 where-  convert (PixelRGBA r g b a) = JP.PixelRGBA8 r g b a-  -instance Convertible (Pixel RGBA Word16) JP.PixelRGBA16 where-  convert (PixelRGBA r g b a) = JP.PixelRGBA16 r g b a---instance Convertible (Pixel YCbCr Word8) JP.PixelYCbCr8 where-  convert (PixelYCbCr y cb cr) = JP.PixelYCbCr8 y cb cr--instance Convertible (Pixel CMYK Word8) JP.PixelCMYK8 where-  convert (PixelCMYK c m y k) = JP.PixelCMYK8 c m y k--instance Convertible (Pixel CMYK Word16) JP.PixelCMYK16 where-  convert (PixelCMYK c m y k) = JP.PixelCMYK16 c m y k--------------------------------------------------------------------------------------- Decoding images using JuicyPixels -------------------------------------------------------------------------------------------------------------------------------- BMP Format Reading--instance Readable (Image VS Binary Bit) BMP where-  decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodeBitmap--instance Readable (Image VS Y Word8) BMP where-  decode _ = jpImageY8ToImage . JP.decodeBitmap--instance Readable (Image VS RGB Word8) BMP where-  decode _ = jpImageRGB8ToImage . JP.decodeBitmap--instance Readable (Image VS RGBA Word8) BMP where-  decode _ = jpImageRGBA8ToImage . JP.decodeBitmap------ GIF Format Reading--instance Readable (Image VS RGB Word8) GIF where-  decode _ = jpImageRGB8ToImage . JP.decodeGif--instance Readable (Image VS RGBA Word8) GIF where-  decode _ = jpImageRGBA8ToImage . JP.decodeGif----- List of GIF Format frames Reading--decodeGifs :: (Either String JP.DynamicImage -> Either String img)-           -> B.ByteString -> Either String [img]-decodeGifs decoder = either Left decodeLS . JP.decodeGifImages where-    decodeLS ls = if null errs then Right imgs else Left $ unlines errs where-      (errs, imgs) = partitionEithers $ P.map (decoder . Right) ls--instance Readable [Image VS RGB Word8] [GIF] where-  decode _ = decodeGifs jpImageRGB8ToImage--instance Readable [Image VS RGBA Word8] [GIF] where-  decode _ = decodeGifs jpImageRGBA8ToImage----- HDR Format Reading--instance Readable (Image VS RGB Float) HDR where-  decode _ = jpImageRGBFToImage . JP.decodeHDR----- JPG Format Reading--instance Readable (Image VS Y Word8) JPG where-  decode _ = jpImageY8ToImage . JP.decodeJpeg--instance Readable (Image VS YA Word8) JPG where-  decode _ = jpImageYA8ToImage . JP.decodeJpeg--instance Readable (Image VS RGB Word8) JPG where-  decode _ = jpImageRGB8ToImage . JP.decodeJpeg--instance Readable (Image VS CMYK Word8) JPG where-  decode _ = jpImageCMYK8ToImage . JP.decodeJpeg--instance Readable (Image VS YCbCr Word8) JPG where-  decode _ = jpImageYCbCr8ToImage . JP.decodeJpeg----- PNG Format Reading--instance Readable (Image VS Binary Bit) PNG where-  decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodePng--instance Readable (Image VS Y Word8) PNG where-  decode _ = jpImageY8ToImage . JP.decodePng--instance Readable (Image VS Y Word16) PNG where-  decode _ = jpImageY16ToImage . JP.decodePng--instance Readable (Image VS YA Word8) PNG where-  decode _ = jpImageYA8ToImage . JP.decodePng--instance Readable (Image VS YA Word16) PNG where-  decode _ = jpImageYA16ToImage . JP.decodePng--instance Readable (Image VS RGB Word8) PNG where-  decode _ = jpImageRGB8ToImage . JP.decodePng--instance Readable (Image VS RGB Word16) PNG where-  decode _ = jpImageRGB16ToImage . JP.decodePng--instance Readable (Image VS RGBA Word8) PNG where-  decode _ = jpImageRGBA8ToImage . JP.decodePng--instance Readable (Image VS RGBA Word16) PNG where-  decode _ = jpImageRGBA16ToImage . JP.decodePng----- TGA Format Reading--instance Readable (Image VS Binary Bit) TGA where-  decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodeTga--instance Readable (Image VS Y Word8) TGA where-  decode _ = jpImageY8ToImage . JP.decodeTga--instance Readable (Image VS RGB Word8) TGA where-  decode _ = jpImageRGB8ToImage . JP.decodeTga--instance Readable (Image VS RGBA Word8) TGA where-  decode _ = jpImageRGBA8ToImage . JP.decodeTga----- TIF Format Reading--instance Readable (Image VS Binary Bit) TIF where-  decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodeTiff--instance Readable (Image VS Y Word8) TIF where-  decode _ = jpImageY8ToImage . JP.decodeTiff--instance Readable (Image VS Y Word16) TIF where-  decode _ = jpImageY16ToImage . JP.decodeTiff--instance Readable (Image VS YA Word8) TIF where-  decode _ = jpImageYA8ToImage . JP.decodeTiff--instance Readable (Image VS YA Word16) TIF where-  decode _ = jpImageYA16ToImage . JP.decodeTiff--instance Readable (Image VS RGB Word8) TIF where-  decode _ = jpImageRGB8ToImage . JP.decodeTiff--instance Readable (Image VS RGB Word16) TIF where-  decode _ = jpImageRGB16ToImage . JP.decodeTiff--instance Readable (Image VS RGBA Word8) TIF where-  decode _ = jpImageRGBA8ToImage . JP.decodeTiff--instance Readable (Image VS RGBA Word16) TIF where-  decode _ = jpImageRGBA16ToImage . JP.decodeTiff--instance Readable (Image VS CMYK Word8) TIF where-  decode _ = jpImageCMYK8ToImage . JP.decodeTiff--instance Readable (Image VS CMYK Word16) TIF where-  decode _ = jpImageCMYK16ToImage . JP.decodeTiff----- To Double precision safe conversion--instance Array arr Y Double => Readable (Image arr Y Double) BMP where-  decode _ = jpDynamicImageToImage . JP.decodeBitmap--instance Array arr YA Double => Readable (Image arr YA Double) BMP where-  decode _ = jpDynamicImageToImage . JP.decodeBitmap--instance Array arr RGB Double => Readable (Image arr RGB Double) BMP where-  decode _ = jpDynamicImageToImage . JP.decodeBitmap--instance Array arr RGBA Double => Readable (Image arr RGBA Double) BMP where-  decode _ = jpDynamicImageToImage . JP.decodeBitmap---instance Array arr Y Double => Readable (Image arr Y Double) GIF where-  decode _ = jpDynamicImageToImage . JP.decodeGif--instance Array arr YA Double => Readable (Image arr YA Double) GIF where-  decode _ = jpDynamicImageToImage . JP.decodeGif--instance Array arr RGB Double => Readable (Image arr RGB Double) GIF where-  decode _ = jpDynamicImageToImage . JP.decodeGif--instance Array arr RGBA Double => Readable (Image arr RGBA Double) GIF where-  decode _ = jpDynamicImageToImage . JP.decodeGif---instance Array arr Y Double => Readable [Image arr Y Double] [GIF] where-  decode _ = decodeGifs jpDynamicImageToImage--instance Array arr YA Double => Readable [Image arr YA Double] [GIF] where-  decode _ = decodeGifs jpDynamicImageToImage--instance Array arr RGB Double => Readable [Image arr RGB Double] [GIF] where-  decode _ = decodeGifs jpDynamicImageToImage--instance Array arr RGBA Double => Readable [Image arr RGBA Double] [GIF] where-  decode _ = decodeGifs jpDynamicImageToImage---instance Array arr Y Double => Readable (Image arr Y Double) HDR where-  decode _ = jpDynamicImageToImage . JP.decodeHDR--instance Array arr YA Double => Readable (Image arr YA Double) HDR where-  decode _ = jpDynamicImageToImage . JP.decodeHDR--instance Array arr RGB Double => Readable (Image arr RGB Double) HDR where-  decode _ = jpDynamicImageToImage . JP.decodeHDR--instance Array arr RGBA Double => Readable (Image arr RGBA Double) HDR where-  decode _ = jpDynamicImageToImage . JP.decodeHDR---instance Array arr Y Double => Readable (Image arr Y Double) JPG where-  decode _ = jpDynamicImageToImage . JP.decodeJpeg--instance Array arr YA Double => Readable (Image arr YA Double) JPG where-  decode _ = jpDynamicImageToImage . JP.decodeJpeg--instance Array arr RGB Double => Readable (Image arr RGB Double) JPG where-  decode _ = jpDynamicImageToImage . JP.decodeJpeg--instance Array arr RGBA Double => Readable (Image arr RGBA Double) JPG where-  decode _ = jpDynamicImageToImage . JP.decodeJpeg---instance Array arr Y Double => Readable (Image arr Y Double) PNG where-  decode _ = jpDynamicImageToImage . JP.decodePng--instance Array arr YA Double => Readable (Image arr YA Double) PNG where-  decode _ = jpDynamicImageToImage . JP.decodePng--instance Array arr RGB Double => Readable (Image arr RGB Double) PNG where-  decode _ = jpDynamicImageToImage . JP.decodePng--instance Array arr RGBA Double => Readable (Image arr RGBA Double) PNG where-  decode _ = jpDynamicImageToImage . JP.decodePng---instance Array arr Y Double => Readable (Image arr Y Double) TGA where-  decode _ = jpDynamicImageToImage . JP.decodeTga--instance Array arr YA Double => Readable (Image arr YA Double) TGA where-  decode _ = jpDynamicImageToImage . JP.decodeTga--instance Array arr RGB Double => Readable (Image arr RGB Double) TGA where-  decode _ = jpDynamicImageToImage . JP.decodeTga--instance Array arr RGBA Double => Readable (Image arr RGBA Double) TGA where-  decode _ = jpDynamicImageToImage . JP.decodeTga---instance Array arr Y Double => Readable (Image arr Y Double) TIF where-  decode _ = jpDynamicImageToImage . JP.decodeTiff--instance Array arr YA Double => Readable (Image arr YA Double) TIF where-  decode _ = jpDynamicImageToImage . JP.decodeTiff--instance Array arr RGB Double => Readable (Image arr RGB Double) TIF where-  decode _ = jpDynamicImageToImage . JP.decodeTiff--instance Array arr RGBA Double => Readable (Image arr RGBA Double) TIF where-  decode _ = jpDynamicImageToImage . JP.decodeTiff------ General decoding and helper functions--jpImageToImageUnsafe :: (Array VS cs e, JP.Pixel jpx) =>-                  JP.Image jpx -> Image VS cs e-jpImageToImageUnsafe (JP.Image n m v) = fromVector (m, n) $ V.unsafeCast v----jpImageToImageSafe :: (Array arr cs e, Convertible jpx (Pixel cs e), JP.Pixel jpx) =>-                      JP.Image jpx -> Image arr cs e-jpImageToImageSafe jimg = makeImage (JP.imageHeight jimg, JP.imageWidth jimg) getPx-  where getPx (y, x) = convert $ JP.pixelAt jimg x y---jpImageY8ToImage :: Either String JP.DynamicImage -> Either String (Image VS Y Word8)-jpImageY8ToImage (Right (JP.ImageY8 jimg)) = Right (jpImageToImageUnsafe jimg)-jpImageY8ToImage jimg = jpCSError "Y8 (Pixel Y Word8)" jimg---jpImageY16ToImage :: Either String JP.DynamicImage -> Either String (Image VS Y Word16)-jpImageY16ToImage (Right (JP.ImageY16 jimg)) = Right (jpImageToImageUnsafe jimg)-jpImageY16ToImage jimg = jpCSError "Y16 (Pixel Y Word16)" jimg--{- -- No JuicyPixels images are actually read in this type-jpImageYFToImage :: Either String JP.DynamicImage -> Either String (Image VS Y Float)-jpImageYFToImage (Right (JP.ImageYF jimg)) = Right (jpImageToImage jimg)-jpImageYFToImage jimg = jpCSError "YF (Pixel Y Float)" jimg--}--jpImageYA8ToImage :: Either String JP.DynamicImage -> Either String (Image VS YA Word8)-jpImageYA8ToImage (Right (JP.ImageYA8 jimg)) = Right (jpImageToImageUnsafe jimg)-jpImageYA8ToImage jimg = jpCSError "YA8 (Pixel YA Word8)" jimg---jpImageYA16ToImage :: Either String JP.DynamicImage -> Either String (Image VS YA Word16)-jpImageYA16ToImage (Right (JP.ImageYA16 jimg)) = Right (jpImageToImageUnsafe jimg)-jpImageYA16ToImage jimg = jpCSError "YA16 (Pixel YA Word16)" jimg---jpImageRGB8ToImage :: Either String JP.DynamicImage -> Either String (Image VS RGB Word8)-jpImageRGB8ToImage (Right (JP.ImageRGB8 jimg)) = Right (jpImageToImageUnsafe jimg)-jpImageRGB8ToImage jimg = jpCSError "RGB8 (Pixel RGB Word8)" jimg---jpImageRGB16ToImage :: Either String JP.DynamicImage -> Either String (Image VS RGB Word16)-jpImageRGB16ToImage (Right (JP.ImageRGB16 jimg)) = Right (jpImageToImageUnsafe jimg)-jpImageRGB16ToImage jimg = jpCSError "RGB16 (Pixel RGB Word16)" jimg---jpImageRGBFToImage :: Either String JP.DynamicImage -> Either String (Image VS RGB Float)-jpImageRGBFToImage (Right (JP.ImageRGBF jimg)) = Right (jpImageToImageUnsafe jimg)-jpImageRGBFToImage jimg = jpCSError "RGBF (Pixel RGB Float)" jimg---jpImageRGBA8ToImage :: Either String JP.DynamicImage -> Either String (Image VS RGBA Word8)-jpImageRGBA8ToImage (Right (JP.ImageRGBA8 jimg)) = Right (jpImageToImageUnsafe jimg)-jpImageRGBA8ToImage jimg = jpCSError "RGBA8 (Pixel RGBA Word8)" jimg---jpImageRGBA16ToImage :: Either String JP.DynamicImage -> Either String (Image VS RGBA Word16)-jpImageRGBA16ToImage (Right (JP.ImageRGBA16 jimg)) = Right (jpImageToImageUnsafe jimg)-jpImageRGBA16ToImage jimg = jpCSError "RGBA16 (Pixel RGBA Word16)" jimg---jpImageYCbCr8ToImage :: Either String JP.DynamicImage -> Either String (Image VS YCbCr Word8)-jpImageYCbCr8ToImage (Right (JP.ImageYCbCr8 jimg)) = Right (jpImageToImageUnsafe jimg)-jpImageYCbCr8ToImage jimg = jpCSError "YCbCr8 (Pixel YCbCr Word8)" jimg---jpImageCMYK8ToImage :: Either String JP.DynamicImage -> Either String (Image VS CMYK Word8)-jpImageCMYK8ToImage (Right (JP.ImageCMYK8 jimg)) = Right (jpImageToImageUnsafe jimg)-jpImageCMYK8ToImage jimg = jpCSError "CMYK8 (Pixel CMYK Word8)" jimg---jpImageCMYK16ToImage :: Either String JP.DynamicImage -> Either String (Image VS CMYK Word16)-jpImageCMYK16ToImage (Right (JP.ImageCMYK16 jimg)) = Right (jpImageToImageUnsafe jimg)-jpImageCMYK16ToImage jimg = jpCSError "CMYK16 (Pixel CMYK Word16)" jimg---jpDynamicImageToImage' :: (Convertible JP.PixelCMYK16 (Pixel cs e),-                           Convertible JP.PixelCMYK8 (Pixel cs e),-                           Convertible JP.PixelRGB16 (Pixel cs e),-                           Convertible JP.PixelRGB8 (Pixel cs e),-                           Convertible JP.PixelRGBA16 (Pixel cs e),-                           Convertible JP.PixelRGBA8 (Pixel cs e),-                           Convertible JP.PixelRGBF (Pixel cs e),-                           Convertible JP.PixelYA16 (Pixel cs e),-                           Convertible JP.PixelYA8 (Pixel cs e),-                           Convertible JP.PixelYCbCr8 (Pixel cs e),-                           Convertible JP.Pixel16 (Pixel cs e),-                           Convertible JP.Pixel8 (Pixel cs e),-                           Convertible JP.PixelF (Pixel cs e),-                           Array arr cs e) =>-                          JP.DynamicImage -> Image arr cs e-jpDynamicImageToImage' (JP.ImageY8 jimg)     = jpImageToImageSafe jimg-jpDynamicImageToImage' (JP.ImageY16 jimg)    = jpImageToImageSafe jimg-jpDynamicImageToImage' (JP.ImageYF jimg)     = jpImageToImageSafe jimg-jpDynamicImageToImage' (JP.ImageYA8 jimg)    = jpImageToImageSafe jimg-jpDynamicImageToImage' (JP.ImageYA16 jimg)   = jpImageToImageSafe jimg-jpDynamicImageToImage' (JP.ImageRGB8 jimg)   = jpImageToImageSafe jimg-jpDynamicImageToImage' (JP.ImageRGB16 jimg)  = jpImageToImageSafe jimg-jpDynamicImageToImage' (JP.ImageRGBF jimg)   = jpImageToImageSafe jimg-jpDynamicImageToImage' (JP.ImageRGBA8 jimg)  = jpImageToImageSafe jimg-jpDynamicImageToImage' (JP.ImageRGBA16 jimg) = jpImageToImageSafe jimg-jpDynamicImageToImage' (JP.ImageYCbCr8 jimg) = jpImageToImageSafe jimg-jpDynamicImageToImage' (JP.ImageCMYK8 jimg)  = jpImageToImageSafe jimg-jpDynamicImageToImage' (JP.ImageCMYK16 jimg) = jpImageToImageSafe jimg---jpDynamicImageToImage :: (Convertible JP.PixelCMYK16 (Pixel cs e),-                          Convertible JP.PixelCMYK8 (Pixel cs e),-                          Convertible JP.PixelRGB16 (Pixel cs e),-                          Convertible JP.PixelRGB8 (Pixel cs e),-                          Convertible JP.PixelRGBA16 (Pixel cs e),-                          Convertible JP.PixelRGBA8 (Pixel cs e),-                          Convertible JP.PixelRGBF (Pixel cs e),-                          Convertible JP.PixelYA16 (Pixel cs e),-                          Convertible JP.PixelYA8 (Pixel cs e),-                          Convertible JP.PixelYCbCr8 (Pixel cs e),-                          Convertible JP.Pixel16 (Pixel cs e),-                          Convertible JP.Pixel8 (Pixel cs e),-                          Convertible JP.PixelF (Pixel cs e), Array arr cs e) =>-                         Either String JP.DynamicImage -> Either String (Image arr cs e)-jpDynamicImageToImage = either jpError (Right . jpDynamicImageToImage')---jpImageShowCS :: JP.DynamicImage -> String-jpImageShowCS (JP.ImageY8 _)     = "Y8 (Pixel Y Word8)"-jpImageShowCS (JP.ImageY16 _)    = "Y16 (Pixel Y Word16)"-jpImageShowCS (JP.ImageYF _)     = "YF (Pixel Y Float)"-jpImageShowCS (JP.ImageYA8 _)    = "YA8 (Pixel YA Word8)"-jpImageShowCS (JP.ImageYA16 _)   = "YA16 (Pixel YA Word16)"-jpImageShowCS (JP.ImageRGB8 _)   = "RGB8 (Pixel RGB Word8)"-jpImageShowCS (JP.ImageRGB16 _)  = "RGB16 (Pixel RGB Word16)"-jpImageShowCS (JP.ImageRGBF _)   = "RGBF (Pixel RGB Float)"-jpImageShowCS (JP.ImageRGBA8 _)  = "RGBA8 (Pixel RGBA Word8)"-jpImageShowCS (JP.ImageRGBA16 _) = "RGBA16 (Pixel RGBA Word16)"-jpImageShowCS (JP.ImageYCbCr8 _) = "YCbCr8 (Pixel YCbCr Word8)"-jpImageShowCS (JP.ImageCMYK8 _)  = "CMYK8 (Pixel CMYK Word8)"-jpImageShowCS (JP.ImageCMYK16 _) = "CMYK16 (Pixel CMYK Word16)"---jpError :: String -> Either String a-jpError err = Left ("JuicyPixel decoding error: "++err)---jpCSError :: String -> Either String JP.DynamicImage -> Either String a-jpCSError _  (Left err)   = jpError err-jpCSError cs (Right jimg) =-  jpError $-  "Input image is in " ++-  jpImageShowCS jimg ++ ", cannot convert it to " ++ cs ++ " colorspace."-------------------------------------------------------------------------------------- Encoding images using JuicyPixels ------------------------------------------------------------------------------------------------------------------------------instance Writable (Image VS Y Word8) BMP where-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) id--instance Writable (Image VS RGB Word8) BMP where-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGB8) id--instance Writable (Image VS RGBA Word8) BMP where-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGBA8) id--instance Writable (Image VS Binary Bit) BMP where-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary--instance Writable (Image VS Y Double) BMP where-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) (fmap toWord8)--instance Writable (Image VS YA Double) BMP where-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8)-                                                ((fmap toWord8) . dropAlpha)--instance Writable (Image VS RGB Double) BMP where-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGB8) (fmap toWord8)--instance Writable (Image VS RGBA Double) BMP where-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGBA8) (fmap toWord8)---- Writable GIF--encodeGIF :: (Array VS cs' e, Array VS cs Word8) =>-             [SaveOption GIF] -> (Pixel cs' e -> Pixel cs Word8)-             -> Image VS cs' e -> BL.ByteString-encodeGIF []                     !conv =-  either error id . uncurry JP.encodeGifImageWithPalette .-  JP.palettize JP.defaultPaletteOptions . imageToJPImage (undefined :: JP.PixelRGB8) conv-encodeGIF (GIFPalette palOpts:_) !conv =-  either error id . uncurry JP.encodeGifImageWithPalette .-  JP.palettize palOpts . imageToJPImage (undefined :: JP.PixelRGB8) conv---instance Writable (Image VS RGB Word8) GIF where-  encode _ opts = encodeGIF opts id-  -instance Writable (Image VS Y Double) GIF where-  encode _ opts = encodeGIF opts ((fmap toWord8) . toPixelRGB)-    -instance Writable (Image VS YA Double) GIF where-  encode _ opts = encodeGIF opts ((fmap toWord8) . toPixelRGB . dropAlpha)--instance Writable (Image VS RGB Double) GIF where-  encode _ opts = encodeGIF opts (fmap toWord8)--instance Writable (Image VS RGBA Double) GIF where-  encode _ opts = encodeGIF opts ((fmap toWord8) . dropAlpha)---encodeGIFs :: (Array VS cs' e, Array VS cs Word8) =>-              [SaveOption [GIF]] -> (Pixel cs' e -> Pixel cs Word8)-           -> [(JP.GifDelay, Image VS cs' e)] -> BL.ByteString-encodeGIFs !opts !conv =-  either error id . JP.encodeGifImages (getGIFsLoop opts) . P.map palletizeGif where-    getGIFsLoop []                   = JP.LoopingNever-    getGIFsLoop (GIFsLooping loop:_) = loop-    getGIFsLoop (_:xs)               = getGIFsLoop xs    -    getGIFsPal []                      = JP.defaultPaletteOptions-    getGIFsPal (GIFsPalette palOpts:_) = palOpts-    getGIFsPal (_:xs)                  = getGIFsPal xs-    palletizeGif !(d, img) = (p, d, jimg) where  -      !(jimg, p) = JP.palettize (getGIFsPal opts) $-                   imageToJPImage (undefined :: JP.PixelRGB8) conv img---instance Writable [(JP.GifDelay, Image VS RGB Word8)] [GIF] where-  encode _ opts = encodeGIFs opts id--instance Writable [(JP.GifDelay, Image VS RGB Double)] [GIF] where-  encode _ opts = encodeGIFs opts (fmap toWord8)--- Writable HDR--instance Writable (Image VS RGB Float) HDR where-  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF) id--instance Writable (Image VS Y Double) HDR where-  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF)-                                             (fmap toFloat . toPixelRGB)--instance Writable (Image VS YA Double) HDR where-  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF)-                                             (fmap toFloat . toPixelRGB . dropAlpha)--instance Writable (Image VS RGB Double) HDR where-  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF) (fmap toFloat)--instance Writable (Image VS RGBA Double) HDR where-  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF)-                                             (fmap toFloat . dropAlpha)- ---- Writable JPG---encodeJPG-  :: (JP.JpgEncodable px, Array VS cs' e, Array VS cs (JP.PixelBaseComponent px)) =>-     [SaveOption JPG]-     -> px-     -> (Pixel cs' e -> Pixel cs (JP.PixelBaseComponent px))-     -> Image VS cs' e-     -> BL.ByteString-encodeJPG []               t conv =-  JP.encodeDirectJpegAtQualityWithMetadata 100 M.mempty . imageToJPImage t conv-encodeJPG (JPGQuality q:_) t conv =-  JP.encodeDirectJpegAtQualityWithMetadata q M.mempty . imageToJPImage t conv---instance Writable (Image VS Y Word8) JPG where-  encode _ opts = encodeJPG opts (undefined :: JP.Pixel8) id--instance Writable (Image VS RGB Word8) JPG where-  encode _ opts = encodeJPG opts (undefined :: JP.PixelRGB8) id--instance Writable (Image VS CMYK Word8) JPG where-  encode _ opts = encodeJPG opts (undefined :: JP.PixelCMYK8) id-               -instance Writable (Image VS YCbCr Word8) JPG where-  encode _ opts = encodeJPG opts (undefined :: JP.PixelYCbCr8) id--instance Writable (Image VS Y Double) JPG where-  encode _ opts = encodeJPG opts (undefined :: JP.Pixel8) (fmap toWord8)--instance Writable (Image VS YA Double) JPG where-  encode _ opts = encodeJPG opts (undefined :: JP.Pixel8) ((fmap toWord8) . dropAlpha) --instance Writable (Image VS RGB Double) JPG where-  encode _ opts = encodeJPG opts (undefined :: JP.PixelRGB8) (fmap toWord8)--instance Writable (Image VS RGBA Double) JPG where-  encode _ opts = encodeJPG opts (undefined :: JP.PixelRGB8) ((fmap toWord8) . dropAlpha) ----- Writable PNG--instance Writable (Image VS Binary Bit) PNG where-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary-  -instance Writable (Image VS Y Word8) PNG where-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel8) id--instance Writable (Image VS Y Word16) PNG where-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel16) id--instance Writable (Image VS YA Word8) PNG where-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelYA8) id--instance Writable (Image VS YA Word16) PNG where-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelYA16) id--instance Writable (Image VS RGB Word8) PNG where-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGB8) id--instance Writable (Image VS RGB Word16) PNG where-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGB16) id--instance Writable (Image VS RGBA Word8) PNG where-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGBA8) id--instance Writable (Image VS RGBA Word16) PNG where-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGBA16) id---instance Writable (Image VS Y Double) PNG where-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel16) (fmap toWord16)--instance Writable (Image VS YA Double) PNG where-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelYA16) (fmap toWord16)--instance Writable (Image VS RGB Double) PNG where-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGB16) (fmap toWord16)--instance Writable (Image VS RGBA Double) PNG where-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGBA16) (fmap toWord16)---- Writable TGA--instance Writable (Image VS Binary Bit) TGA where-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary-  -instance Writable (Image VS Y Word8) TGA where-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) id--instance Writable (Image VS RGB Word8) TGA where-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGB8) id--instance Writable (Image VS RGBA Word8) TGA where-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGBA8) id---instance Writable (Image VS Y Double) TGA where-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) (fmap toWord8)--instance Writable (Image VS YA Double) TGA where-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) ((fmap toWord8) . dropAlpha)--instance Writable (Image VS RGB Double) TGA where-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGB8) (fmap toWord8)--instance Writable (Image VS RGBA Double) TGA where-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGBA8) (fmap toWord8)---- Writable TIF--instance Writable (Image VS Y Word8) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel8) id--instance Writable (Image VS Y Word16) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel16) id--instance Writable (Image VS YA Word8) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYA8) id--instance Writable (Image VS YA Word16) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYA16) id--instance Writable (Image VS RGB Word8) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGB8) id--instance Writable (Image VS RGB Word16) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGB16) id--instance Writable (Image VS RGBA Word8) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGBA8) id--instance Writable (Image VS RGBA Word16) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGBA16) id--instance Writable (Image VS YCbCr Word8) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYCbCr8) id-  -instance Writable (Image VS CMYK Word8) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelCMYK8) id--instance Writable (Image VS CMYK Word16) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelCMYK16) id---instance Writable (Image VS Binary Bit) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary-  -instance Writable (Image VS Y Double) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel16) (fmap toWord16)--instance Writable (Image VS YA Double) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYA16) (fmap toWord16)--instance Writable (Image VS RGB Double) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGB16) (fmap toWord16)--instance Writable (Image VS RGBA Double) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGBA16) (fmap toWord16)--instance Writable (Image VS YCbCr Double) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYCbCr8) (fmap toWord8)--instance Writable (Image VS CMYK Double) TIF where-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelCMYK16) (fmap toWord16)----imageToJPImage :: (JP.Pixel a, Array VS cs' e, Array VS cs (JP.PixelBaseComponent a)) =>-                  a -> (Pixel cs' e -> Pixel cs (JP.PixelBaseComponent a)) -> Image VS cs' e -> JP.Image a-imageToJPImage _ f !img = JP.Image n m $ V.unsafeCast $ toVector $ I.map f img where-  !(m, n) = dims img-{-# INLINE imageToJPImage #-}---    

@@ -0,0 +1,112 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}+-- |+-- Module      : Graphics.Image.IO.Formats.JuicyPixels.Common+-- Copyright   : (c) Alexey Kuleshevich 2017+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+--+module Graphics.Image.IO.Formats.JuicyPixels.Common (+  BMP(..),+  GIF(..), GIFA(..),+  JP.GifDelay, JP.GifLooping(..), JP.PaletteOptions(..), JP.PaletteCreationMethod(..),+  HDR(..),+  JPG(..),+  PNG(..),+  TGA(..),+  TIF(..),+  SaveOption(..),+  ) where++import Graphics.Image.ColorSpace+import Graphics.Image.IO.Base+import qualified Codec.Picture as JP++++++-- | Bitmap image with @.bmp@ extension.+data BMP = BMP++instance ImageFormat BMP where+  data SaveOption BMP++  ext _ = ".bmp"+++-- | Graphics Interchange Format image with @.gif@ extension.+data GIF = GIF++instance ImageFormat GIF where+  data SaveOption GIF = GIFPalette JP.PaletteOptions+  +  ext _ = ".gif"+++  -- | Graphics Interchange Format animated image with @.gif@ extension.+data GIFA = GIFA++instance ImageFormat GIFA where+  data SaveOption GIFA = GIFAPalette JP.PaletteOptions+                       | GIFALooping JP.GifLooping+  +  ext _ = ext GIF++-- | High-dynamic-range image with @.hdr@ or @.pic@ extension.+data HDR = HDR++instance ImageFormat HDR where+  data SaveOption HDR++  ext _ = ".hdr"++  exts _ = [".hdr", ".pic"]+++-- | Joint Photographic Experts Group image with @.jpg@ or @.jpeg@ extension.+data JPG = JPG++instance ImageFormat JPG where+  data SaveOption JPG = JPGQuality Word8++  ext _ = ".jpg"++  exts _ = [".jpg", ".jpeg"]+++-- | Portable Network Graphics image with @.png@ extension.+data PNG = PNG++instance ImageFormat PNG where+  data SaveOption PNG++  ext _ = ".png"+++-- | Truevision Graphics Adapter image with .tga extension.+data TGA = TGA++instance ImageFormat TGA where+  data SaveOption TGA++  ext _ = ".tga"+++-- | Tagged Image File Format image with @.tif@ or @.tiff@ extension.+data TIF = TIF++instance ImageFormat TIF where+  data SaveOption TIF  ++  ext _ = ".tif"++  exts _ = [".tif", ".tiff"]

@@ -0,0 +1,568 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}+-- |+-- Module      : Graphics.Image.IO.Formats.JuicyPixels.Readable+-- Copyright   : (c) Alexey Kuleshevich 2017+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+--+module Graphics.Image.IO.Formats.JuicyPixels.Readable () where++import Prelude as P++import Graphics.Image.ColorSpace+import Graphics.Image.Interface as I+import Graphics.Image.Interface.Vector+import Graphics.Image.IO.Base+import Graphics.Image.IO.Formats.JuicyPixels.Common+import qualified Data.ByteString as B  -- (ByteString)+import qualified Codec.Picture as JP+import qualified Codec.Picture.Types as JP+import qualified Codec.Picture.Gif as JP+import qualified Data.Vector.Storable as V+++--------------------------------------------------------------------------------+-- Converting to and from JuicyPixels ------------------------------------------+--------------------------------------------------------------------------------++---- to JuicyPixels -----++---- Exact precision conversions++instance Convertible JP.Pixel8 (Pixel Y Word8) where+  convert = PixelY+  +instance Convertible JP.Pixel16 (Pixel Y Word16) where+  convert = PixelY++instance Convertible JP.Pixel32 (Pixel Y Word32) where+  convert = PixelY++instance Convertible JP.PixelF (Pixel Y Float) where+  convert = PixelY++instance Convertible JP.PixelYA8 (Pixel YA Word8) where+  convert (JP.PixelYA8 g a) = PixelYA g a+  +instance Convertible JP.PixelYA16 (Pixel YA Word16) where+  convert (JP.PixelYA16 g a) = PixelYA g a++instance Convertible JP.PixelRGB8 (Pixel RGB Word8) where+  convert (JP.PixelRGB8 r g b) = PixelRGB r g b+  +instance Convertible JP.PixelRGB16 (Pixel RGB Word16) where+  convert (JP.PixelRGB16 r g b) = PixelRGB r g b++instance Convertible JP.PixelRGBF (Pixel RGB Float) where+  convert (JP.PixelRGBF r g b) = PixelRGB r g b++instance Convertible JP.PixelRGBA8 (Pixel RGBA Word8) where+  convert (JP.PixelRGBA8 r g b a) = PixelRGBA r g b a+  +instance Convertible JP.PixelRGBA16 (Pixel RGBA Word16) where+  convert (JP.PixelRGBA16 r g b a) = PixelRGBA r g b a++instance Convertible JP.PixelYCbCr8 (Pixel YCbCr Word8) where+  convert (JP.PixelYCbCr8 y cb cr) = PixelYCbCr y cb cr++instance Convertible JP.PixelCMYK8 (Pixel CMYK Word8) where+  convert (JP.PixelCMYK8 c m y k) = PixelCMYK c m y k++instance Convertible JP.PixelCMYK16 (Pixel CMYK Word16) where+  convert (JP.PixelCMYK16 c m y k) = PixelCMYK c m y k++++instance Convertible (Pixel Y Word8) JP.Pixel8 where+  convert (PixelY y) = y+  +instance Convertible (Pixel Y Word16) JP.Pixel16 where+  convert (PixelY y) = y++instance Convertible (Pixel Y Word32) JP.Pixel32 where+  convert (PixelY y) = y++instance Convertible (Pixel Y Float) JP.PixelF where+  convert (PixelY y) = y++instance Convertible (Pixel YA Word8) JP.PixelYA8 where+  convert (PixelYA y a) = JP.PixelYA8 y a+  +instance Convertible (Pixel YA Word16) JP.PixelYA16 where+  convert (PixelYA y a) = JP.PixelYA16 y a++instance Convertible (Pixel RGB Word8) JP.PixelRGB8 where+  convert (PixelRGB r g b) = JP.PixelRGB8 r g b+  +instance Convertible (Pixel RGB Word16) JP.PixelRGB16 where+  convert (PixelRGB r g b) = JP.PixelRGB16 r g b++instance Convertible (Pixel RGB Float) JP.PixelRGBF where+  convert (PixelRGB r g b) = JP.PixelRGBF r g b++instance Convertible (Pixel RGBA Word8) JP.PixelRGBA8 where+  convert (PixelRGBA r g b a) = JP.PixelRGBA8 r g b a+  +instance Convertible (Pixel RGBA Word16) JP.PixelRGBA16 where+  convert (PixelRGBA r g b a) = JP.PixelRGBA16 r g b a++instance Convertible (Pixel YCbCr Word8) JP.PixelYCbCr8 where+  convert (PixelYCbCr y cb cr) = JP.PixelYCbCr8 y cb cr++instance Convertible (Pixel CMYK Word8) JP.PixelCMYK8 where+  convert (PixelCMYK c m y k) = JP.PixelCMYK8 c m y k++instance Convertible (Pixel CMYK Word16) JP.PixelCMYK16 where+  convert (PixelCMYK c m y k) = JP.PixelCMYK16 c m y k++++--------------------------------------------------------------------------------+-- Decoding images using JuicyPixels ------------------------------------------+--------------------------------------------------------------------------------+++-- BMP Format Reading++instance Readable (Image VS Binary Bit) BMP where+  decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodeBitmap++instance Readable (Image VS Y Word8) BMP where+  decode _ = jpImageY8ToImage . JP.decodeBitmap++instance Readable (Image VS RGB Word8) BMP where+  decode _ = jpImageRGB8ToImage . JP.decodeBitmap++instance Readable (Image VS RGBA Word8) BMP where+  decode _ = jpImageRGBA8ToImage . JP.decodeBitmap++++-- GIF Format Reading++instance Readable (Image VS RGB Word8) GIF where+  decode _ = jpImageRGB8ToImage . JP.decodeGif++instance Readable (Image VS RGBA Word8) GIF where+  decode _ = jpImageRGBA8ToImage . JP.decodeGif+++-- Animated GIF Format frames reading into a list++decodeGifs :: (Either String JP.DynamicImage -> Either String img)+           -> B.ByteString -> Either String [img]+decodeGifs decoder bs = do+  imgs <- JP.decodeGifImages bs+  sequence $ fmap (decoder . Right) imgs+++decodeGifsDelays :: (Either String JP.DynamicImage -> Either String img)+                 -> B.ByteString -> Either String [(GifDelay, img)]+decodeGifsDelays decoder bs = do+  imgs <- JP.decodeGifImages bs+  delays <- JP.getDelaysGifImages bs+  gifs <- sequence $ fmap (decoder . Right) imgs+  return $ zip delays gifs++++instance Readable [Image VS RGB Word8] GIFA where+  decode _ = decodeGifs jpImageRGB8ToImage++instance Readable [Image VS RGBA Word8] GIFA where+  decode _ = decodeGifs jpImageRGBA8ToImage++instance Readable [(GifDelay, Image VS RGB Word8)] GIFA where+  decode _ = decodeGifsDelays jpImageRGB8ToImage++instance Readable [(GifDelay, Image VS RGBA Word8)] GIFA where+  decode _ = decodeGifsDelays jpImageRGBA8ToImage+++-- HDR Format Reading++instance Readable (Image VS RGB Float) HDR where+  decode _ = jpImageRGBFToImage . JP.decodeHDR+++-- JPG Format Reading++instance Readable (Image VS Y Word8) JPG where+  decode _ = jpImageY8ToImage . JP.decodeJpeg++instance Readable (Image VS YA Word8) JPG where+  decode _ = jpImageYA8ToImage . JP.decodeJpeg++instance Readable (Image VS RGB Word8) JPG where+  decode _ = jpImageRGB8ToImage . JP.decodeJpeg++instance Readable (Image VS CMYK Word8) JPG where+  decode _ = jpImageCMYK8ToImage . JP.decodeJpeg++instance Readable (Image VS YCbCr Word8) JPG where+  decode _ = jpImageYCbCr8ToImage . JP.decodeJpeg+++-- PNG Format Reading++instance Readable (Image VS Binary Bit) PNG where+  decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodePng++instance Readable (Image VS Y Word8) PNG where+  decode _ = jpImageY8ToImage . JP.decodePng++instance Readable (Image VS Y Word16) PNG where+  decode _ = jpImageY16ToImage . JP.decodePng++instance Readable (Image VS YA Word8) PNG where+  decode _ = jpImageYA8ToImage . JP.decodePng++instance Readable (Image VS YA Word16) PNG where+  decode _ = jpImageYA16ToImage . JP.decodePng++instance Readable (Image VS RGB Word8) PNG where+  decode _ = jpImageRGB8ToImage . JP.decodePng++instance Readable (Image VS RGB Word16) PNG where+  decode _ = jpImageRGB16ToImage . JP.decodePng++instance Readable (Image VS RGBA Word8) PNG where+  decode _ = jpImageRGBA8ToImage . JP.decodePng++instance Readable (Image VS RGBA Word16) PNG where+  decode _ = jpImageRGBA16ToImage . JP.decodePng+++-- TGA Format Reading++instance Readable (Image VS Binary Bit) TGA where+  decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodeTga++instance Readable (Image VS Y Word8) TGA where+  decode _ = jpImageY8ToImage . JP.decodeTga++instance Readable (Image VS RGB Word8) TGA where+  decode _ = jpImageRGB8ToImage . JP.decodeTga++instance Readable (Image VS RGBA Word8) TGA where+  decode _ = jpImageRGBA8ToImage . JP.decodeTga+++-- TIF Format Reading++instance Readable (Image VS Binary Bit) TIF where+  decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodeTiff++instance Readable (Image VS Y Word8) TIF where+  decode _ = jpImageY8ToImage . JP.decodeTiff++instance Readable (Image VS Y Word16) TIF where+  decode _ = jpImageY16ToImage . JP.decodeTiff++instance Readable (Image VS YA Word8) TIF where+  decode _ = jpImageYA8ToImage . JP.decodeTiff++instance Readable (Image VS YA Word16) TIF where+  decode _ = jpImageYA16ToImage . JP.decodeTiff++instance Readable (Image VS RGB Word8) TIF where+  decode _ = jpImageRGB8ToImage . JP.decodeTiff++instance Readable (Image VS RGB Word16) TIF where+  decode _ = jpImageRGB16ToImage . JP.decodeTiff++instance Readable (Image VS RGBA Word8) TIF where+  decode _ = jpImageRGBA8ToImage . JP.decodeTiff++instance Readable (Image VS RGBA Word16) TIF where+  decode _ = jpImageRGBA16ToImage . JP.decodeTiff++instance Readable (Image VS CMYK Word8) TIF where+  decode _ = jpImageCMYK8ToImage . JP.decodeTiff++instance Readable (Image VS CMYK Word16) TIF where+  decode _ = jpImageCMYK16ToImage . JP.decodeTiff+++-- To Double precision safe conversion++instance Readable (Image VS Y Double) BMP where+  decode _ = jpDynamicImageToImage . JP.decodeBitmap++instance Readable (Image VS YA Double) BMP where+  decode _ = jpDynamicImageToImage . JP.decodeBitmap++instance Readable (Image VS RGB Double) BMP where+  decode _ = jpDynamicImageToImage . JP.decodeBitmap++instance Readable (Image VS RGBA Double) BMP where+  decode _ = jpDynamicImageToImage . JP.decodeBitmap+++instance Readable (Image VS Y Double) GIF where+  decode _ = jpDynamicImageToImage . JP.decodeGif++instance Readable (Image VS YA Double) GIF where+  decode _ = jpDynamicImageToImage . JP.decodeGif++instance Readable (Image VS RGB Double) GIF where+  decode _ = jpDynamicImageToImage . JP.decodeGif++instance Readable (Image VS RGBA Double) GIF where+  decode _ = jpDynamicImageToImage . JP.decodeGif+++instance Readable [Image VS Y Double] GIFA where+  decode _ = decodeGifs jpDynamicImageToImage++instance Readable [Image VS YA Double] GIFA where+  decode _ = decodeGifs jpDynamicImageToImage++instance Readable [Image VS RGB Double] GIFA where+  decode _ = decodeGifs jpDynamicImageToImage++instance Readable [Image VS RGBA Double] GIFA where+  decode _ = decodeGifs jpDynamicImageToImage+++instance Readable (Image VS Y Double) HDR where+  decode _ = jpDynamicImageToImage . JP.decodeHDR++instance Readable (Image VS YA Double) HDR where+  decode _ = jpDynamicImageToImage . JP.decodeHDR++instance Readable (Image VS RGB Double) HDR where+  decode _ = jpDynamicImageToImage . JP.decodeHDR++instance Readable (Image VS RGBA Double) HDR where+  decode _ = jpDynamicImageToImage . JP.decodeHDR+++instance Readable (Image VS Y Double) JPG where+  decode _ = jpDynamicImageToImage . JP.decodeJpeg++instance Readable (Image VS YA Double) JPG where+  decode _ = jpDynamicImageToImage . JP.decodeJpeg++instance Readable (Image VS RGB Double) JPG where+  decode _ = jpDynamicImageToImage . JP.decodeJpeg++instance Readable (Image VS RGBA Double) JPG where+  decode _ = jpDynamicImageToImage . JP.decodeJpeg+++instance Readable (Image VS Y Double) PNG where+  decode _ = jpDynamicImageToImage . JP.decodePng++instance Readable (Image VS YA Double) PNG where+  decode _ = jpDynamicImageToImage . JP.decodePng++instance Readable (Image VS RGB Double) PNG where+  decode _ = jpDynamicImageToImage . JP.decodePng++instance Readable (Image VS RGBA Double) PNG where+  decode _ = jpDynamicImageToImage . JP.decodePng+++instance Readable (Image VS Y Double) TGA where+  decode _ = jpDynamicImageToImage . JP.decodeTga++instance Readable (Image VS YA Double) TGA where+  decode _ = jpDynamicImageToImage . JP.decodeTga++instance Readable (Image VS RGB Double) TGA where+  decode _ = jpDynamicImageToImage . JP.decodeTga++instance Readable (Image VS RGBA Double) TGA where+  decode _ = jpDynamicImageToImage . JP.decodeTga+++instance Readable (Image VS Y Double) TIF where+  decode _ = jpDynamicImageToImage . JP.decodeTiff++instance Readable (Image VS YA Double) TIF where+  decode _ = jpDynamicImageToImage . JP.decodeTiff++instance Readable (Image VS RGB Double) TIF where+  decode _ = jpDynamicImageToImage . JP.decodeTiff++instance Readable (Image VS RGBA Double) TIF where+  decode _ = jpDynamicImageToImage . JP.decodeTiff++++-- General decoding and helper functions++jpImageToImageUnsafe :: (Array VS cs e, JP.Pixel jpx) =>+                        JP.Image jpx -> Image VS cs e+jpImageToImageUnsafe (JP.Image n m !v) = fromVector (m, n) $ V.unsafeCast v++++-- jpImageToImageSafe :: (Array arr cs e, Convertible jpx (Pixel cs e), JP.Pixel jpx) =>+--                       JP.Image jpx -> Image arr cs e+-- jpImageToImageSafe !jimg = makeImage (JP.imageHeight jimg, JP.imageWidth jimg) getPx+--   where getPx !(y, x) = convert $ JP.pixelAt jimg x y+++jpImageY8ToImage :: Either String JP.DynamicImage -> Either String (Image VS Y Word8)+jpImageY8ToImage (Right (JP.ImageY8 jimg)) = Right (jpImageToImageUnsafe jimg)+jpImageY8ToImage jimg = jpCSError "Y8 (Pixel Y Word8)" jimg+++jpImageY16ToImage :: Either String JP.DynamicImage -> Either String (Image VS Y Word16)+jpImageY16ToImage (Right (JP.ImageY16 jimg)) = Right (jpImageToImageUnsafe jimg)+jpImageY16ToImage jimg = jpCSError "Y16 (Pixel Y Word16)" jimg++{- -- No JuicyPixels images are actually read in this type+jpImageYFToImage :: Either String JP.DynamicImage -> Either String (Image VS Y Float)+jpImageYFToImage (Right (JP.ImageYF jimg)) = Right (jpImageToImage jimg)+jpImageYFToImage jimg = jpCSError "YF (Pixel Y Float)" jimg+-}++jpImageYA8ToImage :: Either String JP.DynamicImage -> Either String (Image VS YA Word8)+jpImageYA8ToImage (Right (JP.ImageYA8 jimg)) = Right (jpImageToImageUnsafe jimg)+jpImageYA8ToImage jimg = jpCSError "YA8 (Pixel YA Word8)" jimg+++jpImageYA16ToImage :: Either String JP.DynamicImage -> Either String (Image VS YA Word16)+jpImageYA16ToImage (Right (JP.ImageYA16 jimg)) = Right (jpImageToImageUnsafe jimg)+jpImageYA16ToImage jimg = jpCSError "YA16 (Pixel YA Word16)" jimg+++jpImageRGB8ToImage :: Either String JP.DynamicImage -> Either String (Image VS RGB Word8)+jpImageRGB8ToImage (Right (JP.ImageRGB8 jimg)) = Right (jpImageToImageUnsafe jimg)+jpImageRGB8ToImage jimg = jpCSError "RGB8 (Pixel RGB Word8)" jimg+++jpImageRGB16ToImage :: Either String JP.DynamicImage -> Either String (Image VS RGB Word16)+jpImageRGB16ToImage (Right (JP.ImageRGB16 jimg)) = Right (jpImageToImageUnsafe jimg)+jpImageRGB16ToImage jimg = jpCSError "RGB16 (Pixel RGB Word16)" jimg+++jpImageRGBFToImage :: Either String JP.DynamicImage -> Either String (Image VS RGB Float)+jpImageRGBFToImage (Right (JP.ImageRGBF jimg)) = Right (jpImageToImageUnsafe jimg)+jpImageRGBFToImage jimg = jpCSError "RGBF (Pixel RGB Float)" jimg+++jpImageRGBA8ToImage :: Either String JP.DynamicImage -> Either String (Image VS RGBA Word8)+jpImageRGBA8ToImage (Right (JP.ImageRGBA8 jimg)) = Right (jpImageToImageUnsafe jimg)+jpImageRGBA8ToImage jimg = jpCSError "RGBA8 (Pixel RGBA Word8)" jimg+++jpImageRGBA16ToImage :: Either String JP.DynamicImage -> Either String (Image VS RGBA Word16)+jpImageRGBA16ToImage (Right (JP.ImageRGBA16 jimg)) = Right (jpImageToImageUnsafe jimg)+jpImageRGBA16ToImage jimg = jpCSError "RGBA16 (Pixel RGBA Word16)" jimg+++jpImageYCbCr8ToImage :: Either String JP.DynamicImage -> Either String (Image VS YCbCr Word8)+jpImageYCbCr8ToImage (Right (JP.ImageYCbCr8 jimg)) = Right (jpImageToImageUnsafe jimg)+jpImageYCbCr8ToImage jimg = jpCSError "YCbCr8 (Pixel YCbCr Word8)" jimg+++jpImageCMYK8ToImage :: Either String JP.DynamicImage -> Either String (Image VS CMYK Word8)+jpImageCMYK8ToImage (Right (JP.ImageCMYK8 jimg)) = Right (jpImageToImageUnsafe jimg)+jpImageCMYK8ToImage jimg = jpCSError "CMYK8 (Pixel CMYK Word8)" jimg+++jpImageCMYK16ToImage :: Either String JP.DynamicImage -> Either String (Image VS CMYK Word16)+jpImageCMYK16ToImage (Right (JP.ImageCMYK16 jimg)) = Right (jpImageToImageUnsafe jimg)+jpImageCMYK16ToImage jimg = jpCSError "CMYK16 (Pixel CMYK Word16)" jimg+++jpDynamicImageToImage' :: (Convertible (Pixel Y Word8) (Pixel cs e),+                           Convertible (Pixel YA Word8) (Pixel cs e),+                           Convertible (Pixel Y Word16) (Pixel cs e),+                           Convertible (Pixel YA Word16) (Pixel cs e),+                           Convertible (Pixel Y Float) (Pixel cs e),+                           Convertible (Pixel RGB Word8) (Pixel cs e),+                           Convertible (Pixel RGBA Word8) (Pixel cs e),+                           Convertible (Pixel RGB Word16) (Pixel cs e),+                           Convertible (Pixel RGBA Word16) (Pixel cs e),+                           Convertible (Pixel RGB Float) (Pixel cs e),+                           Convertible (Pixel YCbCr Word8) (Pixel cs e),+                           Convertible (Pixel CMYK Word8) (Pixel cs e),+                           Convertible (Pixel CMYK Word16) (Pixel cs e),+                           Array VS cs e) =>+                          JP.DynamicImage -> Image VS cs e+jpDynamicImageToImage' (JP.ImageY8 jimg)     =+  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS Y Word8)+jpDynamicImageToImage' (JP.ImageYA8 jimg)    =+  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS YA Word8)+jpDynamicImageToImage' (JP.ImageY16 jimg)    =+  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS Y Word16)+jpDynamicImageToImage' (JP.ImageYA16 jimg)   =+  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS YA Word16)+jpDynamicImageToImage' (JP.ImageYF jimg)     =+  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS Y Float)+jpDynamicImageToImage' (JP.ImageRGB8 jimg)   =+  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS RGB Word8)+jpDynamicImageToImage' (JP.ImageRGBA8 jimg)  =+  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS RGBA Word8)+jpDynamicImageToImage' (JP.ImageRGB16 jimg)  =+  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS RGB Word16)+jpDynamicImageToImage' (JP.ImageRGBA16 jimg) =+  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS RGBA Word16)+jpDynamicImageToImage' (JP.ImageRGBF jimg)   =+  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS RGB Float)+jpDynamicImageToImage' (JP.ImageYCbCr8 jimg) =+  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS YCbCr Word8)+jpDynamicImageToImage' (JP.ImageCMYK8 jimg)  =+  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS CMYK Word8)+jpDynamicImageToImage' (JP.ImageCMYK16 jimg) =+  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS CMYK Word16)+++jpDynamicImageToImage :: (Convertible (Pixel Y Word8) (Pixel cs e),+                          Convertible (Pixel YA Word8) (Pixel cs e),+                          Convertible (Pixel Y Word16) (Pixel cs e),+                          Convertible (Pixel YA Word16) (Pixel cs e),+                          Convertible (Pixel Y Float) (Pixel cs e),+                          Convertible (Pixel RGB Word8) (Pixel cs e),+                          Convertible (Pixel RGBA Word8) (Pixel cs e),+                          Convertible (Pixel RGB Word16) (Pixel cs e),+                          Convertible (Pixel RGBA Word16) (Pixel cs e),+                          Convertible (Pixel RGB Float) (Pixel cs e),+                          Convertible (Pixel YCbCr Word8) (Pixel cs e),+                          Convertible (Pixel CMYK Word8) (Pixel cs e),+                          Convertible (Pixel CMYK Word16) (Pixel cs e),+                          Array VS cs e) =>+                         Either String JP.DynamicImage -> Either String (Image VS cs e)+jpDynamicImageToImage = either jpError (Right . jpDynamicImageToImage')+++jpImageShowCS :: JP.DynamicImage -> String+jpImageShowCS (JP.ImageY8 _)     = "Y8 (Pixel Y Word8)"+jpImageShowCS (JP.ImageY16 _)    = "Y16 (Pixel Y Word16)"+jpImageShowCS (JP.ImageYF _)     = "YF (Pixel Y Float)"+jpImageShowCS (JP.ImageYA8 _)    = "YA8 (Pixel YA Word8)"+jpImageShowCS (JP.ImageYA16 _)   = "YA16 (Pixel YA Word16)"+jpImageShowCS (JP.ImageRGB8 _)   = "RGB8 (Pixel RGB Word8)"+jpImageShowCS (JP.ImageRGB16 _)  = "RGB16 (Pixel RGB Word16)"+jpImageShowCS (JP.ImageRGBF _)   = "RGBF (Pixel RGB Float)"+jpImageShowCS (JP.ImageRGBA8 _)  = "RGBA8 (Pixel RGBA Word8)"+jpImageShowCS (JP.ImageRGBA16 _) = "RGBA16 (Pixel RGBA Word16)"+jpImageShowCS (JP.ImageYCbCr8 _) = "YCbCr8 (Pixel YCbCr Word8)"+jpImageShowCS (JP.ImageCMYK8 _)  = "CMYK8 (Pixel CMYK Word8)"+jpImageShowCS (JP.ImageCMYK16 _) = "CMYK16 (Pixel CMYK Word16)"+++jpError :: String -> Either String a+jpError err = Left ("JuicyPixel decoding error: "++err)+++jpCSError :: String -> Either String JP.DynamicImage -> Either String a+jpCSError _  (Left err)   = jpError err+jpCSError cs (Right jimg) =+  jpError $+  "Input image is in " +++  jpImageShowCS jimg ++ ", cannot convert it to " ++ cs ++ " colorspace."

@@ -0,0 +1,305 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}+-- |+-- Module      : Graphics.Image.IO.Formats.JuicyPixels.Writable+-- Copyright   : (c) Alexey Kuleshevich 2017+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+--+module Graphics.Image.IO.Formats.JuicyPixels.Writable () where++import Prelude as P+import qualified Data.Monoid as M (mempty)+import Graphics.Image.ColorSpace+import Graphics.Image.Interface as I+import Graphics.Image.Interface.Vector+import Graphics.Image.IO.Base+import Graphics.Image.IO.Formats.JuicyPixels.Common+import qualified Data.ByteString.Lazy as BL (ByteString)+import qualified Codec.Picture as JP+import qualified Codec.Picture.Jpg as JP+import qualified Codec.Picture.ColorQuant as JP+import qualified Data.Vector.Storable as V++--------------------------------------------------------------------------------+-- Encoding images using JuicyPixels -------------------------------------------+--------------------------------------------------------------------------------++instance Writable (Image VS Y Word8) BMP where+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) id++instance Writable (Image VS RGB Word8) BMP where+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGB8) id++instance Writable (Image VS RGBA Word8) BMP where+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGBA8) id++instance Writable (Image VS Binary Bit) BMP where+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary++instance Writable (Image VS Y Double) BMP where+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) (fmap toWord8)++instance Writable (Image VS YA Double) BMP where+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8)+                                                ((fmap toWord8) . dropAlpha)++instance Writable (Image VS RGB Double) BMP where+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGB8) (fmap toWord8)++instance Writable (Image VS RGBA Double) BMP where+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGBA8) (fmap toWord8)++-- Writable GIF++encodeGIF :: (Array VS cs' e, Array VS cs Word8) =>+             [SaveOption GIF] -> (Pixel cs' e -> Pixel cs Word8)+             -> Image VS cs' e -> BL.ByteString+encodeGIF []                     !conv =+  either error id . uncurry JP.encodeGifImageWithPalette .+  JP.palettize JP.defaultPaletteOptions . imageToJPImage (undefined :: JP.PixelRGB8) conv+encodeGIF (GIFPalette palOpts:_) !conv =+  either error id . uncurry JP.encodeGifImageWithPalette .+  JP.palettize palOpts . imageToJPImage (undefined :: JP.PixelRGB8) conv+++instance Writable (Image VS RGB Word8) GIF where+  encode _ opts = encodeGIF opts id+  +instance Writable (Image VS Y Double) GIF where+  encode _ opts = encodeGIF opts ((fmap toWord8) . toPixelRGB)+    +instance Writable (Image VS YA Double) GIF where+  encode _ opts = encodeGIF opts ((fmap toWord8) . toPixelRGB . dropAlpha)++instance Writable (Image VS RGB Double) GIF where+  encode _ opts = encodeGIF opts (fmap toWord8)++instance Writable (Image VS RGBA Double) GIF where+  encode _ opts = encodeGIF opts ((fmap toWord8) . dropAlpha)+++encodeGIFA :: (Array VS cs' e, Array VS cs Word8) =>+              [SaveOption GIFA] -> (Pixel cs' e -> Pixel cs Word8)+           -> [(JP.GifDelay, Image VS cs' e)] -> BL.ByteString+encodeGIFA !opts !conv =+  either error id . JP.encodeGifImages (getGIFALoop opts) . P.map palletizeGif where+    getGIFALoop []                   = JP.LoopingNever+    getGIFALoop (GIFALooping loop:_) = loop+    getGIFALoop (_:xs)               = getGIFALoop xs    +    getGIFAPal []                      = JP.defaultPaletteOptions+    getGIFAPal (GIFAPalette palOpts:_) = palOpts+    getGIFAPal (_:xs)                  = getGIFAPal xs+    palletizeGif !(d, img) = (p, d, jimg) where  +      !(jimg, p) = JP.palettize (getGIFAPal opts) $+                   imageToJPImage (undefined :: JP.PixelRGB8) conv img+++instance Writable [(JP.GifDelay, Image VS RGB Word8)] GIFA where+  encode _ opts = encodeGIFA opts id++instance Writable [(JP.GifDelay, Image VS RGB Double)] GIFA where+  encode _ opts = encodeGIFA opts (fmap toWord8)++-- Writable HDR++instance Writable (Image VS RGB Float) HDR where+  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF) id++instance Writable (Image VS Y Double) HDR where+  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF)+                                             (fmap toFloat . toPixelRGB)++instance Writable (Image VS YA Double) HDR where+  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF)+                                             (fmap toFloat . toPixelRGB . dropAlpha)++instance Writable (Image VS RGB Double) HDR where+  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF) (fmap toFloat)++instance Writable (Image VS RGBA Double) HDR where+  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF)+                                             (fmap toFloat . dropAlpha)+ ++-- Writable JPG+++encodeJPG+  :: (JP.JpgEncodable px, Array VS cs' e, Array VS cs (JP.PixelBaseComponent px)) =>+     [SaveOption JPG]+     -> px+     -> (Pixel cs' e -> Pixel cs (JP.PixelBaseComponent px))+     -> Image VS cs' e+     -> BL.ByteString+encodeJPG []               t conv =+  JP.encodeDirectJpegAtQualityWithMetadata 100 M.mempty . imageToJPImage t conv+encodeJPG (JPGQuality q:_) t conv =+  JP.encodeDirectJpegAtQualityWithMetadata q M.mempty . imageToJPImage t conv+++instance Writable (Image VS Y Word8) JPG where+  encode _ opts = encodeJPG opts (undefined :: JP.Pixel8) id++instance Writable (Image VS RGB Word8) JPG where+  encode _ opts = encodeJPG opts (undefined :: JP.PixelRGB8) id++instance Writable (Image VS CMYK Word8) JPG where+  encode _ opts = encodeJPG opts (undefined :: JP.PixelCMYK8) id+               +instance Writable (Image VS YCbCr Word8) JPG where+  encode _ opts = encodeJPG opts (undefined :: JP.PixelYCbCr8) id++instance Writable (Image VS Y Double) JPG where+  encode _ opts = encodeJPG opts (undefined :: JP.Pixel8) (fmap toWord8)++instance Writable (Image VS YA Double) JPG where+  encode _ opts = encodeJPG opts (undefined :: JP.Pixel8) ((fmap toWord8) . dropAlpha) ++instance Writable (Image VS RGB Double) JPG where+  encode _ opts = encodeJPG opts (undefined :: JP.PixelRGB8) (fmap toWord8)++instance Writable (Image VS RGBA Double) JPG where+  encode _ opts = encodeJPG opts (undefined :: JP.PixelRGB8) ((fmap toWord8) . dropAlpha) +++-- Writable PNG++instance Writable (Image VS Binary Bit) PNG where+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary+  +instance Writable (Image VS Y Word8) PNG where+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel8) id++instance Writable (Image VS Y Word16) PNG where+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel16) id++instance Writable (Image VS YA Word8) PNG where+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelYA8) id++instance Writable (Image VS YA Word16) PNG where+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelYA16) id++instance Writable (Image VS RGB Word8) PNG where+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGB8) id++instance Writable (Image VS RGB Word16) PNG where+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGB16) id++instance Writable (Image VS RGBA Word8) PNG where+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGBA8) id++instance Writable (Image VS RGBA Word16) PNG where+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGBA16) id+++instance Writable (Image VS Y Double) PNG where+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel16) (fmap toWord16)++instance Writable (Image VS YA Double) PNG where+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelYA16) (fmap toWord16)++instance Writable (Image VS RGB Double) PNG where+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGB16) (fmap toWord16)++instance Writable (Image VS RGBA Double) PNG where+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGBA16) (fmap toWord16)++-- Writable TGA++instance Writable (Image VS Binary Bit) TGA where+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary+  +instance Writable (Image VS Y Word8) TGA where+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) id++instance Writable (Image VS RGB Word8) TGA where+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGB8) id++instance Writable (Image VS RGBA Word8) TGA where+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGBA8) id+++instance Writable (Image VS Y Double) TGA where+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) (fmap toWord8)++instance Writable (Image VS YA Double) TGA where+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) ((fmap toWord8) . dropAlpha)++instance Writable (Image VS RGB Double) TGA where+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGB8) (fmap toWord8)++instance Writable (Image VS RGBA Double) TGA where+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGBA8) (fmap toWord8)++-- Writable TIF++instance Writable (Image VS Y Word8) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel8) id++instance Writable (Image VS Y Word16) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel16) id++instance Writable (Image VS YA Word8) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYA8) id++instance Writable (Image VS YA Word16) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYA16) id++instance Writable (Image VS RGB Word8) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGB8) id++instance Writable (Image VS RGB Word16) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGB16) id++instance Writable (Image VS RGBA Word8) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGBA8) id++instance Writable (Image VS RGBA Word16) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGBA16) id++instance Writable (Image VS YCbCr Word8) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYCbCr8) id+  +instance Writable (Image VS CMYK Word8) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelCMYK8) id++instance Writable (Image VS CMYK Word16) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelCMYK16) id+++instance Writable (Image VS Binary Bit) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary+  +instance Writable (Image VS Y Double) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel16) (fmap toWord16)++instance Writable (Image VS YA Double) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYA16) (fmap toWord16)++instance Writable (Image VS RGB Double) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGB16) (fmap toWord16)++instance Writable (Image VS RGBA Double) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGBA16) (fmap toWord16)++instance Writable (Image VS YCbCr Double) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYCbCr8) (fmap toWord8)++instance Writable (Image VS CMYK Double) TIF where+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelCMYK16) (fmap toWord16)++++imageToJPImage :: (JP.Pixel a, Array VS cs' e, Array VS cs (JP.PixelBaseComponent a)) =>+                  a -> (Pixel cs' e -> Pixel cs (JP.PixelBaseComponent a)) -> Image VS cs' e -> JP.Image a+imageToJPImage _ f !img = JP.Image n m $ V.unsafeCast $ toVector $ I.map f img where+  !(m, n) = dims img

@@ -15,9 +15,8 @@   PBM(..), PGM(..), PPM(..)   ) where - import Graphics.Image.ColorSpace-import Graphics.Image.Interface hiding (map)+import Graphics.Image.Interface as I import Graphics.Image.Interface.Vector import Graphics.Image.IO.Base import Foreign.Storable (Storable)@@ -75,76 +74,7 @@ -- Converting to and from Netpbm ----------------------------------------------- -------------------------------------------------------------------------------- --- -> Y (Double) -instance Convertible PNM.PbmPixel (Pixel Y Double) where-  convert (PNM.PbmPixel bool) = PixelY $ if bool then 0 else 1-  -instance Convertible PNM.PgmPixel8 (Pixel Y Double) where-  convert (PNM.PgmPixel8 w8) = PixelY $ toDouble w8--instance Convertible PNM.PgmPixel16 (Pixel Y Double) where-  convert (PNM.PgmPixel16 w16) = PixelY $ toDouble w16--instance Convertible PNM.PpmPixelRGB8 (Pixel Y Double) where-  convert (PNM.PpmPixelRGB8 r g b) = toPixelY . fmap toDouble $ PixelRGB r g b--instance Convertible PNM.PpmPixelRGB16 (Pixel Y Double) where-  convert (PNM.PpmPixelRGB16 r g b) = toPixelY . fmap toDouble $ PixelRGB r g b---- -> YA (Double)--instance Convertible PNM.PbmPixel (Pixel YA Double) where-  convert = addAlpha 1 . (convert :: PNM.PbmPixel -> Pixel Y Double)-  -instance Convertible PNM.PgmPixel8 (Pixel YA Double) where-  convert = addAlpha 1 . (convert :: PNM.PgmPixel8 -> Pixel Y Double)--instance Convertible PNM.PgmPixel16 (Pixel YA Double) where-  convert = addAlpha 1 . (convert :: PNM.PgmPixel16 -> Pixel Y Double)--instance Convertible PNM.PpmPixelRGB8 (Pixel YA Double) where-  convert = addAlpha 1 . (convert :: PNM.PpmPixelRGB8 -> Pixel Y Double)--instance Convertible PNM.PpmPixelRGB16 (Pixel YA Double) where-  convert = addAlpha 1 . (convert :: PNM.PpmPixelRGB16 -> Pixel Y Double)---- -> RGB (Double)--instance Convertible PNM.PbmPixel (Pixel RGB Double) where-  convert = toPixelRGB . (convert :: PNM.PbmPixel -> Pixel Y Double)-  -instance Convertible PNM.PgmPixel8 (Pixel RGB Double) where-  convert = toPixelRGB . (convert :: PNM.PgmPixel8 -> Pixel Y Double)--instance Convertible PNM.PgmPixel16 (Pixel RGB Double) where-  convert = toPixelRGB . (convert :: PNM.PgmPixel16 -> Pixel Y Double)--instance Convertible PNM.PpmPixelRGB8 (Pixel RGB Double) where-  convert (PNM.PpmPixelRGB8 r g b) = fmap toDouble $ PixelRGB r g b--instance Convertible PNM.PpmPixelRGB16 (Pixel RGB Double) where-  convert (PNM.PpmPixelRGB16 r g b) = fmap toDouble $ PixelRGB r g b----- -> RGBA (Double)--instance Convertible PNM.PbmPixel (Pixel RGBA Double) where-  convert = addAlpha 1 . (convert :: PNM.PbmPixel -> Pixel RGB Double)-  -instance Convertible PNM.PgmPixel8 (Pixel RGBA Double) where-  convert = addAlpha 1 . (convert :: PNM.PgmPixel8 -> Pixel RGB Double)--instance Convertible PNM.PgmPixel16 (Pixel RGBA Double) where-  convert = addAlpha 1 . (convert :: PNM.PgmPixel16 -> Pixel RGB Double)--instance Convertible PNM.PpmPixelRGB8 (Pixel RGBA Double) where-  convert = addAlpha 1 . (convert :: PNM.PpmPixelRGB8 -> Pixel RGB Double)--instance Convertible PNM.PpmPixelRGB16 (Pixel RGBA Double) where-  convert = addAlpha 1 . (convert :: PNM.PpmPixelRGB16 -> Pixel RGB Double)-- ---- Exact precision conversions  @@ -169,27 +99,27 @@ --------------------------------------------------------------------------------  --- BMP Format Reading (general)+-- BPM Format Reading (general) -instance Array arr Y Double => Readable (Image arr Y Double) PBM where-  decode _ = fmap (ppmToImageUsing (pnmDataToImage id) . head) . decodePnm+instance Readable (Image VS Y Double) PBM where+  decode _ = fmap (ppmToImageUsing pnmDataToImage . head) . decodePnm -instance Array arr Y Double => Readable (Image arr Y Double) PGM where-  decode _ = fmap (ppmToImageUsing (pnmDataToImage id) . head) . decodePnm+instance Readable (Image VS Y Double) PGM where+  decode _ = fmap (ppmToImageUsing pnmDataToImage . head) . decodePnm -instance Array arr Y Double => Readable (Image arr Y Double) PPM where-  decode _ = fmap (ppmToImageUsing (pnmDataToImage id) . head) . decodePnm+instance Readable (Image VS Y Double) PPM where+  decode _ = fmap (ppmToImageUsing pnmDataToImage . head) . decodePnm -instance Array arr YA Double => Readable (Image arr YA Double) PPM where-  decode _ = fmap (ppmToImageUsing (pnmDataToImage (addAlpha 1)) . head) . decodePnm+instance Readable (Image VS YA Double) PPM where+  decode _ = fmap (ppmToImageUsing pnmDataToImage . head) . decodePnm -instance Array arr RGB Double => Readable (Image arr RGB Double) PPM where-  decode _ = fmap (ppmToImageUsing (pnmDataToImage id) . head) . decodePnm+instance Readable (Image VS RGB Double) PPM where+  decode _ = fmap (ppmToImageUsing pnmDataToImage . head) . decodePnm -instance Array arr RGBA Double => Readable (Image arr RGBA Double) PPM where-  decode _ = fmap (ppmToImageUsing (pnmDataToImage (addAlpha 1)) . head) . decodePnm+instance Readable (Image VS RGBA Double) PPM where+  decode _ = fmap (ppmToImageUsing pnmDataToImage . head) . decodePnm --- BMP Format Reading (exact)+-- BPM Format Reading (exact)  instance Readable (Image VS Binary Bit) PBM where   decode _ = either Left (ppmToImageUsing pnmDataPBMToImage . head) . decodePnm@@ -226,22 +156,26 @@ pnmToImagesUsing :: (Int -> Int -> PNM.PpmPixelData -> Either String b)                  -> B.ByteString -> Either String [b] pnmToImagesUsing conv =-  fmap (map (either error id . ppmToImageUsing conv)) . decodePnm---getPx :: (Storable a, Convertible a b) => V.Vector a -> Int -> (Int, Int) -> b-getPx v w (i, j) = convert (v V.! (i * w + j))+  fmap (fmap (either error id . ppmToImageUsing conv)) . decodePnm  -pnmDataToImage :: (Array arr cs e, Convertible PNM.PbmPixel px,-                   Convertible PNM.PgmPixel16 px, Convertible PNM.PgmPixel8 px,-                   Convertible PNM.PpmPixelRGB16 px, Convertible PNM.PpmPixelRGB8 px) =>-                  (px -> Pixel cs e) -> Int -> Int -> PNM.PpmPixelData -> Image arr cs e-pnmDataToImage conv w h (PNM.PbmPixelData v)      = makeImage (h, w) (conv . getPx v w)-pnmDataToImage conv w h (PNM.PgmPixelData8 v)     = makeImage (h, w) (conv . getPx v w)-pnmDataToImage conv w h (PNM.PgmPixelData16 v)    = makeImage (h, w) (conv . getPx v w)-pnmDataToImage conv w h (PNM.PpmPixelDataRGB8 v)  = makeImage (h, w) (conv . getPx v w)-pnmDataToImage conv w h (PNM.PpmPixelDataRGB16 v) = makeImage (h, w) (conv . getPx v w)+pnmDataToImage :: (Convertible (Pixel Binary Bit) (Pixel cs e),+                   Convertible (Pixel Y Word8) (Pixel cs e),+                   Convertible (Pixel Y Word16) (Pixel cs e),+                   Convertible (Pixel RGB Word8) (Pixel cs e),+                   Convertible (Pixel RGB Word16) (Pixel cs e),+                   Array VS cs e) =>+                  Int -> Int -> PNM.PpmPixelData -> Image VS cs e+pnmDataToImage w h (PNM.PbmPixelData v)      =+  I.map convert (makeImageUnsafe (h, w) v :: Image VS Binary Bit)+pnmDataToImage w h (PNM.PgmPixelData8 v)     =+  I.map convert (makeImageUnsafe (h, w) v :: Image VS Y Word8)+pnmDataToImage w h (PNM.PgmPixelData16 v)    =+  I.map convert (makeImageUnsafe (h, w) v :: Image VS Y Word16)+pnmDataToImage w h (PNM.PpmPixelDataRGB8 v)  =+  I.map convert (makeImageUnsafe (h, w) v :: Image VS RGB Word8)+pnmDataToImage w h (PNM.PpmPixelDataRGB16 v) =+  I.map convert (makeImageUnsafe (h, w) v :: Image VS RGB Word16)   makeImageUnsafe

@@ -42,16 +42,16 @@ import GHC.Exts (Constraint) import Data.Typeable (Typeable, showsTypeRep, typeOf) import Control.DeepSeq (NFData(rnf), deepseq)-import Data.Word import qualified Data.Vector.Generic as VG import qualified Data.Vector.Unboxed as VU +import Graphics.Image.Interface.Elevator  -- | A Pixel family with a color space and a precision of elements. data family Pixel cs e :: *  -class (Eq cs, Enum cs, Show cs, Bounded cs, Typeable cs, Elevator e, Typeable e,+class (Eq cs, Enum cs, Show cs, Bounded cs, Typeable cs, Elevator e,       Eq (Pixel cs e), VU.Unbox (Components cs e))       => ColorSpace cs e where   @@ -115,7 +115,7 @@   -- | Get an alpha channel of a transparant pixel.    getAlpha :: Pixel cs e -> e -  -- | Add an alpha channel of an opaque pixel.+  -- | Add an alpha channel to an opaque pixel.   --   -- @ addAlpha 0 (PixelHSI 1 2 3) == PixelHSIA 1 2 3 0 @   addAlpha :: e -> Pixel (Opaque cs) e -> Pixel cs e@@ -128,39 +128,8 @@   dropAlpha :: Pixel cs e -> Pixel (Opaque cs) e  --- | A class with a set of convenient functions that allow for changing precision of--- channels within pixels, while scaling the values to keep them in an appropriate range.------ >>> let rgb = PixelRGB 0.0 0.5 1.0 :: Pixel RGB Double--- >>> toWord8 rgb--- <RGB:(0|128|255)>----class (Eq e, Num e, VU.Unbox e) => Elevator e where--  -- | Values are scaled to @[0, 255]@ range.-  toWord8 :: e -> Word8--  -- | Values are scaled to @[0, 65535]@ range.-  toWord16 :: e -> Word16--  -- | Values are scaled to @[0, 4294967295]@ range.-  toWord32 :: e -> Word32--  -- | Values are scaled to @[0, 18446744073709551615]@ range.-  toWord64 :: e -> Word64--  -- | Values are scaled to @[0.0, 1.0]@ range.-  toFloat :: e -> Float--  -- | Values are scaled to @[0.0, 1.0]@ range.-  toDouble :: e -> Double--  -- | Values are scaled from @[0.0, 1.0]@ range.-  fromDouble :: Double -> e-- -- | Base array like representation for an image.-class (Show arr, ColorSpace cs e, SuperClass arr cs e) =>+class (Typeable arr, ColorSpace cs e, SuperClass arr cs e) =>       BaseArray arr cs e where    -- | Required array specific constraints for an array element.@@ -337,7 +306,7 @@         -- | Array representation that is actually has real data stored in memory, hence -- allowing for image indexing, forcing pixels into computed state etc.-class (BaseArray arr cs e) => MArray arr cs e  where+class BaseArray arr cs e => MArray arr cs e  where   data MImage s arr cs e      unsafeIndex :: Image arr cs e -> (Int, Int) -> Pixel cs e@@ -705,8 +674,7 @@          Show (Image arr cs e) where   show (dims -> (m, n)) =     "<Image " ++-    show (undefined :: arr) ++-    " " +++    showsTypeRep (typeOf (undefined :: arr)) " " ++     showsTypeRep (typeOf (undefined :: cs)) " (" ++     showsTypeRep (typeOf (undefined :: e)) "): " ++      show m ++ "x" ++ show n ++ ">"@@ -716,8 +684,7 @@          Show (MImage st arr cs e) where   show (mdims -> (m, n)) =     "<MutableImage " ++-    show (undefined :: arr) ++-    " " +++    showsTypeRep (typeOf (undefined :: arr)) " " ++     showsTypeRep (typeOf (undefined :: cs)) " (" ++     showsTypeRep (typeOf (undefined :: e)) "): " ++      show m ++ "x" ++ show n ++ ">"

@@ -0,0 +1,317 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+#if __GLASGOW_HASKELL__ >= 800+  {-# OPTIONS_GHC -Wno-redundant-constraints #-}+#endif+-- |+-- Module      : Graphics.Image.Interface.Elevator+-- Copyright   : (c) Alexey Kuleshevich 2017+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+--+module Graphics.Image.Interface.Elevator (+  Elevator(..)+  ) where++import qualified Data.Complex as C+import Data.Int+import Data.Word+import GHC.Float+import Data.Typeable+import Data.Vector.Unboxed (Unbox)+++-- | A class with a set of convenient functions that allow for changing precision of+-- channels within pixels, while scaling the values to keep them in an appropriate range.+--+-- >>> let rgb = PixelRGB 0.0 0.5 1.0 :: Pixel RGB Double+-- >>> toWord8 <$> rgb+-- <RGB:(0|128|255)>+-- >>> toWord16 <$> rgb+-- <RGB:(0|32768|65535)>+--+class (Eq e, Num e, Typeable e, Unbox e) => Elevator e where++  -- | Values are scaled to @[0, 255]@ range.+  toWord8 :: e -> Word8++  -- | Values are scaled to @[0, 65535]@ range.+  toWord16 :: e -> Word16++  -- | Values are scaled to @[0, 4294967295]@ range.+  toWord32 :: e -> Word32++  -- | Values are scaled to @[0, 18446744073709551615]@ range.+  toWord64 :: e -> Word64++  -- | Values are scaled to @[0.0, 1.0]@ range.+  toFloat :: e -> Float++  -- | Values are scaled to @[0.0, 1.0]@ range.+  toDouble :: e -> Double++  -- | Values are scaled from @[0.0, 1.0]@ range.+  fromDouble :: Double -> e+++-- | Lower the precision+dropDown :: forall a b. (Integral a, Bounded a, Integral b, Bounded b) => a -> b+dropDown !e = fromIntegral $ fromIntegral e `div` ((maxBound :: a) `div`+                                                   fromIntegral (maxBound :: b)) +{-# INLINE dropDown #-}++-- | Increase the precision+raiseUp :: forall a b. (Integral a, Bounded a, Integral b, Bounded b) => a -> b+raiseUp !e = fromIntegral e * ((maxBound :: b) `div` fromIntegral (maxBound :: a))+{-# INLINE raiseUp #-}++-- | Convert to fractional with value less than or equal to 1.+squashTo1 :: forall a b. (Fractional b, Integral a, Bounded a) => a -> b+squashTo1 !e = fromIntegral e / fromIntegral (maxBound :: a)+{-# INLINE squashTo1 #-}++-- | Convert to integral streaching it's value up to a maximum value.+stretch :: forall a b. (RealFrac a, Floating a, Integral b, Bounded b) => a -> b+stretch !e = round (fromIntegral (maxBound :: b) * clamp01 e)+++-- | Clamp a value to @[0, 1]@ range.+clamp01 :: (Ord a, Floating a) => a -> a+clamp01 !x = min (max 0 x) 1+{-# INLINE clamp01 #-}+++-- | Values between @[0, 255]]@+instance Elevator Word8 where+  toWord8 = id+  {-# INLINE toWord8 #-}+  toWord16 = raiseUp+  {-# INLINE toWord16 #-}+  toWord32 = raiseUp+  {-# INLINE toWord32 #-}+  toWord64 = raiseUp+  {-# INLINE toWord64 #-}+  toFloat = squashTo1+  {-# INLINE toFloat #-}+  toDouble = squashTo1+  {-# INLINE toDouble #-}+  fromDouble = toWord8+  {-# INLINE fromDouble #-}+++-- | Values between @[0, 65535]]@+instance Elevator Word16 where+  toWord8 = dropDown+  {-# INLINE toWord8 #-}+  toWord16 = id+  {-# INLINE toWord16 #-}+  toWord32 = raiseUp+  {-# INLINE toWord32 #-}+  toWord64 = raiseUp+  {-# INLINE toWord64 #-}+  toFloat = squashTo1+  {-# INLINE toFloat #-}+  toDouble = squashTo1+  {-# INLINE toDouble #-}+  fromDouble = toWord16+  {-# INLINE fromDouble #-}+++-- | Values between @[0, 4294967295]@+instance Elevator Word32 where+  toWord8 = dropDown+  {-# INLINE toWord8 #-}+  toWord16 = dropDown+  {-# INLINE toWord16 #-}+  toWord32 = id+  {-# INLINE toWord32 #-}+  toWord64 = raiseUp+  {-# INLINE toWord64 #-}+  toFloat = squashTo1+  {-# INLINE toFloat #-}+  toDouble = squashTo1+  {-# INLINE toDouble #-}+  fromDouble = toWord32+  {-# INLINE fromDouble #-}+++-- | Values between @[0, 18446744073709551615]@+instance Elevator Word64 where+  toWord8 = dropDown+  {-# INLINE toWord8 #-}+  toWord16 = dropDown+  {-# INLINE toWord16 #-}+  toWord32 = dropDown+  {-# INLINE toWord32 #-}+  toWord64 = id+  {-# INLINE toWord64 #-}+  toFloat = squashTo1+  {-# INLINE toFloat #-}+  toDouble = squashTo1+  {-# INLINE toDouble #-}+  fromDouble = toWord64+  {-# INLINE fromDouble #-}++-- | Values between @[0, 18446744073709551615]@ on 64bit+instance Elevator Word where+  toWord8 = dropDown+  {-# INLINE toWord8 #-}+  toWord16 = dropDown+  {-# INLINE toWord16 #-}+  toWord32 = dropDown+  {-# INLINE toWord32 #-}+  toWord64 = fromIntegral+  {-# INLINE toWord64 #-}+  toFloat = squashTo1+  {-# INLINE toFloat #-}+  toDouble = squashTo1+  {-# INLINE toDouble #-}+  fromDouble = stretch . clamp01+  {-# INLINE fromDouble #-}++-- | Values between @[0, 127]@+instance Elevator Int8 where+  toWord8 = fromIntegral . (max 0)+  {-# INLINE toWord8 #-}+  toWord16 = raiseUp . (max 0)+  {-# INLINE toWord16 #-}+  toWord32 = raiseUp . (max 0)+  {-# INLINE toWord32 #-}+  toWord64 = raiseUp . (max 0)+  {-# INLINE toWord64 #-}+  toFloat = squashTo1 . (max 0)+  {-# INLINE toFloat #-}+  toDouble = squashTo1 . (max 0)+  {-# INLINE toDouble #-}+  fromDouble = stretch . clamp01+  {-# INLINE fromDouble #-}+++-- | Values between @[0, 32767]@+instance Elevator Int16 where+  toWord8 = dropDown . (max 0)+  {-# INLINE toWord8 #-}+  toWord16 = fromIntegral . (max 0)+  {-# INLINE toWord16 #-}+  toWord32 = raiseUp . (max 0)+  {-# INLINE toWord32 #-}+  toWord64 = raiseUp . (max 0)+  {-# INLINE toWord64 #-}+  toFloat = squashTo1 . (max 0)+  {-# INLINE toFloat #-}+  toDouble = squashTo1 . (max 0)+  {-# INLINE toDouble #-}+  fromDouble = stretch . clamp01+  {-# INLINE fromDouble #-}+++-- | Values between @[0, 2147483647]@+instance Elevator Int32 where+  toWord8 = dropDown . (max 0)+  {-# INLINE toWord8 #-}+  toWord16 = dropDown . (max 0)+  {-# INLINE toWord16 #-}+  toWord32 = fromIntegral . (max 0)+  {-# INLINE toWord32 #-}+  toWord64 = raiseUp . (max 0)+  {-# INLINE toWord64 #-}+  toFloat = squashTo1 . (max 0)+  {-# INLINE toFloat #-}+  toDouble = squashTo1 . (max 0)+  {-# INLINE toDouble #-}+  fromDouble = stretch . clamp01+  {-# INLINE fromDouble #-}+++-- | Values between @[0, 9223372036854775807]@+instance Elevator Int64 where+  toWord8 = dropDown . (max 0)+  {-# INLINE toWord8 #-}+  toWord16 = dropDown . (max 0)+  {-# INLINE toWord16 #-}+  toWord32 = dropDown . (max 0)+  {-# INLINE toWord32 #-}+  toWord64 = fromIntegral . (max 0)+  {-# INLINE toWord64 #-}+  toFloat = squashTo1 . (max 0)+  {-# INLINE toFloat #-}+  toDouble = squashTo1 . (max 0)+  {-# INLINE toDouble #-}+  fromDouble = stretch . clamp01+  {-# INLINE fromDouble #-}+++-- | Values between @[0, 9223372036854775807]@ on 64bit+instance Elevator Int where+  toWord8 = dropDown . (max 0)+  {-# INLINE toWord8 #-}+  toWord16 = dropDown . (max 0)+  {-# INLINE toWord16 #-}+  toWord32 = dropDown . (max 0)+  {-# INLINE toWord32 #-}+  toWord64 = fromIntegral . (max 0)+  {-# INLINE toWord64 #-}+  toFloat = squashTo1 . (max 0)+  {-# INLINE toFloat #-}+  toDouble = squashTo1 . (max 0)+  {-# INLINE toDouble #-}+  fromDouble = stretch . clamp01+  {-# INLINE fromDouble #-}+++-- | Values between @[0.0, 1.0]@+instance Elevator Float where+  toWord8 = stretch . clamp01+  {-# INLINE toWord8 #-}+  toWord16 = stretch . clamp01+  {-# INLINE toWord16 #-}+  toWord32 = stretch . clamp01+  {-# INLINE toWord32 #-}+  toWord64 = stretch . clamp01+  {-# INLINE toWord64 #-}+  toFloat = id+  {-# INLINE toFloat #-}+  toDouble = float2Double+  {-# INLINE toDouble #-}+  fromDouble = toFloat+  {-# INLINE fromDouble #-}+++-- | Values between @[0.0, 1.0]@+instance Elevator Double where+  toWord8 = stretch . clamp01+  {-# INLINE toWord8 #-}+  toWord16 = stretch . clamp01+  {-# INLINE toWord16 #-}+  toWord32 = stretch . clamp01+  {-# INLINE toWord32 #-}+  toWord64 = stretch . clamp01+  {-# INLINE toWord64 #-}+  toFloat = double2Float+  {-# INLINE toFloat #-}+  toDouble = id+  {-# INLINE toDouble #-}+  fromDouble = id+  {-# INLINE fromDouble #-}+++-- | Discards imaginary part and changes precision of real part.+instance (Num e, Elevator e, RealFloat e) => Elevator (C.Complex e) where+  toWord8 = toWord8 . C.realPart+  {-# INLINE toWord8 #-}+  toWord16 = toWord16 . C.realPart+  {-# INLINE toWord16 #-}+  toWord32 = toWord32 . C.realPart+  {-# INLINE toWord32 #-}+  toWord64 = toWord64 . C.realPart+  {-# INLINE toWord64 #-}+  toFloat = toFloat . C.realPart+  {-# INLINE toFloat #-}+  toDouble = toDouble . C.realPart+  {-# INLINE toDouble #-}+  fromDouble = (C.:+ 0) . fromDouble+  {-# INLINE fromDouble #-}

@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -27,6 +28,7 @@ import qualified Data.Array.Repa as R import qualified Data.Array.Repa.Eval as R import qualified Data.Vector.Generic as VG+import Data.Typeable (Typeable)  import Graphics.Image.ColorSpace.Binary (Bit(..)) import Graphics.Image.Interface as I@@ -38,10 +40,10 @@   -- | Repa Array representation, which is computed in parallel.-data RP r = RP r+data RP r = RP r deriving Typeable  -- | Repa Array representation, which is computed sequentially. -data RS r = RS r+data RS r = RS r deriving Typeable  instance Show r => Show (RP r) where   show (RP r) = "RepaParallel " ++ show r@@ -56,7 +58,7 @@  instance SuperClass (RS r) cs e => BaseArray (RS r) cs e where   type SuperClass (RS r) cs e =-    (Show r, ColorSpace cs e, R.Elt (Pixel cs e), R.Elt e, +    (Typeable r, ColorSpace cs e, R.Elt (Pixel cs e), R.Elt e,       R.Target (Repr r) (Pixel cs e), R.Source (Repr r) (Pixel cs e),      BaseArray r cs e)   @@ -184,7 +186,7 @@  instance SuperClass (RP r) cs e => BaseArray (RP r) cs e where   type SuperClass (RP r) cs e = (-    Show r, ColorSpace cs e,+    Typeable r, ColorSpace cs e,     R.Target (Repr r) (Pixel cs e), R.Source (Repr r) (Pixel cs e),     BaseArray r cs e,     R.Elt e, R.Elt (Pixel cs e))

@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -26,6 +27,7 @@ import qualified Data.Array.Repa.Repr.ForeignPtr as R import qualified Data.Vector.Storable as VS import Foreign.Storable+import Data.Typeable (Typeable)  import Graphics.Image.Interface as I import Graphics.Image.Interface.Repa.Generic@@ -35,16 +37,16 @@   -- | Repa Array representation backed by Storable Vector, which is computed sequentially. -data RSS = RSS+data RSS = RSS deriving Typeable  -- | Repa Array representation backed by Storable Vector, which is computed in parallel.-data RPS = RPS+data RPS = RPS deriving Typeable  instance Show RSS where-  show RSS = "RepaSequentialStorable"+  show _ = "RepaSequentialStorable"  instance Show RPS where-  show RPS = "RepaParallelStorable"+  show _ = "RepaParallelStorable"     type instance Repr IVS.VS = R.F

@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -22,6 +23,7 @@ import Prelude as P import qualified Data.Array.Repa as R  import qualified Data.Array.Repa.Eval as R+import Data.Typeable (Typeable)  import Graphics.Image.Interface as I import Graphics.Image.Interface.Repa.Generic@@ -29,16 +31,16 @@   -- | Repa Array representation backed by Unboxed Vector, which is computed sequentially. -data RSU = RSU+data RSU = RSU deriving Typeable  -- | Repa Array representation backed by Unboxed Vector, which is computed in parallel.-data RPU = RPU+data RPU = RPU deriving Typeable  instance Show RSU where-  show RSU = "RepaSequentialUnboxed"+  show _ = "RepaSequentialUnboxed"  instance Show RPU where-  show RPU = "RepaParallelUnboxed"+  show _ = "RepaParallelUnboxed"     type instance Repr IVU.VU = R.U

@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -30,13 +31,14 @@ import Data.Functor #endif import Data.Primitive.MutVar+import Data.Typeable (Typeable) import qualified Data.Vector.Unboxed as VU import qualified Data.Vector.Generic as VG import qualified Data.Vector.Generic.Mutable as MVG import Graphics.Image.Interface as I  -- | Generic 'Vector' representation.-data G r = G r+data G r = G r deriving Typeable   instance Show r => Show (G r) where@@ -44,7 +46,7 @@  instance SuperClass (G r) cs e => BaseArray (G r) cs e where   type SuperClass (G r) cs e =-    (Show r, ColorSpace cs e,+    (Typeable r, ColorSpace cs e,      VG.Vector (Vector r) Int, VG.Vector (Vector r) Bool,      VG.Vector (Vector r) (Pixel cs e), NFData ((Vector r) (Pixel cs e))) @@ -216,7 +218,7 @@   unsafeIndex (VScalar px)     _ = px   {-# INLINE unsafeIndex #-} -  deepSeqImage (VImage m n v) = m `seq` n `seq` deepseq v+  deepSeqImage (VImage _ _ v) = deepseq v   deepSeqImage (VScalar px)   = seq px   {-# INLINE deepSeqImage #-} 

@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -25,6 +26,7 @@ #if !MIN_VERSION_base(4,8,0) import Data.Functor #endif+import Data.Typeable (Typeable) import qualified Data.Vector.Storable as VS import Graphics.Image.Interface as I import Graphics.Image.Interface.Vector.Generic@@ -32,7 +34,7 @@   -- | Storable 'Vector' representation.-data VS = VS+data VS = VS deriving Typeable  instance Show VS where   show _ = "VectorStorable"

@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -25,6 +26,7 @@ #if !MIN_VERSION_base(4,8,0) import Data.Functor #endif+import Data.Typeable (Typeable) import qualified Data.Vector.Unboxed as VU import Graphics.Image.Interface as I import Graphics.Image.Interface.Vector.Generic@@ -33,7 +35,7 @@   -- | Unboxed 'Vector' representation.-data VU = VU+data VU = VU deriving Typeable  instance Show VU where   show _ = "VectorUnboxed"

@@ -21,9 +21,9 @@   --- | Correlate an image using a kernel. Border resolution technique is required.-correlate :: I.Array arr cs e =>-                  Border (Pixel cs e) -> Image arr cs e -> Image arr cs e -> Image arr cs e+-- | Correlate an image with a kernel. Border resolution technique is required.+correlate :: Array arr cs e =>+             Border (Pixel cs e) -> Image arr cs e -> Image arr cs e -> Image arr cs e correlate !border !kernel !img =   I.traverse (compute img) (const sz) stencil   where

@@ -26,19 +26,7 @@   arbitrary = fromComponents <$> arbitrary  -instance (MArray VU cs e, Arbitrary (Pixel cs e)) => Arbitrary (Image VU cs e) where-  arbitrary = do-    (Positive m, Positive n) <- arbitrary-    II.makeImageM (m, n) (const arbitrary)---instance (MArray VS cs e, Arbitrary (Pixel cs e)) => Arbitrary (Image VS cs e) where-  arbitrary = do-    (Positive m, Positive n) <- arbitrary-    II.makeImageM (m, n) (const arbitrary)---prop_ToFromComponents :: (ColorSpace cs e, Eq (Pixel cs e)) =>+prop_ToFromComponents :: ColorSpace cs e =>                          Pixel cs e -> Bool prop_ToFromComponents px = px == fromComponents (toComponents px) 

@@ -11,6 +11,7 @@ import Test.QuickCheck.Property  import Graphics.Image as I+import Graphics.Image.Interface as I  import Graphics.Image.InterfaceSpec()