massiv-io 0.1.6.0 → 0.1.7.0

raw patch · 14 files changed

+181/−144 lines, 14 filesdep +data-default-classdep −data-defaultPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: data-default-class

Dependencies removed: data-default

API changes (from Hackage documentation)

Files

• CHANGELOG.md +38/−0
• massiv-io.cabal +3/−2
• src/Data/Massiv/Array/IO.hs +7/−5
• src/Data/Massiv/Array/IO/Base.hs +1/−1
• src/Data/Massiv/Array/IO/Image/JuicyPixels.hs +36/−10
• src/Graphics/ColorSpace.hs +5/−4
• src/Graphics/ColorSpace/Binary.hs +0/−31
• src/Graphics/ColorSpace/CMYK.hs +10/−2
• src/Graphics/ColorSpace/HSI.hs +17/−9
• src/Graphics/ColorSpace/Internal.hs +8/−8
• src/Graphics/ColorSpace/RGB.hs +17/−2
• src/Graphics/ColorSpace/X.hs +12/−64
• src/Graphics/ColorSpace/Y.hs +15/−4
• src/Graphics/ColorSpace/YCbCr.hs +12/−2

@@ -0,0 +1,38 @@+# 0.1.7++* Fix compatibility with `JuicyPixels >= 3.3.0`+* Add `Traversable` instances for all `Pixel` types.+* Derive a few more instances for `X` and `Y` pixels.+* Drop dependency on `data-default` in favor of `data-default-class`++# 0.1.6++* Made it compatible with new `massiv >= 0.3` as well as the old ones.++# 0.1.5++* All decoded images will be read in sequentially, but will have default computation set to `Par`.++# 0.1.4++* Fixed wrongful export of `Bit` constructor.+* Added export of `fromDynamicImage` and `fromAnyDynamicImage`++# 0.1.3++* Fixed #22 - Invalid guard against image size+* Made sure format is inferred from all supported file extensions for auto decoding.++# 0.1.2++* Exposed `Elevator` internal functions.+* Deprecate ColorSpace specific functions (`liftPx`, `foldlPx`, etc.) in favor of Functor,+  Applicative and Foldable.++# 0.1.1++* Addition of `Ord` instances to Pixels.++# 0.1.0++* Initial Release

@@ -1,5 +1,5 @@ name:                massiv-io-version:             0.1.6.0+version:             0.1.7.0 synopsis:            Import/export of Image files into massiv Arrays description:         This package contains functionality for import/export of arrays                      into the real world. For now it only has the ability to read/write@@ -13,6 +13,7 @@ category:            Data, Data Structures build-type:          Simple extra-source-files:  README.md+                   , CHANGELOG.md cabal-version:       >=1.10  library@@ -35,7 +36,7 @@                      , Data.Massiv.Array.IO.Image.Netpbm   build-depends:       base            >= 4.8 && < 5                      , bytestring-                     , data-default+                     , data-default-class                      , deepseq                      , directory                      , filepath        >= 1.0

@@ -164,17 +164,19 @@  -- | 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 (Auto TIF) (Image r cs e) =>-                     ExternalViewer -- ^ Image viewer program-                  -> Bool -- ^ Should a call block the cuurrent thread untul viewer is closed.-                  -> Image r cs e -> IO ()+displayImageUsing ::+     Writable (Auto TIF) (Image r cs e)+  => ExternalViewer -- ^ Image viewer program+  -> Bool -- ^ Should the function block the current thread until viewer is closed.+  -> Image r cs e+  -> IO () displayImageUsing viewer block img =   if block     then display     else img `seq` void (forkIO display)   where     display = do-      tmpDir <- fmap (</> "hip") getTemporaryDirectory+      tmpDir <- fmap (</> "massiv-io") getTemporaryDirectory       createDirectoryIfMissing True tmpDir       bracket         (openBinaryTempFile tmpDir "tmp-img.tiff")

@@ -34,7 +34,7 @@ import Control.Exception (Exception, throw) import qualified Data.ByteString as B (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString)-import Data.Default (Default(..))+import Data.Default.Class (Default(..)) import Data.Massiv.Array import Data.Maybe (fromMaybe) import Data.Typeable

@@ -65,7 +65,7 @@   , toJPImageRGBF   , toJPImageYCbCr8   , toJPImageCMYK8-  -- , toJPImageCMYK16+  , toJPImageCMYK16   -- ** From JuicyPixels   , fromDynamicImage   , fromAnyDynamicImage@@ -77,12 +77,13 @@ import qualified Codec.Picture.ColorQuant as JP import qualified Codec.Picture.Gif as JP import qualified Codec.Picture.Jpg as JP+import qualified Codec.Picture.Types as TypesJP import Control.Exception import Control.Monad (guard, msum) import Data.Bifunctor import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL (ByteString)-import Data.Default (Default(..))+import Data.Default.Class (Default(..)) import Data.Massiv.Array as M import Data.Massiv.Array.IO.Base import Data.Massiv.Array.Manifest.Vector@@ -665,6 +666,12 @@                 return $ JP.encodeTiff $ toJPImageY8 img            , do Refl <- eqT :: Maybe (e :~: Word16)                 return $ JP.encodeTiff $ toJPImageY16 img+#if MIN_VERSION_JuicyPixels(3,3,0)+           , do Refl <- eqT :: Maybe (e :~: Word32)+                return $ JP.encodeTiff $ toJPImageY32 img+           , do Refl <- eqT :: Maybe (e :~: Float)+                return $ JP.encodeTiff $ toJPImageYF img+#endif            , return $ JP.encodeTiff $ toJPImageY16 $ M.map toWord16 img            ]     , do Refl <- eqT :: Maybe (cs :~: YA)@@ -701,8 +708,10 @@          msum            [ do Refl <- eqT :: Maybe (e :~: Word8)                 return $ JP.encodeTiff $ toJPImageCMYK8 img-           -- , do Refl <- eqT :: Maybe (e :~: Word16)-           --      return $ JP.encodeTiff $ toJPImageCMYK16 img+           , do Refl <- eqT :: Maybe (e :~: Word16)+                return $ JP.encodeTiff $ toJPImageCMYK16 img+             -- for CMYK default is 8bit, instead of 16bit, since many viewers and editors+             -- don't support it.            , return $ JP.encodeTiff $ toJPImageCMYK8 $ M.map toWord8 img            ]     ]@@ -796,6 +805,11 @@     JP.ImageY16 jimg -> do       Refl <- eqT :: Maybe (Pixel cs e :~: Pixel Y Word16)       fromJPImageUnsafe jimg+#if MIN_VERSION_JuicyPixels(3,3,0)+    JP.ImageY32 jimg -> do+      Refl <- eqT :: Maybe (Pixel cs e :~: Pixel Y Word32)+      fromJPImageUnsafe jimg+#endif     JP.ImageYF jimg -> do       Refl <- eqT :: Maybe (Pixel cs e :~: Pixel Y Float)       fromJPImageUnsafe jimg@@ -838,6 +852,9 @@   case jpDynImg of     JP.ImageY8 jimg     -> (fromJPImageUnsafe jimg :: Maybe (Image S Y Word8))     >>= toAnyCS     JP.ImageY16 jimg    -> (fromJPImageUnsafe jimg :: Maybe (Image S Y Word16))    >>= toAnyCS+#if MIN_VERSION_JuicyPixels(3,3,0)+    JP.ImageY32 jimg    -> (fromJPImageUnsafe jimg :: Maybe (Image S Y Word32))    >>= toAnyCS+#endif     JP.ImageYF jimg     -> (fromJPImageUnsafe jimg :: Maybe (Image S Y Float))     >>= toAnyCS     JP.ImageYA8 jimg    -> (fromJPImageUnsafe jimg :: Maybe (Image S YA Word8))    >>= toAnyCS     JP.ImageYA16 jimg   -> (fromJPImageUnsafe jimg :: Maybe (Image S YA Word16))   >>= toAnyCS@@ -896,6 +913,9 @@ showJP :: JP.DynamicImage -> String showJP (JP.ImageY8     _) = "Image S Y Word8" showJP (JP.ImageY16    _) = "Image S Y Word16"+#if MIN_VERSION_JuicyPixels(3,3,0)+showJP (JP.ImageY32    _) = "Image S Y Word32"+#endif showJP (JP.ImageYF     _) = "Image S Y Float" showJP (JP.ImageYA8    _) = "Image S YA Word8" showJP (JP.ImageYA16   _) = "Image S YA Word16"@@ -921,14 +941,20 @@   Sz (m :. n) = size img {-# INLINE toJPImageUnsafe #-} -toJPImageY8 :: Source r Ix2 (Pixel Y Word8) => Image r Y Word8 -> JP.Image JP.Pixel8+toJPImageY8 :: Source r Ix2 (Pixel Y Word8) => Image r Y Word8 -> JP.Image TypesJP.Pixel8 toJPImageY8 = toJPImageUnsafe {-# INLINE toJPImageY8 #-} -toJPImageY16 :: Source r Ix2 (Pixel Y Word16) => Image r Y Word16 -> JP.Image JP.Pixel16+toJPImageY16 :: Source r Ix2 (Pixel Y Word16) => Image r Y Word16 -> JP.Image TypesJP.Pixel16 toJPImageY16 = toJPImageUnsafe {-# INLINE toJPImageY16 #-} +#if MIN_VERSION_JuicyPixels(3,3,0)+toJPImageY32 :: Source r Ix2 (Pixel Y Word32) => Image r Y Word32 -> JP.Image TypesJP.Pixel32+toJPImageY32 = toJPImageUnsafe+{-# INLINE toJPImageY32 #-}+#endif+ toJPImageYA8 :: Source r Ix2 (Pixel YA Word8) => Image r YA Word8 -> JP.Image JP.PixelYA8 toJPImageYA8 = toJPImageUnsafe {-# INLINE toJPImageYA8 #-}@@ -969,10 +995,9 @@ toJPImageCMYK8 = toJPImageUnsafe {-# INLINE toJPImageCMYK8 #-} --- FIXME: debug writing to file of TIF files.--- toJPImageCMYK16 :: Source r Ix2 (Pixel CMYK Word16) => Image r CMYK Word16 -> JP.Image JP.PixelCMYK16--- toJPImageCMYK16 = toJPImageUnsafe--- {-# INLINE toJPImageCMYK16 #-}+toJPImageCMYK16 :: Source r Ix2 (Pixel CMYK Word16) => Image r CMYK Word16 -> JP.Image JP.PixelCMYK16+toJPImageCMYK16 = toJPImageUnsafe+{-# INLINE toJPImageCMYK16 #-}   @@ -985,3 +1010,4 @@   guard (n * m * sizeOf (undefined :: Pixel cs e) == V.length v)   fromVectorM Par (Sz (m :. n)) $ V.unsafeCast v {-# INLINE fromJPImageUnsafe #-}+

@@ -506,10 +506,11 @@  instance Elevator e => ToCMYK RGB e where   toPixelCMYK (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)+    !c = (k' - r) / k'+    !m = (k' - g) / k'+    !y = (k' - b) / k'+    !k = 1 - k'+    !k' = max r (max g b)   {-# INLINE toPixelCMYK #-}  instance Elevator e => ToCMYK RGBA e where

@@ -18,7 +18,6 @@   Bit, on, off, isOn, isOff, fromBool, zero, one, bit2bool, bool2bit, toNum, fromNum   ) where -import Control.Applicative import Control.Monad import Data.Bits import Data.Typeable (Typeable)@@ -84,36 +83,6 @@   popCount _       = 1   {-# INLINE popCount #-} --instance Bits (Pixel X Bit) where-  (.&.) = liftA2 (.&.)-  {-# INLINE (.&.) #-}-  (.|.) = liftA2 (.|.)-  {-# INLINE (.|.) #-}-  xor = liftA2 xor-  {-# INLINE xor #-}-  complement = fmap complement-  {-# INLINE complement #-}-  shift !b !n = fmap (`shift` n) b-  {-# INLINE shift #-}-  rotate !b !n = fmap (`rotate` n) b-  {-# INLINE rotate #-}-  zeroBits = pure zeroBits-  {-# INLINE zeroBits #-}-  bit = pure . bit-  {-# INLINE bit #-}-  testBit (PixelX (Bit 1)) 0 = True-  testBit _                _ = False-  {-# INLINE testBit #-}-  bitSizeMaybe _ = Just 1-  {-# INLINE bitSizeMaybe #-}-  bitSize _ = 1-  {-# INLINE bitSize #-}-  isSigned _ = False-  {-# INLINE isSigned #-}-  popCount (PixelX (Bit 0)) = 0-  popCount _                = 1-  {-# INLINE popCount #-}  toNum :: Num a => Bit -> a toNum (Bit 0) = 0

@@ -86,7 +86,11 @@   {-# INLINE foldr #-}  +instance Traversable (Pixel CMYK) where+  traverse f (PixelCMYK c m y k) = PixelCMYK <$> f c <*> f m <*> f y <*> f k+  {-# INLINE traverse #-} + instance Storable e => Storable (Pixel CMYK e) where    sizeOf _ = 4 * sizeOf (undefined :: e)@@ -99,7 +103,7 @@     m <- peekElemOff q 1     y <- peekElemOff q 2     k <- peekElemOff q 3-    return (PixelCMYK c m y k)+    return $! PixelCMYK c m y k   {-# INLINE peek #-}   poke !p (PixelCMYK c m y k) = do     let !q = castPtr p@@ -187,7 +191,11 @@   foldr f !z (PixelCMYKA c m y k a) = f c (f m (f y (f k (f a z))))   {-# INLINE foldr #-} +instance Traversable (Pixel CMYKA) where+  traverse f (PixelCMYKA c m y k a) = PixelCMYKA <$> f c <*> f m <*> f y <*> f k <*> f a+  {-# INLINE traverse #-} + instance Storable e => Storable (Pixel CMYKA e) where    sizeOf _ = 5 * sizeOf (undefined :: e)@@ -201,7 +209,7 @@     y <- peekElemOff q 2     k <- peekElemOff q 3     a <- peekElemOff q 4-    return (PixelCMYKA c m y k a)+    return $! PixelCMYKA c m y k a   {-# INLINE peek #-}   poke !p (PixelCMYKA c m y k a) = do     let !q = castPtr p

@@ -81,7 +81,11 @@   foldr f !z (PixelHSI h s i) = f h (f s (f i z))   {-# INLINE foldr #-} +instance Traversable (Pixel HSI) where+  traverse f (PixelHSI h s i) = PixelHSI <$> f h <*> f s <*> f i+  {-# INLINE traverse #-} + instance Storable e => Storable (Pixel HSI e) where    sizeOf _ = 3 * sizeOf (undefined :: e)@@ -90,16 +94,16 @@   {-# INLINE alignment #-}   peek !p = do     let !q = castPtr p-    r <- peek q-    g <- peekElemOff q 1-    b <- peekElemOff q 2-    return (PixelHSI r g b)+    h <- peek q+    s <- peekElemOff q 1+    i <- peekElemOff q 2+    return $! PixelHSI h s i   {-# INLINE peek #-}-  poke !p (PixelHSI r g b) = do+  poke !p (PixelHSI h s i) = do     let !q =  castPtr p-    poke q r-    pokeElemOff q 1 g-    pokeElemOff q 2 b+    poke q h+    pokeElemOff q 1 s+    pokeElemOff q 2 i   {-# INLINE poke #-}  ------------@@ -173,7 +177,11 @@   foldr f !z (PixelHSIA h s i a) = f h (f s (f i (f a z)))   {-# INLINE foldr #-} +instance Traversable (Pixel HSIA) where+  traverse f (PixelHSIA h s i a) = PixelHSIA <$> f h <*> f s <*> f i <*> f a+  {-# INLINE traverse #-} + instance Storable e => Storable (Pixel HSIA e) where   sizeOf _ = 4 * sizeOf (undefined :: e)   {-# INLINE sizeOf #-}@@ -185,7 +193,7 @@     s <- peekElemOff q 1     i <- peekElemOff q 2     a <- peekElemOff q 3-    return (PixelHSIA h s i a)+    return $! PixelHSIA h s i a   {-# INLINE peek #-}   poke !p (PixelHSIA h s i a) = do     let !q = castPtr p

@@ -20,7 +20,7 @@ import Control.Applicative import Control.DeepSeq (NFData(rnf), deepseq) import Control.Monad (liftM)-import Data.Default+import Data.Default.Class (Default(..)) import Data.Foldable import Data.Typeable import qualified Data.Vector.Generic as V@@ -34,7 +34,7 @@ data family Pixel cs e :: *  class (Eq cs, Enum cs, Show cs, Bounded cs, Typeable cs,-       Functor (Pixel cs), Applicative (Pixel cs), Foldable (Pixel cs),+       Functor (Pixel cs), Applicative (Pixel cs), Foldable (Pixel cs), Traversable (Pixel cs),        Eq (Pixel cs e), VU.Unbox (Components cs e), VS.Storable (Pixel cs e), Elevator e)       => ColorSpace cs e where @@ -118,7 +118,7 @@  instance ColorSpace cs e => Default (Pixel cs e) where -  def = promote 0+  def = pure 0   {-# INLINE def #-}  @@ -133,7 +133,7 @@   {-# INLINE abs #-}   signum      = fmap signum   {-# INLINE signum #-}-  fromInteger = promote . fromInteger+  fromInteger = pure . fromInteger   {-# INLINE fromInteger #-}  @@ -142,12 +142,12 @@   {-# INLINE (/) #-}   recip        = fmap recip   {-# INLINE recip #-}-  fromRational = promote . fromRational+  fromRational = pure . fromRational   {-# INLINE fromRational #-}   instance (ColorSpace cs e, Floating e) => Floating (Pixel cs e) where-  pi      = promote pi+  pi      = pure pi   {-# INLINE pi #-}   exp     = fmap exp   {-# INLINE exp #-}@@ -175,9 +175,9 @@   {-# INLINE acosh #-}  instance (ColorSpace cs e, Bounded e) => Bounded (Pixel cs e) where-  maxBound = promote maxBound+  maxBound = pure maxBound   {-# INLINE maxBound #-}-  minBound = promote minBound+  minBound = pure minBound   {-# INLINE minBound #-}  instance (ColorSpace cs e, NFData e) => NFData (Pixel cs e) where

@@ -78,20 +78,28 @@   {-# INLINE foldr #-}  +instance Traversable (Pixel RGB) where+  traverse f (PixelRGB r g b) = PixelRGB <$> f r <*> f g <*> f b+  {-# INLINE traverse #-}+ instance Storable e => Storable (Pixel RGB e) where   sizeOf _ = 3 * sizeOf (undefined :: e)+  {-# INLINE sizeOf #-}   alignment _ = alignment (undefined :: e)+  {-# INLINE alignment #-}   peek !p = do     let !q = castPtr p     r <- peek q     g <- peekElemOff q 1     b <- peekElemOff q 2-    return (PixelRGB r g b)+    return $! PixelRGB r g b+  {-# INLINE peek #-}   poke !p (PixelRGB r g b) = do     let !q = castPtr p     poke q r     pokeElemOff q 1 g     pokeElemOff q 2 b+  {-# INLINE poke #-}   ------------@@ -162,20 +170,27 @@   foldr f !z (PixelRGBA r g b a) = f r (f g (f b (f a z)))   {-# INLINE foldr #-} +instance Traversable (Pixel RGBA) where+  traverse f (PixelRGBA r g b a) = PixelRGBA <$> f r <*> f g <*> f b <*> f a+  {-# INLINE traverse #-}  instance Storable e => Storable (Pixel RGBA e) where   sizeOf _ = 4 * sizeOf (undefined :: e)+  {-# INLINE sizeOf #-}   alignment _ = alignment (undefined :: e)+  {-# INLINE alignment #-}   peek p = do     let q = castPtr p     r <- peek q     g <- peekElemOff q 1     b <- peekElemOff q 2     a <- peekElemOff q 3-    return (PixelRGBA r g b a)+    return $! PixelRGBA r g b a+  {-# INLINE peek #-}   poke p (PixelRGBA r g b a) = do     let q = castPtr p     poke q r     pokeElemOff q 1 g     pokeElemOff q 2 b     pokeElemOff q 3 a+  {-# INLINE poke #-}

@@ -2,6 +2,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}@@ -20,6 +21,7 @@   , fromPixelsX   ) where +import Data.Bits (Bits) import Data.Foldable import Data.Typeable (Typeable) import Foreign.Ptr@@ -27,15 +29,17 @@ import Graphics.ColorSpace.Internal import Prelude as P --- ^ This is a single channel colorspace, that is designed to separate Gray+-- | This is a single channel colorspace, that is designed to separate Gray -- level values from other types of colorspace, hence it is not convertible to -- or from, but rather is here to allow operation on arbirtary single channel--- images. If you are looking for a true grayscale colorspace+-- images. If you are looking for the actual grayscale color space. -- 'Graphics.ColorSpace.Luma.Y' should be used instead. data X = X deriving (Eq, Enum, Bounded, Show, Typeable)  -newtype instance Pixel X e = PixelX { getX :: e } deriving (Ord, Eq)+newtype instance  Pixel X e = PixelX+  { getX :: e+  } deriving (Ord, Eq, Enum, Bounded, Real, Integral, RealFrac, RealFloat, Bits)   instance Show e => Show (Pixel X e) where@@ -76,11 +80,14 @@   {-# INLINE foldr #-}  -instance Monad (Pixel X) where+instance Traversable (Pixel X) where+  traverse f (PixelX x) = PixelX <$> f x+  {-# INLINE traverse #-} ++instance Monad (Pixel X) where   return = PixelX   {-# INLINE return #-}-   (>>=) (PixelX g) f = f g   {-# INLINE (>>=) #-} @@ -123,62 +130,3 @@ fromPixelsX :: ColorSpace cs e => [(cs, Pixel X e)] -> Pixel cs e fromPixelsX = foldl' f (pure 0) where   f !px (c, PixelX x) = setPxC px c x------ -- | Apply a left fold to each of the pixels in the image.--- squashWith :: (Array arr cs e, Array arr X b) =>---               (b -> e -> b) -> b -> Image arr cs e -> Image arr X b--- squashWith f !a = I.map (PixelX . foldlPx f a) where--- {-# INLINE squashWith #-}----- -- | Combination of zipWith and simultanious left fold on two pixels at the same time.--- squashWith2 :: (Array arr cs e, Array arr X b) =>---                (b -> e -> e -> b) -> b -> Image arr cs e -> Image arr cs e -> Image arr X b--- squashWith2 f !a = I.zipWith (PixelX .:! foldlPx2 f a) where--- {-# INLINE squashWith2 #-}----- -- | Separate an image into a list of images with 'X' pixels containing every--- -- channel from the source image.--- ----- -- >>> frog <- readImageRGB "images/frog.jpg"--- -- >>> let [frog_red, frog_green, frog_blue] = toImagesX frog--- -- >>> writeImage "images/frog_red.png" $ toImageY frog_red--- -- >>> writeImage "images/frog_green.jpg" $ toImageY frog_green--- -- >>> writeImage "images/frog_blue.jpg" $ toImageY frog_blue--- ----- -- <<images/frog_red.jpg>> <<images/frog_green.jpg>> <<images/frog_blue.jpg>>--- ----- toImagesX :: (Array arr cs e, Array arr X e) => Image arr cs e -> [Image arr X e]--- toImagesX !img = P.map getCh (enumFrom minBound) where---   getCh !ch = I.map (PixelX . (`getPxC` ch)) img---   {-# INLINE getCh #-}--- {-# INLINE toImagesX #-}----- -- | Combine a list of images with 'X' pixels into an image of any color--- -- space, by supplying an order of color space channels.--- ----- -- For example here is a frog with swapped 'BlueRGB' and 'GreenRGB' channels.--- ----- -- >>> writeImage "images/frog_rbg.jpg" $ fromImagesX [(RedRGB, frog_red), (BlueRGB, frog_green), (GreenRGB, frog_blue)]--- ----- -- <<images/frog.jpg>> <<images/frog_rbg.jpg>>--- ----- -- It is worth noting though, despite that separating image channels can be--- -- sometimes pretty useful, exactly the same effect as in example above can be--- -- achieved in a much simpler and a more efficient way:--- ----- -- @ `I.map` (\\(PixelRGB r g b) -> PixelRGB r b g) frog @--- ----- 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---   {-# INLINE updateCh #-}---   fromXs img []          = img---   fromXs img ((c, i):xs) = fromXs (I.zipWith (updateCh c) img i) xs---   {-# INLINE fromXs #-}--- {-# INLINE fromImagesX #-}

@@ -2,6 +2,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}@@ -18,6 +19,7 @@   ) where  import Data.Foldable+import Data.Bits (Bits) import Data.Typeable (Typeable) import Foreign.Ptr import Foreign.Storable@@ -32,7 +34,8 @@ data Y = LumaY deriving (Eq, Enum, Show, Bounded, Typeable)  -newtype instance Pixel Y e = PixelY e deriving (Ord, Eq)+newtype instance Pixel Y e = PixelY e+  deriving (Ord, Eq, Enum, Bounded, Real, Integral, RealFrac, RealFloat, Bits)  instance Show e => Show (Pixel Y e) where   show (PixelY g) = "<Luma:("++show g++")>"@@ -70,11 +73,14 @@   {-# INLINE foldr #-}  -instance Monad (Pixel Y) where+instance Traversable (Pixel Y) where+  traverse f (PixelY y) = PixelY <$> f y+  {-# INLINE traverse #-} ++instance Monad (Pixel Y) where   return = PixelY   {-# INLINE return #-}-   (>>=) (PixelY y) f = f y   {-# INLINE (>>=) #-} @@ -159,6 +165,11 @@   {-# INLINE foldr #-}  +instance Traversable (Pixel YA) where+  traverse f (PixelYA y a) = PixelYA <$> f y <*> f a+  {-# INLINE traverse #-}++ instance Storable e => Storable (Pixel YA e) where    sizeOf _ = 2 * sizeOf (undefined :: e)@@ -169,7 +180,7 @@     let q = castPtr p     y <- peekElemOff q 0     a <- peekElemOff q 1-    return (PixelYA y a)+    return $! PixelYA y a   {-# INLINE peek #-}   poke !p (PixelYA y a) = do     let q = castPtr p

@@ -81,6 +81,11 @@   {-# INLINE foldr #-}  +instance Traversable (Pixel YCbCr) where+  traverse f (PixelYCbCr y b r) = PixelYCbCr <$> f y <*> f b <*> f r+  {-# INLINE traverse #-}++ instance Storable e => Storable (Pixel YCbCr e) where    sizeOf _ = 3 * sizeOf (undefined :: e)@@ -92,7 +97,7 @@     y <- peek q     b <- peekElemOff q 1     r <- peekElemOff q 2-    return (PixelYCbCr y b r)+    return $! PixelYCbCr y b r   {-# INLINE poke #-}   poke !p (PixelYCbCr y b r) = do     let q = castPtr p@@ -174,6 +179,11 @@   {-# INLINE foldr #-}  +instance Traversable (Pixel YCbCrA) where+  traverse f (PixelYCbCrA y b r a) = PixelYCbCrA <$> f y <*> f b <*> f r <*> f a+  {-# INLINE traverse #-}++ instance Storable e => Storable (Pixel YCbCrA e) where    sizeOf _ = 4 * sizeOf (undefined :: e)@@ -186,7 +196,7 @@     b <- peekElemOff q 1     r <- peekElemOff q 2     a <- peekElemOff q 3-    return (PixelYCbCrA y b r a)+    return $! PixelYCbCrA y b r a   {-# INLINE peek #-}   poke !p (PixelYCbCrA y b r a) = do     let q = castPtr p