hip 1.2.0.0 → 1.3.0.0

raw patch · 31 files changed

+972/−683 lines, 31 filesdep +criteriondep ~basedep ~deepseqdep ~vectorbinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: criterion

Dependency ranges changed: base, deepseq, vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +18/−2
• LICENSE +2/−0
• README.md +6/−4
• benchmarks/Interface.hs +75/−0
• hip.cabal +16/−2
• images/frog_translate_edge.jpg binary
• images/frog_translate_wrap.jpg binary
• images/logo_40.png binary
• images/logo_center.png binary
• images/logo_tile.png binary
• src/Graphics/Image.hs +66/−38
• src/Graphics/Image/ColorSpace/Gray.hs +1/−1
• src/Graphics/Image/IO.hs +3/−3
• src/Graphics/Image/IO/Formats/JuicyPixels.hs +77/−74
• src/Graphics/Image/IO/Histogram.hs +17/−15
• src/Graphics/Image/Interface.hs +63/−56
• src/Graphics/Image/Interface/Repa.hs +29/−43
• src/Graphics/Image/Interface/Repa/Internal.hs +294/−333
• src/Graphics/Image/Interface/Vector.hs +2/−31
• src/Graphics/Image/Interface/Vector/Unboxed.hs +38/−27
• src/Graphics/Image/Processing.hs +1/−1
• src/Graphics/Image/Processing/Binary.hs +6/−6
• src/Graphics/Image/Processing/Complex.hs +3/−3
• src/Graphics/Image/Processing/Complex/Fourier.hs +8/−6
• src/Graphics/Image/Processing/Convolution.hs +6/−6
• src/Graphics/Image/Processing/Geometric.hs +58/−13
• src/Graphics/Image/Processing/Interpolation.hs +2/−2
• src/Graphics/Image/Types.hs +3/−3
• tests/Graphics/Image/ColorSpaceSpec.hs +1/−1
• tests/Graphics/Image/InterfaceSpec.hs +63/−13
• tests/Graphics/Image/ProcessingSpec.hs +114/−0

@@ -1,3 +1,21 @@+1.3.0.0+=======++* Significantly simplified interface:+  * Removed `ManifestArray`, `SequentialArray` and `MutableArray` classes in favor of `MArray`.+* Rewrite of Repa image representations. Removed `RD` representation.+* Introduced function `canvasSize`.++1.2.0.0+=======++* Changed `Interpolation` in a way that border resolution is supplied separatly+  from the method.+* Introduced function `translate`.+* Added a better test suite. Improved coverage.+* Fixed a bug with border resolution strategy `Continue`.+* Added better error messaging for border checks.+ 1.1.0.1 ======= @@ -18,8 +36,6 @@  * Changed the way image displaying works. Now `displayImage` function will try   to automatically detect the default external viewer program.-* Made Histogram plotting using Chart dependency optional, which is controlled-  by a compile time flag `use-chart`. * Renamed module `Graphics.Image.IO.External` to `Graphics.Image.IO.Formats`,   so it reflects the purpose slightly better. 

@@ -1,3 +1,5 @@+BSD 3-Clause License+ Copyright (c) 2016, Alexey Kuleshevich All rights reserved. 

@@ -3,9 +3,10 @@  Haskell Image Processing (HIP) Library -Documentation is on [Hackage](http://hackage.haskell.org/package/hip).+Documentation is on [Hackage](http://hackage.haskell.org/package/hip), and [Stackage](https://www.stackage.org/nightly/package/hip). -[![Build Status](https://travis-ci.org/lehins/hip.svg?branch=master)](https://travis-ci.org/lehins/hip)+[![Build Status](https://travis-ci.org/lehins/hip.svg?branch=master)](https://travis-ci.org/lehins/hip) +[![Hackage](https://img.shields.io/hackage/v/hip.svg?style=flat)](https://hackage.haskell.org/package/hip)  Installation ------------@@ -14,8 +15,9 @@  * `$ cabal update && cabal install hip` -and using `stack` (from source code only, not yet on stackage):-* `$ stack install`+and using `stack`:++* `$ stack install hip`  In order to be able to view images in GHCi and external image viewer is used. On Linux I recommend `GPicView`, but you can use any viewer that accepts a filename

@@ -0,0 +1,75 @@+{-# LANGUAGE FlexibleContexts #-}+module Main where++import Prelude as P+import Criterion.Main+import Graphics.Image.Interface as I+--import Graphics.Image.Processing++--import qualified Graphics.Image.Interface.Vector as V+import Graphics.Image.Types++main :: IO ()+main = do+  defaultMain+    [ bgroup+        "RP fusion"+        [ bench "native" $+          whnf+            (compute  . (noFusion :: (Int, Int) -> Image RP Y Double))+            (1000, 1000)+        , bench "RP fusion" $+          whnf+            (compute  . (fusion :: (Int, Int) -> Image RP Y Double))+            (1000, 1000)+        ]+    , bgroup+        "RS fusion"+        [ bench "native" $+          whnf+            (compute . (noFusion :: (Int, Int) -> Image RS Y Double))+            (1000, 1000)+        , bench "RS fusion" $+          whnf+            (compute . (fusion :: (Int, Int) -> Image RS Y Double))+            (1000, 1000)+        ]+    , bgroup+        "VU fusion"+        [ bench "no fusion" $+          nf (noFusion :: (Int, Int) -> Image VU Y Double) (1000, 1000)+        , bench "VU fusion" $+          nf (fusion :: (Int, Int) -> Image VU Y Double) (1000, 1000)+        ]+    ]+--frog <- V.readImageY "images/frog.jpg"+--     [ bgroup+--         ("makeImage big " ++ show bigDims)+--         [ bench "makeImage VU" $ nf (`V.makeImage` getPxY) bigDims+--         , bench "computeS" $ nf R.computeS (R.makeImage bigDims getPxY)+--           -- parallel+--         , bench "computeP" $ nf R.computeP (R.makeImage bigDims getPxY)+--         ]+--     , bgroup+--         "Sobel operator"+--         [ bench "sobel VU" $ nf sobel frog+--         , bench "sobel RS" $ nf (sobel . exchange RS) frog+--           -- parallel+--         , bench "sobel RP" $ nf (sobel . R.computeP . exchange RP) frog+--         ]+--     ]+    where+--     bigDims = (2000, 2000)+      getPxY :: (Int, Int) -> Pixel Y Double+      getPxY (i, j) = fromIntegral (i * j)+      noFusion ds = makeImage ds getPx+        where getPx :: (Int, Int) -> Pixel Y Double+              getPx (i, j) = (getPxY (i, j) / 5 - fromIntegral i) * 21+      fusion ds = imap (\ (i, _) px -> (px - fromIntegral i) * 21) $ (makeImage ds getPxY / 5)+++-- sobel :: ManifestArray arr cs Double => Image arr cs Double -> Image arr cs Double+-- sobel img = sqrt (imgX ^ (2 :: Int) + imgY ^ (2 :: Int))+--   where+--     imgX = convolve Edge (fromLists [[-1, 0, 1], [-2, 0, 2], [-1, 0, 1]]) img+--     imgY = convolve Edge (fromLists [[-1,-2,-1], [ 0, 0, 0], [ 1, 2, 1]]) img

@@ -1,5 +1,5 @@ Name:              hip-Version:           1.2.0.0+Version:           1.3.0.0 License:           BSD3 License-File:      LICENSE Author:            Alexey Kuleshevich@@ -98,6 +98,7 @@   HS-Source-Dirs:     tests   Main-Is:            Spec.hs   Other-Modules:      Graphics.Image.ColorSpaceSpec+                    , Graphics.Image.ProcessingSpec                     , Graphics.Image.InterfaceSpec                     , Graphics.Image.Interface.VectorSpec   Build-Depends:      base            >= 4.5 && < 5@@ -105,7 +106,20 @@                     , hspec                     , QuickCheck   Default-Language:   Haskell2010-  GHC-Options:        -Wall -O0+  GHC-Options:        -Wall -threaded -with-rtsopts=-N+++benchmark interface-benchmarks+  type:                exitcode-stdio-1.0+  hs-source-dirs:      benchmarks+  main-is:             Interface.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base+                     , criterion+                     , deepseq+                     , hip+                     , vector+  default-language:    Haskell2010  Source-Repository head   Type:     git

binary file changed (absent → 82837 bytes)

binary file changed (absent → 131265 bytes)

binary file changed (absent → 1073 bytes)

binary file changed (absent → 1498 bytes)

binary file changed (absent → 6223 bytes)

@@ -20,14 +20,9 @@ -- representation, @__cs__@ is the `ColorSpace` of an image and @__e__@ is the -- type denoting precision of an image. ----- * @__`ManifestArray` arr cs e__@ - is a kind of array that is represented by an--- actual data in memory.------ * @__`SequentialArray` arr cs e__@ - contains functionality that can only be--- computed sequentially.------ * @__`MutableArray` arr cs e__@ - allows mutation on __@`MImage`@ @st@ @arr@ @cs@ @e@__,--- which is `Image`'s mutable cousin.+-- * @__`MArray` arr cs e__@ - is a kind of array, that can be indexed in+-- constant time and allows monadic operations and mutation on __@`MImage`@ @st@+-- @arr@ @cs@ @e@__, which is `Image`'s mutable cousin. -- -- Array representation type and the above classes it is installed in determine -- operations that can be done on the image with that representation.@@ -36,20 +31,18 @@ -- <http://hackage.haskell.org/package/repa Repa> packages: -- -- * `VU` - Unboxed Vector representation. (Default)--- * `RD` - Delayed Repa array representation. -- * `RS` - Unboxed Repa array representation (computation is done sequentially). -- * `RP` - Unboxed Repa array representation (computation is done in parallel). ----- Images with `RD` type hold functions rather then actual data, so this--- representation should be used for fusing computation together, and later--- changed to `RS` or `RP` using `exchange`, which in turn performs the fused--- computation.+-- Images with `RS` and `RP` types, most of the time hold functions rather then+-- actual data, this way computation can be fused together, and later changed to+-- `VU` using `toManifest`, which in turn performs the fused computation. If at+-- any time computation needs to be forced, `compute` can be used for that+-- purpose. -- -- Just as it is mentioned above, Vector representation is a default one, so in -- order to create images with Repa representation--- "Graphics.Image.Interface.Repa" module should be used. It has to be imported--- as qualified, since it contains image generating functions with same names as--- here.+-- "Graphics.Image.Interface.Repa" module should be used. -- -- Many of the function names exported by this module will clash with the ones -- from "Prelude", hence it can be more convenient to import it qualified and@@ -73,14 +66,26 @@   --   -- @ makeImage (256, 256) (PixelY . fromIntegral . fst) :: Image RP Y Word8 @   ---  makeImage, fromLists, toLists,+  makeImage, makeImageS, makeImageP, fromLists, fromListsS, fromListsP, toLists,   -- * IO   -- ** Reading-  -- | Read any supported image file into an 'Image' with 'VU' (Vector Unboxed)-  -- representation and pixels with 'Double' precision. In order to read an-  -- image with different representation, color space and precision 'readImage'-  -- or 'readImageExact' from <Graphics-Image-IO.html Graphics.Image.IO> can be-  -- used.+  -- | 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`, `RS` or `RP` 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 RP "images/cluster.jpg"+  -- >>> displayImage cluster+  -- >>> centaurus <- readImageRGB VU "images/centaurus.jpg"+  -- >>> displayImage centaurus+  -- >>> displayImage ((cluster + exchange RP centaurus) / 2)+  --+  -- <<images/cluster.jpg>> <<images/centaurus.jpg>> <<images/centaurus_and_cluster.jpg>>+  --   readImageY, readImageYA, readImageRGB, readImageRGBA, readImageExact,   -- ** Writing   writeImage, writeImageExact, displayImage,@@ -100,7 +105,7 @@   fold, sum, product, maximum, minimum, normalize,   -- * Representations   exchange,-  VU(..), RD(..), RS(..), RP(..),+  VU(..), RS(..), RP(..),   ) where  #if MIN_VERSION_base(4,8,0)@@ -112,9 +117,9 @@ import qualified Data.Foldable as F import Graphics.Image.ColorSpace import Graphics.Image.IO-import Graphics.Image.Interface hiding (makeImage, fromLists)-import Graphics.Image.Interface.Vector as V-import Graphics.Image.Interface.Repa as R (RD(..), RS(..), RP(..))+import Graphics.Image.Interface as I hiding (makeImage, fromLists)+import Graphics.Image.Interface.Vector+import Graphics.Image.Interface.Repa   import Graphics.Image.Processing@@ -124,59 +129,82 @@ import Graphics.Image.IO.Histogram  +-- | Read image as luma (brightness).+readImageY :: Array arr Y Double => arr -> FilePath -> IO (Image arr Y Double)+readImageY _ = fmap (either error id) . 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+{-# 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+{-# 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+{-# INLINE readImageRGBA #-}++ -- | Get the number of rows in an image. ----- >>> frog <- readImageRGB "images/frog.jpg"+-- >>> frog <- readImageRGB VU "images/frog.jpg" -- >>> frog -- <Image VectorUnboxed RGB (Double): 200x320> -- >>> rows frog -- 200 ---rows :: Array arr cs e => Image arr cs e -> Int+rows :: BaseArray arr cs e => Image arr cs e -> Int rows = fst . dims {-# INLINE rows #-}   -- | Get the number of columns in an image. ----- >>> frog <- readImageRGB "images/frog.jpg"+-- >>> frog <- readImageRGB VU "images/frog.jpg" -- >>> frog -- <Image VectorUnboxed RGB (Double): 200x320> -- >>> cols frog -- 320 ---cols :: Array arr cs e => Image arr cs e -> Int+cols :: BaseArray arr cs e => Image arr cs e -> Int cols = snd . dims {-# INLINE cols #-}   -- | Sum all pixels in the image.-sum :: ManifestArray arr cs e => Image arr cs e -> Pixel cs e+sum :: Array arr cs e => Image arr cs e -> Pixel cs e sum = fold (+) 0 {-# INLINE sum #-}   -- | Multiply all pixels in the image.-product :: ManifestArray arr cs e => Image arr cs e -> Pixel cs e+product :: Array arr cs e => Image arr cs e -> Pixel cs e product = fold (+) 1 {-# INLINE product #-}   -- | Retrieve the biggest pixel from an image-maximum :: (ManifestArray arr cs e, Ord (Pixel cs e)) => Image arr cs e -> Pixel cs e-maximum !img = fold max (index img (0, 0)) img+maximum :: (Array arr cs e, Ord (Pixel cs e)) => Image arr cs e -> Pixel cs e+maximum !img = fold max (index00 img) img {-# INLINE maximum #-}   -- | Retrieve the smallest pixel from an image-minimum :: (ManifestArray arr cs e, Ord (Pixel cs e)) => Image arr cs e -> Pixel cs e-minimum !img = fold min (index img (0, 0)) img+minimum :: (Array arr cs e, Ord (Pixel cs e)) => Image arr cs e -> Pixel cs e+minimum !img = fold min (index00 img) img {-# INLINE minimum #-}   -- | Scales all of the pixels to be in the range @[0, 1]@.-normalize :: (ManifestArray arr cs e, ManifestArray arr Gray e, Fractional e, Ord e) =>+normalize :: (Array arr cs e, Array arr Gray e, Fractional e, Ord e) =>              Image arr cs e -> Image arr cs e normalize !img = if l == s                  then (if s < 0 then (*0) else if s > 1 then (*1) else id) img@@ -193,7 +221,7 @@ -- -- @ img == fromLists (toLists img) @ ---toLists :: ManifestArray arr cs e => Image arr cs e -> [[Pixel cs e]]+toLists :: MArray arr cs e => Image arr cs e -> [[Pixel cs e]] toLists img = [[index img (i, j) | j <- [0..cols img - 1]] | i <- [0..rows img - 1]]  -- $colorspace

@@ -59,7 +59,7 @@ -- -- <<images/frog.jpg>> <<images/frog_rbg.jpg>> ----- It is worth noting though, that separating image channels can be sometimes+-- It is worth noting though, despite that separating image channels can be sometimes -- pretty useful, the same effect as above can be achieved in a much simpler and -- more efficient way: --

@@ -105,7 +105,7 @@ -- 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 RD RGB Word8))+-- >>> readImageExact JPG "images/frog.jpg" :: IO (Either String (Image RP 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@@ -141,7 +141,7 @@   -- | Write an image in a specific format, while supplying any format specific--- options. Precision and color space that an image will be written is decided+-- 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 img format =>@@ -190,7 +190,7 @@ the OS. This is a non-blocking function call, so it will take some time before an image will appear. -  >>> frog <- readImageRGB "images/frog.jpg"+  >>> frog <- readImageRGB VU "images/frog.jpg"   >>> displayImage frog  -}

@@ -796,38 +796,38 @@ -- Encoding images using JuicyPixels ------------------------------------------- -------------------------------------------------------------------------------- -instance ManifestArray arr Y Word8 => Writable (Image arr Y Word8) BMP where+instance Array arr Y Word8 => Writable (Image arr Y Word8) BMP where   encode _ _ = JP.encodeBitmap . imageToJPImage (convert :: Pixel Y Word8 -> JP.Pixel8)  -instance ManifestArray arr RGB Word8 => Writable (Image arr RGB Word8) BMP where+instance Array arr RGB Word8 => Writable (Image arr RGB Word8) BMP where   encode _ _ = JP.encodeBitmap . imageToJPImage (convert :: Pixel RGB Word8 -> JP.PixelRGB8)  -instance ManifestArray arr RGBA Word8 => Writable (Image arr RGBA Word8) BMP where+instance Array arr RGBA Word8 => Writable (Image arr RGBA Word8) BMP where   encode _ _ = JP.encodeBitmap . imageToJPImage (convert :: Pixel RGBA Word8 -> JP.PixelRGBA8)  -instance ManifestArray arr Binary Bit => Writable (Image arr Binary Bit) BMP where+instance Array arr Binary Bit => Writable (Image arr Binary Bit) BMP where   encode _ _ = JP.encodeBitmap . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8)                                                  . fromPixelBinary) -instance ManifestArray arr Y Double => Writable (Image arr Y Double) BMP where+instance Array arr Y Double => Writable (Image arr Y Double) BMP where   encode _ _ = JP.encodeBitmap . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8)                                                  . toWord8) -instance ManifestArray arr YA Double => Writable (Image arr YA Double) BMP where+instance Array arr YA Double => Writable (Image arr YA Double) BMP where   encode _ _ = JP.encodeBitmap . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8)                                                  . toWord8 . dropAlpha) -instance ManifestArray arr RGB Double => Writable (Image arr RGB Double) BMP where+instance Array arr RGB Double => Writable (Image arr RGB Double) BMP where   encode _ _ = JP.encodeBitmap . imageToJPImage ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)                                                  . toWord8) -instance ManifestArray arr RGBA Double => Writable (Image arr RGBA Double) BMP where+instance Array arr RGBA Double => Writable (Image arr RGBA Double) BMP where   encode _ _ = JP.encodeBitmap . imageToJPImage ((convert :: Pixel RGBA Word8 -> JP.PixelRGBA8)                                                  . toWord8)  -- Writable GIF -encodeGIF :: ManifestArray arr cs e =>+encodeGIF :: Array arr cs e =>              [SaveOption GIF] -> (Pixel cs e -> JP.PixelRGB8)              -> Image arr cs e -> BL.ByteString encodeGIF []                     !conv =@@ -838,27 +838,27 @@   JP.palettize palOpts . imageToJPImage conv  -instance ManifestArray arr RGB Word8 => Writable (Image arr RGB Word8) GIF where+instance Array arr RGB Word8 => Writable (Image arr RGB Word8) GIF where   encode _ opts = encodeGIF opts (convert :: Pixel RGB Word8 -> JP.PixelRGB8)   -instance ManifestArray arr Y Double => Writable (Image arr Y Double) GIF where+instance Array arr Y Double => Writable (Image arr Y Double) GIF where   encode _ opts = encodeGIF opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)                                   . toWord8 . toPixelRGB)     -instance ManifestArray arr YA Double => Writable (Image arr YA Double) GIF where+instance Array arr YA Double => Writable (Image arr YA Double) GIF where   encode _ opts = encodeGIF opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)                                   . toWord8 . toPixelRGB . dropAlpha) -instance ManifestArray arr RGB Double => Writable (Image arr RGB Double) GIF where+instance Array arr RGB Double => Writable (Image arr RGB Double) GIF where   encode _ opts = encodeGIF opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)                                   . toWord8) -instance ManifestArray arr RGBA Double => Writable (Image arr RGBA Double) GIF where+instance Array arr RGBA Double => Writable (Image arr RGBA Double) GIF where   encode _ opts = encodeGIF opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)                                   . toWord8 . dropAlpha)  -encodeGIFs :: ManifestArray arr cs e =>+encodeGIFs :: Array arr cs e =>               [SaveOption [GIF]] -> (Pixel cs e -> JP.PixelRGB8)            -> [(JP.GifDelay, Image arr cs e)] -> BL.ByteString encodeGIFs !opts !conv =@@ -873,31 +873,31 @@       !(jimg, p) = JP.palettize (getGIFsPal opts) $ imageToJPImage conv img  -instance ManifestArray arr RGB Word8 => Writable [(JP.GifDelay, Image arr RGB Word8)] [GIF] where+instance Array arr RGB Word8 => Writable [(JP.GifDelay, Image arr RGB Word8)] [GIF] where   encode _ opts = encodeGIFs opts (convert :: Pixel RGB Word8 -> JP.PixelRGB8) -instance ManifestArray arr RGB Double => Writable [(JP.GifDelay, Image arr RGB Double)] [GIF] where+instance Array arr RGB Double => Writable [(JP.GifDelay, Image arr RGB Double)] [GIF] where   encode _ opts = encodeGIFs opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)                                    . toWord8)  -- Writable HDR -instance ManifestArray arr RGB Float => Writable (Image arr RGB Float) HDR where+instance Array arr RGB Float => Writable (Image arr RGB Float) HDR where   encode _ _ = JP.encodeHDR . imageToJPImage (convert :: Pixel RGB Float -> JP.PixelRGBF)  -instance ManifestArray arr Y Double => Writable (Image arr Y Double) HDR where+instance Array arr Y Double => Writable (Image arr Y Double) HDR where   encode _ _ = JP.encodeHDR . imageToJPImage ((convert :: Pixel RGB Float -> JP.PixelRGBF)                                               . toFloat . toPixelRGB) -instance ManifestArray arr YA Double => Writable (Image arr YA Double) HDR where+instance Array arr YA Double => Writable (Image arr YA Double) HDR where   encode _ _ = JP.encodeHDR . imageToJPImage ((convert :: Pixel RGB Float -> JP.PixelRGBF)                                               . toFloat . toPixelRGB . dropAlpha) -instance ManifestArray arr RGB Double => Writable (Image arr RGB Double) HDR where+instance Array arr RGB Double => Writable (Image arr RGB Double) HDR where   encode _ _ = JP.encodeHDR . imageToJPImage ((convert :: Pixel RGB Float -> JP.PixelRGBF)                                               . toFloat) -instance ManifestArray arr RGBA Double => Writable (Image arr RGBA Double) HDR where+instance Array arr RGBA Double => Writable (Image arr RGBA Double) HDR where   encode _ _ = JP.encodeHDR . imageToJPImage ((convert :: Pixel RGB Float -> JP.PixelRGBF)                                               . toFloat . dropAlpha)  @@ -905,7 +905,7 @@ -- Writable JPG  -encodeJPG :: (JP.JpgEncodable px, ManifestArray arr cs e) =>+encodeJPG :: (JP.JpgEncodable px, Array arr cs e) =>              [SaveOption JPG] -> (Pixel cs e -> px) -> Image arr cs e -> BL.ByteString encodeJPG []               conv =   JP.encodeDirectJpegAtQualityWithMetadata 100 M.mempty . imageToJPImage conv@@ -913,185 +913,188 @@   JP.encodeDirectJpegAtQualityWithMetadata q M.mempty . imageToJPImage conv  -instance ManifestArray arr Y Word8 => Writable (Image arr Y Word8) JPG where+instance Array arr Y Word8 => Writable (Image arr Y Word8) JPG where   encode _ opts = encodeJPG opts (convert :: Pixel Y Word8 -> JP.Pixel8) -instance ManifestArray arr RGB Word8 => Writable (Image arr RGB Word8) JPG where+instance Array arr RGB Word8 => Writable (Image arr RGB Word8) JPG where   encode _ opts = encodeJPG opts (convert :: Pixel RGB Word8 -> JP.PixelRGB8)  -instance ManifestArray arr CMYK Word8 => Writable (Image arr CMYK Word8) JPG where+instance Array arr CMYK Word8 => Writable (Image arr CMYK Word8) JPG where   encode _ opts = encodeJPG opts (convert :: Pixel CMYK Word8 -> JP.PixelCMYK8)                 -instance ManifestArray arr YCbCr Word8 => Writable (Image arr YCbCr Word8) JPG where+instance Array arr YCbCr Word8 => Writable (Image arr YCbCr Word8) JPG where   encode _ opts = encodeJPG opts (convert :: Pixel YCbCr Word8 -> JP.PixelYCbCr8)  -instance ManifestArray arr Y Double => Writable (Image arr Y Double) JPG where+instance Array arr Y Double => Writable (Image arr Y Double) JPG where   encode _ opts = encodeJPG opts ((convert :: Pixel Y Word8 -> JP.Pixel8)                                   . toWord8)  -instance ManifestArray arr YA Double => Writable (Image arr YA Double) JPG where+instance Array arr YA Double => Writable (Image arr YA Double) JPG where   encode _ opts = encodeJPG opts ((convert :: Pixel Y Word8 -> JP.Pixel8)                                   . toWord8 . dropAlpha)  -instance ManifestArray arr RGB Double => Writable (Image arr RGB Double) JPG where+instance Array arr RGB Double => Writable (Image arr RGB Double) JPG where   encode _ opts = encodeJPG opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)                                   . toWord8)  -instance ManifestArray arr RGBA Double => Writable (Image arr RGBA Double) JPG where+instance Array arr RGBA Double => Writable (Image arr RGBA Double) JPG where   encode _ opts = encodeJPG opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)                                   . toWord8 . dropAlpha)    -- Writable PNG -instance ManifestArray arr Binary Bit => Writable (Image arr Binary Bit) PNG where+instance Array arr Binary Bit => Writable (Image arr Binary Bit) PNG where   encode _ _ = JP.encodePng . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8)                                                . fromPixelBinary)   -instance ManifestArray arr Y Word8 => Writable (Image arr Y Word8) PNG where+instance Array arr Y Word8 => Writable (Image arr Y Word8) PNG where   encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel Y Word8 -> JP.Pixel8)  -instance ManifestArray arr Y Word16 => Writable (Image arr Y Word16) PNG where+instance Array arr Y Word16 => Writable (Image arr Y Word16) PNG where   encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel Y Word16 -> JP.Pixel16)  -instance ManifestArray arr YA Word8 => Writable (Image arr YA Word8) PNG where+instance Array arr YA Word8 => Writable (Image arr YA Word8) PNG where   encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel YA Word8 -> JP.PixelYA8)  -instance ManifestArray arr YA Word16 => Writable (Image arr YA Word16) PNG where+instance Array arr YA Word16 => Writable (Image arr YA Word16) PNG where   encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel YA Word16 -> JP.PixelYA16)  -instance ManifestArray arr RGB Word8 => Writable (Image arr RGB Word8) PNG where+instance Array arr RGB Word8 => Writable (Image arr RGB Word8) PNG where   encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel RGB Word8 -> JP.PixelRGB8)  -instance ManifestArray arr RGB Word16 => Writable (Image arr RGB Word16) PNG where+instance Array arr RGB Word16 => Writable (Image arr RGB Word16) PNG where   encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel RGB Word16 -> JP.PixelRGB16)  -instance ManifestArray arr RGBA Word8 => Writable (Image arr RGBA Word8) PNG where+instance Array arr RGBA Word8 => Writable (Image arr RGBA Word8) PNG where   encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel RGBA Word8 -> JP.PixelRGBA8)  -instance ManifestArray arr RGBA Word16 => Writable (Image arr RGBA Word16) PNG where+instance Array arr RGBA Word16 => Writable (Image arr RGBA Word16) PNG where   encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel RGBA Word16 -> JP.PixelRGBA16)   -instance ManifestArray arr Y Double => Writable (Image arr Y Double) PNG where+instance Array arr Y Double => Writable (Image arr Y Double) PNG where   encode _ _ = JP.encodePng . imageToJPImage ((convert :: Pixel Y Word16 -> JP.Pixel16)                                               . toWord16) -instance ManifestArray arr YA Double => Writable (Image arr YA Double) PNG where+instance Array arr YA Double => Writable (Image arr YA Double) PNG where   encode _ _ = JP.encodePng . imageToJPImage ((convert :: Pixel YA Word16 -> JP.PixelYA16)                                               . toWord16) -instance ManifestArray arr RGB Double => Writable (Image arr RGB Double) PNG where+instance Array arr RGB Double => Writable (Image arr RGB Double) PNG where   encode _ _ = JP.encodePng . imageToJPImage ((convert :: Pixel RGB Word16 -> JP.PixelRGB16)                                               . toWord16) -instance ManifestArray arr RGBA Double => Writable (Image arr RGBA Double) PNG where+instance Array arr RGBA Double => Writable (Image arr RGBA Double) PNG where   encode _ _ = JP.encodePng . imageToJPImage ((convert :: Pixel RGBA Word16 -> JP.PixelRGBA16)                                               . toWord16)  -- Writable TGA -instance ManifestArray arr Binary Bit => Writable (Image arr Binary Bit) TGA where+instance Array arr Binary Bit => Writable (Image arr Binary Bit) TGA where   encode _ _ = JP.encodeTga . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8)                                               . fromPixelBinary)   -instance ManifestArray arr Y Word8 => Writable (Image arr Y Word8) TGA where+instance Array arr Y Word8 => Writable (Image arr Y Word8) TGA where   encode _ _ = JP.encodeTga . imageToJPImage (convert :: Pixel Y Word8 -> JP.Pixel8)  -instance ManifestArray arr RGB Word8 => Writable (Image arr RGB Word8) TGA where+instance Array arr RGB Word8 => Writable (Image arr RGB Word8) TGA where   encode _ _ = JP.encodeTga . imageToJPImage (convert :: Pixel RGB Word8 -> JP.PixelRGB8)  -instance ManifestArray arr RGBA Word8 => Writable (Image arr RGBA Word8) TGA where+instance Array arr RGBA Word8 => Writable (Image arr RGBA Word8) TGA where   encode _ _ = JP.encodeTga . imageToJPImage (convert :: Pixel RGBA Word8 -> JP.PixelRGBA8)   -instance ManifestArray arr Y Double => Writable (Image arr Y Double) TGA where+instance Array arr Y Double => Writable (Image arr Y Double) TGA where   encode _ _ = JP.encodeTga . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8)                                               . toWord8) -instance ManifestArray arr YA Double => Writable (Image arr YA Double) TGA where+instance Array arr YA Double => Writable (Image arr YA Double) TGA where   encode _ _ = JP.encodeTga . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8)                                               . toWord8 . dropAlpha) -instance ManifestArray arr RGB Double => Writable (Image arr RGB Double) TGA where+instance Array arr RGB Double => Writable (Image arr RGB Double) TGA where   encode _ _ = JP.encodeTga . imageToJPImage ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)                                               . toWord8) -instance ManifestArray arr RGBA Double => Writable (Image arr RGBA Double) TGA where+instance Array arr RGBA Double => Writable (Image arr RGBA Double) TGA where   encode _ _ = JP.encodeTga . imageToJPImage ((convert :: Pixel RGBA Word8 -> JP.PixelRGBA8)                                               . toWord8)  -- Writable TIF -instance ManifestArray arr Y Word8 => Writable (Image arr Y Word8) TIF where+instance Array arr Y Word8 => Writable (Image arr Y Word8) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel Y Word8 -> JP.Pixel8)  -instance ManifestArray arr Y Word16 => Writable (Image arr Y Word16) TIF where+instance Array arr Y Word16 => Writable (Image arr Y Word16) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel Y Word16 -> JP.Pixel16)  -instance ManifestArray arr YA Word8 => Writable (Image arr YA Word8) TIF where+instance Array arr YA Word8 => Writable (Image arr YA Word8) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel YA Word8 -> JP.PixelYA8)  -instance ManifestArray arr YA Word16 => Writable (Image arr YA Word16) TIF where+instance Array arr YA Word16 => Writable (Image arr YA Word16) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel YA Word16 -> JP.PixelYA16)  -instance ManifestArray arr RGB Word8 => Writable (Image arr RGB Word8) TIF where+instance Array arr RGB Word8 => Writable (Image arr RGB Word8) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel RGB Word8 -> JP.PixelRGB8)  -instance ManifestArray arr RGB Word16 => Writable (Image arr RGB Word16) TIF where+instance Array arr RGB Word16 => Writable (Image arr RGB Word16) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel RGB Word16 -> JP.PixelRGB16)  -instance ManifestArray arr RGBA Word8 => Writable (Image arr RGBA Word8) TIF where+instance Array arr RGBA Word8 => Writable (Image arr RGBA Word8) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel RGBA Word8 -> JP.PixelRGBA8)  -instance ManifestArray arr RGBA Word16 => Writable (Image arr RGBA Word16) TIF where+instance Array arr RGBA Word16 => Writable (Image arr RGBA Word16) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel RGBA Word16 -> JP.PixelRGBA16)  -instance ManifestArray arr YCbCr Word8 => Writable (Image arr YCbCr Word8) TIF where+instance Array arr YCbCr Word8 => Writable (Image arr YCbCr Word8) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel YCbCr Word8 -> JP.PixelYCbCr8)   -instance ManifestArray arr CMYK Word8 => Writable (Image arr CMYK Word8) TIF where+instance Array arr CMYK Word8 => Writable (Image arr CMYK Word8) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel CMYK Word8 -> JP.PixelCMYK8)  -instance ManifestArray arr CMYK Word16 => Writable (Image arr CMYK Word16) TIF where+instance Array arr CMYK Word16 => Writable (Image arr CMYK Word16) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel CMYK Word16 -> JP.PixelCMYK16)   -instance ManifestArray arr Binary Bit => Writable (Image arr Binary Bit) TIF where+instance Array arr Binary Bit => Writable (Image arr Binary Bit) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8)                                                . fromPixelBinary)   -instance ManifestArray arr Y Double => Writable (Image arr Y Double) TIF where+instance Array arr Y Double => Writable (Image arr Y Double) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage ((convert :: Pixel Y Word16 -> JP.Pixel16)                                                . toWord16) -instance ManifestArray arr YA Double => Writable (Image arr YA Double) TIF where+instance Array arr YA Double => Writable (Image arr YA Double) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage ((convert :: Pixel YA Word16 -> JP.PixelYA16)                                                . toWord16) -instance ManifestArray arr RGB Double => Writable (Image arr RGB Double) TIF where+instance Array arr RGB Double => Writable (Image arr RGB Double) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage ((convert :: Pixel RGB Word16 -> JP.PixelRGB16)                                                . toWord16) -instance ManifestArray arr RGBA Double => Writable (Image arr RGBA Double) TIF where+instance Array arr RGBA Double => Writable (Image arr RGBA Double) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage ((convert :: Pixel RGBA Word16 -> JP.PixelRGBA16)                                                . toWord16) -instance ManifestArray arr YCbCr Double => Writable (Image arr YCbCr Double) TIF where+instance Array arr YCbCr Double => Writable (Image arr YCbCr Double) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage ((convert :: Pixel YCbCr Word8 -> JP.PixelYCbCr8)                                                . toWord8) -instance ManifestArray arr CMYK Double => Writable (Image arr CMYK Double) TIF where+instance Array arr CMYK Double => Writable (Image arr CMYK Double) TIF where   encode _ _ = JP.encodeTiff . imageToJPImage ((convert :: Pixel CMYK Word16 -> JP.PixelCMYK16)                                                . toWord16)   -imageToJPImage :: (JP.Pixel a, ManifestArray arr cs e) =>+imageToJPImage :: (JP.Pixel a, Array arr cs e) =>                   (Pixel cs e -> a) -> Image arr cs e -> JP.Image a-imageToJPImage !f img@(dims -> (m, n)) = JP.generateImage g n m-  where g !j !i = f (index img (i, j))-        {-# INLINE g #-}+imageToJPImage !f !imgD = JP.generateImage g n m+  where+    !(m, n) = dims imgD+    !img = toManifest imgD+    g !j !i = f (index img (i, j))+    {-# INLINE g #-} {-# INLINE imageToJPImage #-}  

@@ -18,7 +18,6 @@ import Prelude as P  import Control.Concurrent (forkIO) import Control.Monad (void)-import Control.Monad.Primitive (PrimMonad (..)) import Graphics.Image.Interface as I import Graphics.Image.IO import Graphics.Image.ColorSpace@@ -26,12 +25,23 @@ import Graphics.Rendering.Chart.Backend.Diagrams import qualified Data.Colour as C import qualified Data.Vector.Unboxed as V-import qualified Data.Vector.Unboxed.Mutable as MV import System.Directory (getTemporaryDirectory) import System.FilePath ((</>)) import System.IO.Temp (createTempDirectory) +#if MIN_VERSION_vector(0,11,0)+import Data.Vector.Unboxed.Mutable (modify)+#else+import Control.Monad.Primitive (PrimMonad (..))+import qualified Data.Vector.Unboxed.Mutable as MV +modify :: (PrimMonad m, V.Unbox a) => MV.MVector (PrimState m) a -> (a -> a) -> Int -> m ()+modify v f idx = do+  e <- MV.read v idx+  MV.write v idx $ f e+#endif++ -- | A single channel histogram of an image. data Histogram = Histogram { hBins :: V.Vector Int                              -- ^ Vector containing pixel counts. Index of a@@ -47,8 +57,8 @@ type Histograms = [Histogram]  -- | Create a histogram per channel with 256 bins each.-getHistograms :: forall arr cs e . (SequentialArray arr Gray e,-                                    SequentialArray arr cs e, Elevator e) =>+getHistograms :: forall arr cs e . (MArray arr Gray e, Array arr Gray e, +                                    MArray arr cs e, Array arr cs e, Elevator e) =>                  Image arr cs e               -> Histograms getHistograms = P.zipWith setCh (enumFrom (toEnum 0) :: [cs]) . P.map getHistogram . toGrayImages@@ -56,7 +66,7 @@                        , hColour = csColour cs }  -- | Generate a histogram with 256 bins for a single channel Gray image.-getHistogram :: (SequentialArray arr Gray e, Elevator e) =>+getHistogram :: (MArray arr Gray e, Elevator e) =>                 Image arr Gray e              -> Histogram getHistogram img = Histogram { hBins = V.modify countBins $@@ -70,7 +80,7 @@  -- | Write histograms into a PNG image file. ----- >>> frog <- readImageRGB "images/frog.jpg"+-- >>> frog <- readImageRGB VU "images/frog.jpg" -- >>> writeHistograms "images/frog_histogram.svg" $ getHistograms frog -- -- <<images/frog_histogram.svg>>@@ -88,7 +98,7 @@ -- | Display image histograms using an external program. Works in a similar way as -- `Graphics.Image.IO.displayImage`. ----- >>> frog <- readImageRGB "images/frog.jpg"+-- >>> frog <- readImageRGB VU "images/frog.jpg" -- >>> displayHistograms $ getHistograms frog -- displayHistograms :: Histograms -> IO ()@@ -109,11 +119,3 @@   if block     then display     else void $ forkIO display------ | Used for backwards compatibility with vector.-modify :: (PrimMonad m, V.Unbox a) => MV.MVector (PrimState m) a -> (a -> a) -> Int -> m ()-modify v f idx = do-  e <- MV.read v idx-  MV.write v idx $ f e

@@ -22,7 +22,7 @@ -- module Graphics.Image.Interface (   ColorSpace(..), Alpha(..), Elevator(..),-  Array(..), ManifestArray(..), SequentialArray(..), MutableArray(..), +  BaseArray(..), Array(..), MArray(..),   Exchangable(..), exchangeFrom,   defaultIndex, borderIndex, maybeIndex, Border(..), handleBorderIndex,   ) where@@ -137,15 +137,30 @@ class (Show arr, ColorSpace cs, Num (Pixel cs e),        Functor (Pixel cs), Applicative (Pixel cs), Foldable (Pixel cs),        Num e, Typeable e, Elt arr cs e) =>-      Array arr cs e where+      BaseArray arr cs e where    -- | Required array specific constraints for an array element.   type Elt arr cs e :: Constraint   type Elt arr cs e = ()-  +   -- | Underlying image representation.   data Image arr cs e +  -- | Get dimensions of an image.+  --+  -- >>> frog <- readImageRGB VU "images/frog.jpg"+  -- >>> frog+  -- <Image VectorUnboxed RGB (Double): 200x320>+  -- >>> dims frog+  -- (200,320)+  --+  dims :: Image arr cs e -> (Int, Int)++class (MArray (Manifest arr) cs e, BaseArray arr cs e) => Array arr cs e where++  type Manifest arr :: *+  +   -- | Create an Image by supplying it's dimensions and a pixel generating   -- function.   makeImage :: (Int, Int) -- ^ (@m@ rows, @n@ columns) - dimensions of a new image.@@ -158,15 +173,9 @@   -- a scalar.   singleton :: Pixel cs e -> Image arr cs e -  -- | Get dimensions of an image.-  ---  -- >>> frog <- readImageRGB "images/frog.jpg"-  -- >>> frog-  -- <Image VectorUnboxed RGB (Double): 200x320>-  -- >>> dims frog-  -- (200,320)-  ---  dims :: Image arr cs e -> (Int, Int)+  -- | Retrieves a pixel at @(0, 0)@ index. Useful together with `fold`, when+  -- arbitrary initial pixel is needed.+  index00 :: Image arr cs e -> Pixel cs e    -- | Map a function over a an image.   map :: Array arr cs' e' =>@@ -236,10 +245,30 @@   fromLists :: [[Pixel cs e]]             -> Image arr cs e +  -- | Perform matrix multiplication on two images. Inner dimensions must agree.+  (|*|) :: Image arr cs e -> Image arr cs e -> Image arr cs e +  -- | Undirected reduction of an image.+  fold :: (Pixel cs e -> Pixel cs e -> Pixel cs e) -- ^ An associative folding function.+       -> Pixel cs e -- ^ Initial element, that is neutral with respect to the folding function.+       -> Image arr cs e -- ^ Source image.+       -> Pixel cs e++  -- | Pixelwise equality function of two images. Images are+  -- considered distinct if either images' dimensions or at least one pair of+  -- corresponding pixels are not the same. Used in defining an in instance for+  -- the 'Eq' typeclass.+  eq :: Eq (Pixel cs e) => Image arr cs e -> Image arr cs e -> Bool++  compute :: Image arr cs e -> Image arr cs e++  toManifest :: Image arr cs e -> Image (Manifest arr) cs e+  + -- | Array representation that is actually has real data stored in memory, hence -- allowing for image indexing, forcing pixels into computed state etc.-class Array arr cs e => ManifestArray arr cs e where+class BaseArray arr cs e => MArray arr cs e  where+  data MImage st arr cs e    unsafeIndex :: Image arr cs e -> (Int, Int) -> Pixel cs e   @@ -256,26 +285,6 @@   -- | Make sure that an image is fully evaluated.   deepSeqImage :: Image arr cs e -> a -> a -  -- | Perform matrix multiplication on two images. Inner dimensions must agree.-  (|*|) :: Image arr cs e -> Image arr cs e -> Image arr cs e--  -- | Undirected reduction of an image.-  fold :: (Pixel cs e -> Pixel cs e -> Pixel cs e) -- ^ An associative folding function.-       -> Pixel cs e -- ^ Initial element, that is neutral with respect to the folding function.-       -> Image arr cs e -- ^ Source image.-       -> Pixel cs e--  -- | Pixelwise equality function of two images. Images are-  -- considered distinct if either images' dimensions or at least one pair of-  -- corresponding pixels are not the same. Used in defining an in instance for-  -- the 'Eq' typeclass.-  eq :: Eq (Pixel cs e) => Image arr cs e -> Image arr cs e -> Bool----- | Array representation that allows computation, which depends on some specific--- order, consequently making it possible to be computed only sequentially.-class ManifestArray arr cs e => SequentialArray arr cs e where-   -- | Fold an image from the left in a row major order.   foldl :: (a -> Pixel cs e -> a) -> a -> Image arr cs e -> a @@ -292,21 +301,18 @@              -> m (Image arr cs e)    -- | Monading mapping over an image.-  mapM :: (SequentialArray arr cs' e', Functor m, Monad m) =>+  mapM :: (MArray arr cs' e', Functor m, Monad m) =>           (Pixel cs' e' -> m (Pixel cs e)) -> Image arr cs' e' -> m (Image arr cs e)    -- | Monading mapping over an image. Result is discarded.   mapM_ :: (Functor m, Monad m) => (Pixel cs e -> m b) -> Image arr cs e -> m () +  -- | Monadic folding.   foldM :: (Functor m, Monad m) => (a -> Pixel cs e -> m a) -> a -> Image arr cs e -> m a +  -- | Monadic folding. Result is discarded.   foldM_ :: (Functor m, Monad m) => (a -> Pixel cs e -> m a) -> a -> Image arr cs e -> m () ---- | Array representation that supports mutation.-class ManifestArray arr cs e => MutableArray arr cs e where-  data MImage st arr cs e-   -- | Get dimensions of a mutable image.   mdims :: MImage st arr cs e -> (Int, Int) @@ -344,24 +350,25 @@            -> Image arr' cs e -- ^ Source image.            -> Image arr cs e --- | `exchange` function that is allows restricting the representation type of--- source image.-exchangeFrom :: (Exchangable arr' arr, Array arr' cs e, Array arr cs e) =>-                arr'-             -> arr -- ^ New representation of an image.-             -> Image arr' cs e -- ^ Source image.-             -> Image arr cs e-exchangeFrom _ = exchange- -- | Changing to the same array representation as before is disabled and `exchange` -- will behave simply as an identitity function. instance Exchangable arr arr where -  exchange _ = id+  exchange _ !img = img   {-# INLINE exchange #-}  +-- | `exchange` function that allows restricting representation type of the+-- source image.+exchangeFrom :: (Exchangable arr' arr, Array arr' cs e, Array arr cs e) =>+                arr'+             -> arr -- ^ New representation of an image.+             -> Image arr' cs e -- ^ Source image.+             -> Image arr cs e+exchangeFrom _ to !img = exchange to img+{-# INLINE exchangeFrom #-} + -- | Approach to be used near the borders during various transformations. -- Whenever a function needs information not only about a pixel of interest, but -- also about it's neighbours, it will go out of bounds around the image edges,@@ -431,7 +438,7 @@   -- | Image indexing function that returns a default pixel if index is out of bounds.-defaultIndex :: ManifestArray arr cs e =>+defaultIndex :: MArray arr cs e =>                 Pixel cs e -> Image arr cs e -> (Int, Int) -> Pixel cs e defaultIndex !px !img = handleBorderIndex (Fill px) (dims img) (index img) {-# INLINE defaultIndex #-}@@ -439,7 +446,7 @@  -- | Image indexing function that uses a special border resolutions strategy for -- out of bounds pixels.-borderIndex :: ManifestArray arr cs e =>+borderIndex :: MArray arr cs e =>                Border (Pixel cs e) -> Image arr cs e -> (Int, Int) -> Pixel cs e borderIndex atBorder !img = handleBorderIndex atBorder (dims img) (unsafeIndex img) {-# INLINE borderIndex #-}@@ -447,7 +454,7 @@  -- | Image indexing function that returns @'Nothing'@ if index is out of bounds, -- @'Just' px@ otherwise.-maybeIndex :: ManifestArray arr cs e =>+maybeIndex :: MArray arr cs e =>               Image arr cs e -> (Int, Int) -> Maybe (Pixel cs e) maybeIndex !img@(dims -> (m, n)) !(i, j) =   if i >= 0 && j >= 0 && i < m && j < n then Just $ index img (i, j) else Nothing@@ -555,7 +562,7 @@   {-# INLINE minBound #-}  -instance (ManifestArray arr cs e, Eq (Pixel cs e)) => Eq (Image arr cs e) where+instance (Array arr cs e, Eq (Pixel cs e)) => Eq (Image arr cs e) where   (==) = eq   {-# INLINE (==) #-} @@ -631,13 +638,13 @@   {-# INLINE acosh #-}    -instance ManifestArray arr cs e => NFData (Image arr cs e) where+instance MArray arr cs e => NFData (Image arr cs e) where   rnf img = img `deepSeqImage` ()   {-# INLINE rnf #-}   -instance Array arr cs e =>+instance BaseArray arr cs e =>          Show (Image arr cs e) where   show (dims -> (m, n)) =     "<Image " ++@@ -648,7 +655,7 @@      show m ++ "x" ++ show n ++ ">"  -instance MutableArray arr cs e =>+instance MArray arr cs e =>          Show (MImage st arr cs e) where   show (mdims -> (m, n)) =     "<MutableImage " ++

@@ -9,63 +9,49 @@ -- module Graphics.Image.Interface.Repa (   -- * Construction-  makeImage, fromLists,-  -- * IO-  readImageY, readImageYA, readImageRGB, readImageRGBA,-  -- * Computation-  computeS, computeP, delay,+  makeImageS, makeImageP, fromListsS, fromListsP,   -- * Representation-  RD(..), RS(..), RP(..),+  RS(..), RP(..),   -- * Conversion-  fromRepaArray, toRepaArray+  fromRepaArrayS, fromRepaArrayP, toRepaArray   ) where -import Graphics.Image.IO import Graphics.Image.Interface hiding (makeImage, fromLists) import qualified Graphics.Image.Interface as I (makeImage, fromLists) import Graphics.Image.Interface.Repa.Internal-import Graphics.Image.ColorSpace  --- | Create a delayed representation of an image.-makeImage :: Array RD cs Double =>+-- | Create an image with sequential array representation.+makeImageS :: Array RS cs Double =>              (Int, Int) -- ^ (@m@ rows, @n@ columns) - dimensions of a new image.           -> ((Int, Int) -> Pixel cs Double)              -- ^ A function that takes (@i@-th row, and @j@-th column) as an argument              -- and returns a pixel for that location.-          -> Image RD cs Double-makeImage = I.makeImage-{-# INLINE makeImage #-}----- | Construct an image from a nested rectangular shaped list of pixels.-fromLists :: Array RD cs e =>-             [[Pixel cs e]]-          -> Image RD cs e-fromLists = I.fromLists-{-# INLINE fromLists #-}----- | Read image as luma (brightness).-readImageY :: FilePath -> IO (Image RD Y Double)-readImageY = fmap (either error id) . readImage-{-# INLINE readImageY #-}----- | Read image as luma with 'Alpha' channel.-readImageYA :: FilePath -> IO (Image RD YA Double)-readImageYA = fmap (either error id) . readImage-{-# INLINE readImageYA #-}-+          -> Image RS cs Double+makeImageS = I.makeImage+{-# INLINE makeImageS #-} --- | Read image in RGB colorspace.-readImageRGB :: FilePath -> IO (Image RD RGB Double)-readImageRGB = fmap (either error id) . readImage-{-# INLINE readImageRGB #-}+-- | Create an image with parallel array representation.+makeImageP :: Array RP cs Double =>+             (Int, Int) -- ^ (@m@ rows, @n@ columns) - dimensions of a new image.+          -> ((Int, Int) -> Pixel cs Double)+             -- ^ A function that takes (@i@-th row, and @j@-th column) as an argument+             -- and returns a pixel for that location.+          -> Image RP cs Double+makeImageP = I.makeImage+{-# INLINE makeImageP #-}  --- | Read image in RGB colorspace with 'Alpha' channel.-readImageRGBA :: FilePath -> IO (Image RD RGBA Double)-readImageRGBA = fmap (either error id) . readImage-{-# INLINE readImageRGBA #-}+-- | Construct an image from a nested rectangular shaped list of pixels sequentially.+fromListsS+  :: Array RS cs e+  => [[Pixel cs e]] -> Image RS cs e+fromListsS = I.fromLists+{-# INLINE fromListsS #-} +-- | Construct an image from a nested rectangular shaped list of pixels in parallel.+fromListsP+  :: Array RP cs e+  => [[Pixel cs e]] -> Image RP cs e+fromListsP = I.fromLists+{-# INLINE fromListsP #-}

@@ -18,8 +18,8 @@ -- Portability : non-portable -- module Graphics.Image.Interface.Repa.Internal (-  RD(..), RP(..), RS(..), computeP, computeS, delay,-  fromRepaArray, toRepaArray+  RP(..), RS(..),+  fromRepaArrayS, fromRepaArrayP, toRepaArray   ) where  #if MIN_VERSION_base(4,8,0)@@ -33,7 +33,7 @@ import Graphics.Image.Interface.Vector.Unboxed        (VU(..), fromUnboxedVector, toUnboxedVector, checkDims) import Data.Array.Repa.Repr.Unboxed (Unbox)-import qualified Data.Vector.Unboxed as V ((!))+import qualified Data.Vector.Unboxed as V (singleton)  import Data.Typeable (Typeable) import Data.Array.Repa.Index@@ -41,469 +41,430 @@ import qualified Data.Array.Repa.Eval as R (Elt(..), suspendedComputeP)  --- | Repa 'D'elayed Array representation, which allows for fusion of computation.-data RD = RD- -- | Repa 'U'nboxed Array representation, which is computed in parallel. data RP = RP  -- | Repa 'U'nboxed Array representation, which is computed sequentially.  data RS = RS -instance Show RD where-  show _ = "RepaDelayed"- instance Show RP where   show _ = "RepaParallel"    instance Show RS where   show _ = "RepaSequential" -instance Elt RD cs e => Array RD cs e where-  type Elt RD cs e = (ColorSpace cs, Num e, Typeable e, R.Elt e, Unbox e,-                      R.Elt (PixelElt cs e), Unbox (PixelElt cs e),-                      R.Elt (Pixel cs e), Unbox (Pixel cs e))-                     -  data Image RD cs e = RScalar !(Pixel cs e)-                     | RUImage !(R.Array R.U R.DIM2 (Pixel cs e))-                     | RDImage !(R.Array R.D R.DIM2 (Pixel cs e)) -  dims (RScalar _                          ) = (1, 1)-  dims (RUImage (R.extent -> (Z :. m :. n))) = (m, n)-  dims (RDImage (R.extent -> (Z :. m :. n))) = (m, n)-  {-# INLINE dims #-} -  singleton = RScalar-  {-# INLINE singleton #-}--  makeImage !(checkDims "RD.makeImage" -> (m, n)) !f =-    RDImage $ R.fromFunction (Z :. m :. n) (f . shT2)-  {-# INLINE makeImage #-}--  map f (RScalar px)        = RScalar (f px)-  map f (getDelayed -> arr) = RDImage (R.map f arr)-  {-# INLINE map #-}--  imap f (RScalar px)  = RScalar (f (0, 0) px)-  imap f (getDelayed -> arr) = RDImage (R.zipWith f (R.fromFunction (R.extent arr) shT2) arr)-  {-# INLINE imap #-}-    -  zipWith f (RScalar px1)        (RScalar px2)        = RScalar (f px1 px2)-  zipWith f (RScalar px1)        (getDelayed -> arr2) = RDImage (R.map (f   px1) arr2)-  zipWith f (getDelayed -> arr1) (RScalar px2)        = RDImage (R.map (`f` px2) arr1)-  zipWith f (getDelayed -> arr1) (getDelayed -> arr2) = RDImage (R.zipWith f arr1 arr2)-  {-# INLINE zipWith #-}--  izipWith f (RScalar px1)        (RScalar px2)        = RScalar (f (0, 0) px1 px2)-  izipWith f (RScalar px1)        !img2                = imap (`f` px1) img2-  izipWith f !img1                (RScalar px2)        = imap (\ !ix !px -> f ix px px2) img1-  izipWith f (getDelayed -> arr1) (getDelayed -> arr2) =-    RDImage (R.traverse2 arr1 arr2 const getNewPx) where-      getNewPx !getPx1 !getPx2 !sh = f (shT2 sh) (getPx1 sh) (getPx2 sh)-      {-# INLINE getNewPx #-}-  {-# INLINE izipWith #-}--  traverse (getDelayed -> arr) newDims newPx =-    RDImage $ R.traverse arr (tSh2 . checkDims "RD.traverse" . newDims . shT2) newPixel-    where-      newPixel getPx = newPx (getPx . tSh2) . shT2-  {-# INLINE traverse #-}--  traverse2 (getDelayed -> arr1) (getDelayed -> arr2) newDims newPx =-    RDImage $ R.traverse2 arr1 arr2 getNewDims getNewPx-    where getNewPx getPx1 getPx2 = newPx (getPx1 . tSh2) (getPx2 . tSh2) . shT2-          {-# INLINE getNewPx #-}-          getNewDims !dims1 !dims2 =-            tSh2 . checkDims "RD.traverse2" $ newDims (shT2 dims1) (shT2 dims2)-          {-# INLINE getNewDims #-}-  {-# INLINE traverse2 #-}--  transpose (RDImage arr) = RDImage (R.transpose arr)-  transpose (RUImage arr) = RDImage (R.transpose arr)-  transpose !img          = img-  {-# INLINE transpose #-}--  backpermute ds _ img@(RScalar _) = checkDims "RD.backpermute" ds `seq` img-  backpermute !(tSh2 . checkDims "RD.backpermute" -> sh) g (getDelayed -> arr) =-    RDImage (R.backpermute sh (tSh2 . g . shT2) arr)-  {-# INLINE backpermute #-}--  fromLists !ls = if isRect-                  then RUImage . R.fromListUnboxed (Z :. m :. n) . concat $ ls-                  else error "fromLists: Inner lists do not all have an equal length."-    where-      !(m, n) = (length ls, length $ head ls)-      !isRect = (m > 0) && (n > 0) && all (==n) (P.map length ls)-  {-# INLINE fromLists #-}-  ---instance Elt RS cs e => Array RS cs e where+instance Elt RS cs e => BaseArray RS cs e where   type Elt RS cs e = (ColorSpace cs,                        R.Elt e, Unbox e, Num e, Typeable e,                       R.Elt (PixelElt cs e), Unbox (PixelElt cs e),                       R.Elt (Pixel cs e), Unbox (Pixel cs e))   -  data Image RS cs e = RSImage !(Image RD cs e)--  dims (RSImage img) = dims img+  data Image RS cs e = SScalar !(Pixel cs e)+                     | SUImage !(R.Array R.U R.DIM2 (Pixel cs e))+                     | SDImage !(R.Array R.D R.DIM2 (Pixel cs e))+                       +  dims (SScalar _                          ) = (1, 1)+  dims (SUImage (R.extent -> (Z :. m :. n))) = (m, n)+  dims (SDImage (R.extent -> (Z :. m :. n))) = (m, n)   {-# INLINE dims #-} -  makeImage !(checkDims "RS.makeImage" -> ix) !f = computeS (makeImage ix f :: Image RD cs e)-  {-# INLINE makeImage #-} -  singleton = RSImage . singleton+instance (BaseArray RS cs e) => Array RS cs e where++  type Manifest RS = VU+  +  makeImage !(checkDims "RS.makeImage" -> (m, n)) !f =+    SDImage $ R.fromFunction (Z :. m :. n) (f . sh2dims)+  {-# INLINE makeImage #-}+  +  singleton = SScalar   {-# INLINE singleton #-} -  map !f (RSImage img) = computeS . map f $ img+  index00 (SScalar px)  = px+  index00 (SUImage arr) = R.index arr (Z :. 0 :. 0)+  index00 (SDImage arr) = R.index arr (Z :. 0 :. 0)+  {-# INLINE index00 #-}++  map !f (SScalar px)  = SScalar (f px)+  map !f (SUImage arr) = SDImage (R.map f arr)+  map !f (SDImage arr) = SDImage (R.map f arr)   {-# INLINE map #-} -  imap !f (RSImage img) = computeS . imap f $ img+  imap !f (SScalar px)  = SScalar (f (0, 0) px)+  imap !f (SUImage arr) = SDImage (imapR f arr)+  imap !f (SDImage arr) = SDImage (imapR f arr)   {-# INLINE imap #-} -  zipWith !f (RSImage img1) (RSImage img2) = computeS . zipWith f img1 $ img2+  zipWith f (SScalar px1)  (SScalar px2)  = SScalar (f px1 px2)+  zipWith f (SScalar px1)  img2           = map (f px1) img2+  zipWith f img1           (SScalar px2)  = map (`f` px2) img1+  zipWith f img1           img2           =+    SDImage (R.zipWith f (getDelayedS img1) (getDelayedS img2))   {-# INLINE zipWith #-} -  izipWith !f (RSImage img1) (RSImage img2) = computeS . izipWith f img1 $ img2+  izipWith f (SScalar px1)  (SScalar px2)  = SScalar (f (0, 0) px1 px2)+  izipWith f (SScalar px1)  img2           = imap (`f` px1) img2+  izipWith f img1           (SScalar px2)  = imap (\ !ix !px -> f ix px px2) img1+  izipWith f img1           img2           =+    SDImage (izipWithR f (getDelayedS img1) (getDelayedS img2))   {-# INLINE izipWith #-}--  traverse (RSImage img) newDims = computeS . traverse img newDims +  +  -- traverse (SScalar px) getNewDims getNewPx =+  --   makeImage (getNewDims (1, 1)) (getNewPx (const px))+  traverse img          getNewDims getNewPx =+    SDImage (traverseR (getDelayedS img) getNewDims getNewPx)   {-# INLINE traverse #-} -  traverse2 (RSImage img1) (RSImage img2) newDims = computeS . traverse2 img1 img2 newDims +  -- traverse2 (SScalar px1) (SScalar px2) getNewDims getNewPx =+  --   makeImage (getNewDims (1, 1) (1, 1)) (getNewPx (const px1) (const px2))+  traverse2 img1 img2 getNewDims getNewPx =+    SDImage (traverse2R (getDelayedS img1) (getDelayedS img2) getNewDims getNewPx)   {-# INLINE traverse2 #-} -  transpose (RSImage img) = computeS . transpose $ img+  transpose (SDImage arr) = SDImage (R.transpose arr)+  transpose (SUImage arr) = SDImage (R.transpose arr)+  transpose !img          = img   {-# INLINE transpose #-}-  -  backpermute !f !g (RSImage img) = computeS $ backpermute f g img++  -- backpermute !newDims _ (SScalar px) =+  --   SDImage $ R.fromFunction (dims2sh $ checkDims "RS.backpermute" newDims) (const px)+  backpermute !newDims g !img = SDImage (backpermuteR (getDelayedS img) newDims g)   {-# INLINE backpermute #-} -  fromLists = RSImage . fromLists+  fromLists = SUImage . fromListsR   {-# INLINE fromLists #-} +  fold f !px0 (SDImage arr) = R.foldAllS f px0 arr+  fold f !px0 (SUImage arr) = R.foldAllS f px0 arr+  fold f !px0 (SScalar px)  = f px0 px+  {-# INLINE fold #-} +  eq (SScalar px1) (SScalar px2) = px1 == px2+  eq img1 img2 = R.equalsS (getDelayedS img1) (getDelayedS img2)+  {-# INLINE eq #-} -instance Elt RP cs e => Array RP cs e where+  compute img@(SScalar _) = img+  compute img@(SUImage _) = img+  compute (SDImage arr)   = SUImage $ R.computeS arr+  {-# INLINE compute #-}++  (SUImage arr1)   |*| (SUImage arr2)   = SDImage (multR arr1 arr2)+  img1@(SDImage _) |*| img2             = compute img1 |*| img2+  img1             |*| img2@(SDImage _) = img1 |*| compute img2+  (SScalar px1)    |*| img2             = SUImage (singletonR px1) |*| img2+  img1             |*| (SScalar px2)    = img1 |*| SUImage (singletonR px2)+  {-# INLINE (|*|) #-}++  toManifest img@(SUImage arr) = fromUnboxedVector (dims img) (R.toUnboxed arr)+  toManifest (SScalar px)      = singleton px+  toManifest img               = toManifest (compute img)+  {-# INLINE toManifest #-}++---------------------+-- Parallel Arrays --+---------------------++instance Elt RP cs e => BaseArray RP cs e where   type Elt RP cs e = (ColorSpace cs,                        R.Elt e, Unbox e, Num e, Typeable e,                       R.Elt (PixelElt cs e), Unbox (PixelElt cs e),                       R.Elt (Pixel cs e), Unbox (Pixel cs e))   -  data Image RP cs e = RPImage !(Image RD cs e)--  dims (RPImage img) = dims img+  data Image RP cs e = PScalar !(Pixel cs e)+                     | PUImage !(R.Array R.U R.DIM2 (Pixel cs e))+                     | PDImage !(R.Array R.D R.DIM2 (Pixel cs e))+                       +  dims (PScalar _                          ) = (1, 1)+  dims (PUImage (R.extent -> (Z :. m :. n))) = (m, n)+  dims (PDImage (R.extent -> (Z :. m :. n))) = (m, n)   {-# INLINE dims #-} -  makeImage !(checkDims "RP.makeImage" -> ix) !f = suspendedComputeP $ makeImage ix f-  {-# INLINE makeImage #-} -  singleton = RPImage . singleton+instance (BaseArray RP cs e) => Array RP cs e where++  type Manifest RP = VU+  +  makeImage !(checkDims "RP.makeImage" -> (m, n)) !f =+    PDImage $ R.fromFunction (Z :. m :. n) (f . sh2dims)+  {-# INLINE makeImage #-}+  +  singleton = PScalar   {-# INLINE singleton #-} -  map !f (RPImage img) = suspendedComputeP . map f $ img+  index00 (PScalar px)  = px+  index00 (PUImage arr) = R.index arr (Z :. 0 :. 0)+  index00 (PDImage arr) = R.index arr (Z :. 0 :. 0)+  {-# INLINE index00 #-}++  map !f (PScalar px)  = PScalar (f px)+  map !f (PUImage arr) = PDImage (R.map f arr)+  map !f (PDImage arr) = PDImage (R.map f arr)   {-# INLINE map #-} -  imap !f (RPImage img) = suspendedComputeP . imap f $ img+  imap !f (PScalar px)  = PScalar (f (0, 0) px)+  imap !f (PUImage arr) = PDImage (imapR f arr)+  imap !f (PDImage arr) = PDImage (imapR f arr)   {-# INLINE imap #-} -  zipWith !f (RPImage img1) (RPImage img2) = suspendedComputeP . zipWith f img1 $ img2+  zipWith f (PScalar px1)  (PScalar px2)  = PScalar (f px1 px2)+  zipWith f (PScalar px1)  img2           = map (f px1) img2+  zipWith f img1           (PScalar px2)  = map (`f` px2) img1+  zipWith f img1           img2           =+    PDImage (R.zipWith f (getDelayedP img1) (getDelayedP img2))   {-# INLINE zipWith #-} -  izipWith !f (RPImage img1) (RPImage img2) = suspendedComputeP . izipWith f img1 $ img2+  izipWith f (PScalar px1)  (PScalar px2)  = PScalar (f (0, 0) px1 px2)+  izipWith f (PScalar px1)  img2           = imap (`f` px1) img2+  izipWith f img1           (PScalar px2)  = imap (\ !ix !px -> f ix px px2) img1+  izipWith f img1           img2           =+    PDImage (izipWithR f (getDelayedP img1) (getDelayedP img2))   {-# INLINE izipWith #-}--  traverse (RPImage img) newDims = suspendedComputeP . traverse img newDims +  +  -- traverse (PScalar px) getNewDims getNewPx =+  --   makeImage (getNewDims (1, 1)) (getNewPx (const px))+  traverse img          getNewDims getNewPx =+    PDImage (traverseR (getDelayedP img) getNewDims getNewPx)   {-# INLINE traverse #-} -  traverse2 (RPImage img1) (RPImage img2) newDims =-    suspendedComputeP . traverse2 img1 img2 newDims +  -- traverse2 (PScalar px1) (PScalar px2) getNewDims getNewPx =+  --   makeImage (getNewDims (1, 1) (1, 1)) (getNewPx (const px1) (const px2))+  traverse2 img1 img2 getNewDims getNewPx =+    PDImage (traverse2R (getDelayedP img1) (getDelayedP img2) getNewDims getNewPx)   {-# INLINE traverse2 #-} -  transpose (RPImage img) = suspendedComputeP . transpose $ img+  transpose (PDImage arr) = PDImage (R.transpose arr)+  transpose (PUImage arr) = PDImage (R.transpose arr)+  transpose !img          = img   {-# INLINE transpose #-}-  -  backpermute !f !g (RPImage img) = suspendedComputeP $ backpermute f g img++  -- backpermute !newDims _ (PScalar px) =+  --   PDImage $ R.fromFunction (dims2sh $ checkDims "RS.backpermute" newDims) (const px)+  backpermute !newDims g !img = PDImage (backpermuteR (getDelayedP img) newDims g)   {-# INLINE backpermute #-} -  fromLists = RPImage . fromLists+  fromLists = PUImage . fromListsR   {-# INLINE fromLists #-} --  -instance Array RS cs e => ManifestArray RS cs e where--  unsafeIndex (RSImage (RUImage arr)) (i, j) = R.index arr (Z :. i :. j)-  unsafeIndex (RSImage (RScalar px))  _      = px-  unsafeIndex _ _ = _errorCompute "ManifestArray RS cs e :: unsafeIndex"-  {-# INLINE unsafeIndex #-}--  deepSeqImage (RSImage (RUImage arr)) = R.deepSeqArray arr-  deepSeqImage (RSImage (RScalar px))  = seq px-  deepSeqImage _ = _errorCompute "ManifestArray RS cs e :: deepSeqImage"-  {-# INLINE deepSeqImage #-}--  (|*|) i1@(RSImage img1) i2@(RSImage img2) =-    i1 `deepSeqImage` i2 `deepSeqImage` computeS (mult img1 img2)-  {-# INLINE (|*|) #-}--  fold !f !px0 (RSImage (RUImage arr)) = R.foldAllS f px0 arr-  fold !f !px0 (RSImage (RScalar px))  = f px0 px-  fold _  _  _ = _errorCompute "ManifestArray RS cs e :: fold"+  fold f !px0 (PDImage arr) = head $ R.foldAllP f px0 arr+  fold f !px0 (PUImage arr) = head $ R.foldAllP f px0 arr+  fold f !px0 (PScalar px)  = f px0 px   {-# INLINE fold #-} -  eq (RSImage (RUImage arr1)) (RSImage (RUImage arr2)) = R.equalsS arr1 arr2-  eq (RSImage (RScalar arr1)) (RSImage (RScalar arr2)) = arr1 == arr2-  eq (RSImage (RUImage arr1)) (RSImage (RScalar arr2))-    | R.extent arr1 == (Z :. 1 :. 1) = R.index arr1 (Z :. 0 :. 0) == arr2-    | otherwise = False-  eq img1@(RSImage (RScalar _)) img2@(RSImage (RUImage _)) = img2 `eq` img1-  eq (RSImage (RDImage _)) _ = _errorCompute "ManifestArray RS cs e :: eq"-  eq _ (RSImage (RDImage _)) = _errorCompute "ManifestArray RS cs e :: eq"+  eq (PScalar px1) (PScalar px2) = px1 == px2+  eq img1 img2 = R.equalsS (getDelayedP img1) (getDelayedP img2)   {-# INLINE eq #-} --instance Array RP cs e => ManifestArray RP cs e where--  unsafeIndex (RPImage (RUImage arr)) (i, j) = R.unsafeIndex arr (Z :. i :. j)-  unsafeIndex (RPImage (RScalar px))  _      = px-  unsafeIndex _ _ = _errorCompute "ManifestArray RP cs e :: unsafeIndex"-  {-# INLINE unsafeIndex #-}--  deepSeqImage (RPImage (RUImage arr)) = R.deepSeqArray arr-  deepSeqImage (RPImage (RScalar px))  = seq px-  deepSeqImage _ = _errorCompute "ManifestArray RP cs e :: deepSeqImage"-  {-# INLINE deepSeqImage #-}+  compute img@(PScalar _) = img+  compute img@(PUImage _) = img+  compute (PDImage arr)   = arrU `R.deepSeqArray` PUImage arrU+    where arrU = R.suspendedComputeP arr+  {-# INLINE compute #-} -  (|*|) i1@(RPImage img1) i2@(RPImage img2) =-    i1 `deepSeqImage` i2 `deepSeqImage` suspendedComputeP (mult img1 img2)+  (PUImage arr1)   |*| (PUImage arr2)   = PDImage (multR arr1 arr2)+  img1@(PDImage _) |*| img2             = compute img1 |*| img2+  img1             |*| img2@(PDImage _) = img1 |*| compute img2+  (PScalar px1)    |*| img2             = PUImage (singletonR px1) |*| img2+  img1             |*| (PScalar px2)    = img1 |*| PUImage (singletonR px2)   {-# INLINE (|*|) #-} -  fold !f !px0 (RPImage (RUImage arr)) = head . R.foldAllP f px0 $ arr-  fold !f !px0 (RPImage (RScalar px))  = f px0 px-  fold _  _  _ = _errorCompute "ManifestArray RP cs e :: fold"-  {-# INLINE fold #-}+  toManifest img@(PUImage arr) = fromUnboxedVector (dims img) (R.toUnboxed arr)+  toManifest (PScalar px)      = singleton px+  toManifest img               = toManifest (compute img)+  {-# INLINE toManifest #-} -  eq (RPImage (RUImage arr1)) (RPImage (RUImage arr2)) = head $ R.equalsP arr1 arr2-  eq (RPImage (RScalar arr1)) (RPImage (RScalar arr2)) = arr1 == arr2-  eq (RPImage (RUImage arr1)) (RPImage (RScalar arr2))-    | R.extent arr1 == (Z :. 1 :. 1) = R.index arr1 (Z :. 0 :. 0) == arr2-    | otherwise = False-  eq img1@(RPImage (RScalar _)) img2@(RPImage (RUImage _)) = img2 `eq` img1-  eq (RPImage (RDImage _)) _ = _errorCompute "ManifestArray RP cs e :: eq"-  eq _ (RPImage (RDImage _)) = _errorCompute "ManifestArray RP cs e :: eq"-  {-# INLINE eq #-} -  -instance ManifestArray RS cs e => SequentialArray RS cs e where+----------------------+-- Helper functions --+---------------------- -  foldl !f !a = foldl f a . exchange VU-  {-# INLINE foldl #-}+sh2dims :: DIM2 -> (Int, Int)+sh2dims (Z :. i :. j) = (i, j)+{-# INLINE sh2dims #-} -  foldr !f !a = foldr f a . exchange VU-  {-# INLINE foldr #-}+dims2sh :: (Int, Int) -> DIM2+dims2sh !(i, j) = Z :. i :. j +{-# INLINE dims2sh #-} -  makeImageM !(checkDims "RS.makeImageM" -> ix) !f = fmap (exchangeFrom VU RS) (makeImageM ix f) -  mapM !f img = fmap (exchange RS) (mapM f (exchange VU img))-  {-# INLINE mapM #-}+imapR+  :: R.Source r2 b =>+     ((Int, Int) -> b -> c) -> R.Array r2 DIM2 b -> R.Array R.D DIM2 c+imapR f arr = R.zipWith f (R.fromFunction (R.extent arr) sh2dims) arr -  mapM_ !f img = mapM_ f (exchange VU img)-  {-# INLINE mapM_ #-} -  foldM !f !a = foldM f a . exchange VU-  {-# INLINE foldM #-}+-- | Combine two arrays, element-wise, with index aware operator. If the extent of+-- the two array arguments differ, then the resulting array's extent is their+-- intersection.+izipWithR+  :: (R.Source r2 t1, R.Source r1 t)+  => ((Int, Int) -> t -> t1 -> c)+  -> R.Array r1 DIM2 t+  -> R.Array r2 DIM2 t1+  -> R.Array R.D DIM2 c+izipWithR f arr1 arr2 =+  (R.traverse2 arr1 arr2 getNewDims getNewPx) where+    getNewPx !getPx1 !getPx2 !sh = f (sh2dims sh) (getPx1 sh) (getPx2 sh)+    getNewDims (Z :. m1 :. n1) (Z :. m2 :. n2) = Z :. min m1 m2 :. min n1 n2+    {-# INLINE getNewPx #-}+{-# INLINE izipWithR #-} -  foldM_ !f !a = foldM_ f a . exchange VU-  {-# INLINE foldM_ #-} +traverseR+  :: R.Source r c+  => R.Array r DIM2 c+  -> ((Int, Int) -> (Int, Int))+  -> (((Int, Int) -> c) -> (Int, Int) -> b)+  -> R.Array R.D DIM2 b+traverseR arr getNewDims getNewPx =+  R.traverse arr (dims2sh . checkDims "traverseR" . getNewDims . sh2dims) getNewE+  where+    getNewE getPx = getNewPx (getPx . dims2sh) . sh2dims+    {-# INLINE getNewE #-}+{-# INLINE traverseR #-} -instance ManifestArray RS cs e => MutableArray RS cs e where+traverse2R+  :: (R.Source r2 c1, R.Source r1 c)+  => R.Array r1 DIM2 c+  -> R.Array r2 DIM2 c1+  -> ((Int, Int) -> (Int, Int) -> (Int, Int))+  -> (((Int, Int) -> c) -> ((Int, Int) -> c1) -> (Int, Int) -> c2)+  -> R.Array R.D DIM2 c2+traverse2R arr1 arr2 getNewDims getNewPx =+  R.traverse2 arr1 arr2 getNewSh getNewE+  where getNewE getPx1 getPx2 = getNewPx (getPx1 . dims2sh) (getPx2 . dims2sh) . sh2dims+        {-# INLINE getNewE #-}+        getNewSh !sh1 !sh2 =+          dims2sh . checkDims "traverse2R" $ getNewDims (sh2dims sh1) (sh2dims sh2)+        {-# INLINE getNewSh #-}+{-# INLINE traverse2R #-} -  data MImage st RS cs e = MRSImage !(MImage st VU cs e)+backpermuteR+  :: R.Source r e+  => R.Array r DIM2 e+  -> (Int, Int)+  -> ((Int, Int) -> (Int, Int))+  -> R.Array R.D DIM2 e+backpermuteR arr newDims g =+  R.backpermute+    (dims2sh (checkDims "backpermuteR" newDims))+    (dims2sh . g . sh2dims)+    arr+{-# INLINE backpermuteR #-} -  mdims (MRSImage (mdims -> sz)) = sz-  {-# INLINE mdims #-} -  thaw img = fmap MRSImage (thaw (exchange VU img))-  {-# INLINE thaw #-}+fromListsR :: Unbox a => [[a]] -> R.Array R.U DIM2 a+fromListsR ls =+  if all (== n) (P.map length ls)+    then R.fromListUnboxed (Z :. m :. n) . concat $ ls+    else error "fromListsR: Inner lists do not all have an equal length."+  where+    !(m, n) = checkDims "fromListsR" (length ls, length $ head ls)+{-# INLINE fromListsR #-} -  freeze (MRSImage mimg) = fmap (exchange RS) (freeze mimg)-  {-# INLINE freeze #-} -  new sz = fmap MRSImage (new sz)-  {-# INLINE new #-} -  read (MRSImage mimg) = read mimg-  {-# INLINE read #-}-  -  write (MRSImage mimg) = write mimg-  {-# INLINE write #-}--  swap (MRSImage mimg) = swap mimg-  {-# INLINE swap #-}+multR+  :: (Num a, Unbox a, R.Elt a)+  => R.Array R.U DIM2 a -> R.Array R.U DIM2 a -> R.Array R.D DIM2 a+multR arr1 arr2 =+  if n1 /= m2+    then error $+         "Inner dimensions of multiplied images must be the same, but received: " ++ ""+         --show img1 ++ " X " ++ show img2+    else R.fromFunction (Z :. m1 :. n2) $ getPx+  where+    (Z :. m1 :. n1) = R.extent arr1+    (Z :. m2 :. n2) = R.extent arr2+    getPx (Z :. i :. j) =+      R.sumAllS+        (R.slice arr1 (R.Any :. (i :: Int) :. R.All) R.*^+         R.slice arr2 (R.Any :. (j :: Int)))+    {-# INLINE getPx #-}+{-# INLINE multR #-}  --- | O(1) - Delays manifest array.-instance Exchangable RS RD where--  exchange _ (RSImage img) = img-  {-# INLINE exchange #-}+singletonR :: Unbox e => e -> R.Array R.U DIM2 e+singletonR px = R.fromUnboxed (Z :. 1 :. 1) $ V.singleton px  --- | O(1) - Delays manifest array.-instance Exchangable RP RD where-  -  exchange _ (RPImage img) = img-  {-# INLINE exchange #-}---- | Computes delayed array sequentially.-instance Exchangable RD RS where    +getDelayedS :: Array RS cs e => Image RS cs e -> R.Array R.D DIM2 (Pixel cs e)+getDelayedS (SUImage arr) = R.delay arr+getDelayedS (SDImage arr) = arr+getDelayedS (SScalar px)  = R.fromFunction (Z :. 1 :. 1) (const px)+{-# INLINE getDelayedS #-} -  exchange _ (RDImage arr) = RSImage . RUImage . R.computeS $ arr-  exchange _ img           = RSImage img-  {-# INLINE exchange #-}+getDelayedP :: Array RP cs e => Image RP cs e -> R.Array R.D DIM2 (Pixel cs e)+getDelayedP (PUImage arr) = R.delay arr+getDelayedP (PDImage arr) = arr+getDelayedP (PScalar px)  = R.fromFunction (Z :. 1 :. 1) (const px)+{-# INLINE getDelayedP #-}  --- | O(1) - Changes computation strategy.+-- | Changes computation strategy. Will casue all fused operations to be computed. instance Exchangable RP RS where   -  exchange _ (RPImage img) = RSImage img-  {-# INLINE exchange #-}----- | Computes delayed array in parallel.-instance Exchangable RD RP where-  -  exchange _ (RDImage arr) = RPImage . RUImage . R.suspendedComputeP $ arr-  exchange _ img           = RPImage img+  exchange _ (PScalar px)   = SScalar px+  exchange _ (PUImage arr)  = SUImage arr+  exchange r img@(PDImage _) = exchange r (compute img)   {-# INLINE exchange #-}  --- | O(1) - Changes computation strategy.+-- | Changes computation strategy. Will casue all fused operations to be computed. instance Exchangable RS RP where   -  exchange _ (RSImage img) = RPImage img-  {-# INLINE exchange #-}----- | O(1) - Changes to Repa representation.-instance Exchangable VU RD where-  exchange _ = delay . exchange RS+  exchange _ (SScalar px)   = PScalar px+  exchange _ (SUImage arr)  = PUImage arr+  exchange r img@(SDImage _) = exchange r (compute img)   {-# INLINE exchange #-}   -- | O(1) - Changes to Repa representation. instance Exchangable VU RS where-  exchange _ img@(dims -> (1, 1)) = singleton (toUnboxedVector img V.! 0)-  exchange _ img = RSImage . RUImage . R.fromUnboxed (tSh2 $ dims img) . toUnboxedVector $ img+  exchange _ img@(dims -> (1, 1)) = singleton (img `index` (0, 0))+  exchange _ img = SUImage . R.fromUnboxed (dims2sh $ dims img) . toUnboxedVector $ img   {-# INLINE exchange #-}   -- | O(1) - Changes to Repa representation. instance Exchangable VU RP where-  exchange _ img@(dims -> (1, 1)) = singleton (toUnboxedVector img V.! 0)-  exchange _ img = RPImage . RUImage . R.fromUnboxed (tSh2 $ dims img) . toUnboxedVector $ img+  exchange _ img@(dims -> (1, 1)) = singleton (img `index` (0, 0))+  exchange _ img = PUImage . R.fromUnboxed (dims2sh $ dims img) . toUnboxedVector $ img   {-# INLINE exchange #-}   -- | O(1) - Changes to Vector representation. instance Exchangable RS VU where-  exchange _ img@(RSImage (RUImage arr)) = fromUnboxedVector (dims img) (R.toUnboxed arr)-  exchange _ (RSImage (RScalar px)) = singleton px-  exchange _ _                     = _errorCompute "Exchangable RS VU :: unsafeIndex"+  exchange _ = toManifest   {-# INLINE exchange #-}   -- | O(1) - Changes to Vector representation. instance Exchangable RP VU where-  exchange _ img@(RPImage (RUImage arr)) = fromUnboxedVector (dims img) (R.toUnboxed arr)-  exchange _ (RPImage (RScalar px)) = singleton px-  exchange _ _                     = _errorCompute "Exchangable RP VU :: unsafeIndex"+  exchange _ = toManifest   {-# INLINE exchange #-} --- | Computes an image in parallel and ensures that all elements are evaluated.-computeP :: (Array arr cs e, Array RP cs e, Exchangable arr RP) =>-            Image arr cs e -> Image RP cs e-computeP !img = head $! do-  let img' = exchange RP img-  img' `deepSeqImage` return img'-{-# INLINE computeP #-} --- | Computes an image sequentially and ensures that all elements are evaluated.-computeS :: (Array arr cs e, Array RS cs e, Exchangable arr RS) =>-            Image arr cs e -> Image RS cs e-computeS !img = head $! do-  let img' = exchange RS img-  img' `deepSeqImage` return img'-{-# INLINE computeS #-}---- | Delays an image, so further operations can be fused together.-delay :: (ManifestArray arr cs e, Array RD cs e, Exchangable arr RD) =>-         Image arr cs e -> Image RD cs e-delay = exchange RD-{-# INLINE delay #-}---mult :: Array RD cs e => Image RD cs e -> Image RD cs e -> Image RD cs e-mult img1@(RUImage arr1) img2@(RUImage arr2) =-  if n1 /= m2-    then error $-         "Inner dimensions of multiplied images must be the same, but received: " ++-         show img1 ++ " X " ++ show img2-    else RDImage . R.fromFunction (Z :. m1 :. n2) $ getPx-  where-    (Z :. m1 :. n1) = R.extent arr1-    (Z :. m2 :. n2) = R.extent arr2-    getPx (Z :. i :. j) =-      R.sumAllS-        (R.slice arr1 (R.Any :. (i :: Int) :. R.All) R.*^-         R.slice arr2 (R.Any :. (j :: Int)))-    {-# INLINE getPx #-}-mult _ _ = _errorCompute "Graphics.Image.Interface.Repa.Internal.mult"-{-# INLINE mult #-}---shT2 :: DIM2 -> (Int, Int)-shT2 (Z :. i :. j) = (i, j)-{-# INLINE shT2 #-}--tSh2 :: (Int, Int) -> DIM2-tSh2 !(i, j) = Z :. i :. j -{-# INLINE tSh2 #-}---suspendedComputeP :: Array RD cs e =>-                     Image RD cs e -> Image RP cs e-suspendedComputeP (RDImage arr) = RPImage . RUImage . R.suspendedComputeP $ arr-suspendedComputeP !img          = RPImage img-{-# INLINE suspendedComputeP #-}---getDelayed :: Array RD cs e => Image RD cs e -> R.Array R.D DIM2 (Pixel cs e)-getDelayed (RUImage arr) = R.delay arr-getDelayed (RDImage arr) = arr-getDelayed _             = error "Scalar image is not an array."-{-# INLINE getDelayed #-}+-- | Create a sequential image from a 2D Repa delayed array.+fromRepaArrayS :: R.Array R.D DIM2 (Pixel cs e) -> Image RS cs e+fromRepaArrayS = SDImage  --- | Create an image from a 2D Repa delayed array.-fromRepaArray :: R.Array R.D DIM2 (Pixel cs e) -> Image RD cs e-fromRepaArray = RDImage+-- | Create a parallel image from a 2D Repa delayed array.+fromRepaArrayP :: R.Array R.D DIM2 (Pixel cs e) -> Image RP cs e+fromRepaArrayP = PDImage  --- | Retrieve an underlying Repa array from `RD` image type.-toRepaArray :: (ColorSpace cs, Unbox (PixelElt cs e)) =>-               Image RD cs e -> R.Array R.D DIM2 (Pixel cs e)-toRepaArray (RUImage arr) = R.delay arr-toRepaArray (RDImage arr) = arr-toRepaArray (RScalar px) = R.fromFunction (Z :. 1 :. 1) $ const px-  -_errorCompute :: String -> t-_errorCompute err =-  error $-  err ++ ": Image should be computed at ths point. Please report this error."-                         +-- | Retrieve an underlying Repa array from an image.+toRepaArray+  :: (Array arr cs e, Array RS cs e, Exchangable arr RS)+  => Image arr cs e -> R.Array R.U DIM2 (Pixel cs e)+toRepaArray img =+  case compute (exchange RS img) of+    SUImage arr -> arr+    SDImage arr -> R.computeS arr -- shouldn't occur, but for completeness+    SScalar px -> R.computeS $ R.fromFunction (Z :. 1 :. 1) $ const px  instance R.Elt Bit where   touch (Bit w) = R.touch w

@@ -10,23 +10,19 @@ module Graphics.Image.Interface.Vector (   -- * Construction   makeImage, fromLists, fromUnboxedVector, toUnboxedVector,-  -- * IO-  readImageY, readImageYA, readImageRGB, readImageRGBA,   -- * Representation   VU(..),-  -- * Flat index conversion+  -- * Linear index conversion   toIx, fromIx   ) where -import Graphics.Image.IO import Graphics.Image.Interface hiding (makeImage, fromLists) import qualified Graphics.Image.Interface as I (makeImage, fromLists) import Graphics.Image.Interface.Vector.Unboxed-import Graphics.Image.ColorSpace   -- | Create an image with 'VU' (Vector Unboxed) representation and pixels of 'Double'--- precision. Note, that for 'Double' precision pixels it is essential to keep values+-- precision. Note, that it is essential for 'Double' precision pixels to keep values -- normalized in the @[0, 1]@ range in order for an image to be written to file -- properly. --@@ -68,28 +64,3 @@           -> Image VU cs e fromLists = I.fromLists {-# INLINE fromLists #-}----- | Read image as luma (brightness).-readImageY :: FilePath -> IO (Image VU Y Double)-readImageY = fmap (either error id) . readImage-{-# INLINE readImageY #-}----- | Read image as luma with 'Alpha' channel.-readImageYA :: FilePath -> IO (Image VU YA Double)-readImageYA = fmap (either error id) . readImage-{-# INLINE readImageYA #-}----- | Read image in RGB colorspace.-readImageRGB :: FilePath -> IO (Image VU RGB Double)-readImageRGB = fmap (either error id) . readImage-{-# INLINE readImageRGB #-}----- | Read image in RGB colorspace with 'Alpha' channel.-readImageRGBA :: FilePath -> IO (Image VU RGBA Double)-readImageRGBA = fmap (either error id) . readImage-{-# INLINE readImageRGBA #-}-

@@ -43,23 +43,32 @@   show _ = "VectorUnboxed"  -instance Elt VU cs e => Array VU cs e where+instance Elt VU cs e => BaseArray VU cs e where   type Elt VU cs e = (ColorSpace cs, Num e, Unbox e, Typeable e,                        Unbox (PixelElt cs e), Unbox (Pixel cs e))-                     +   data Image VU cs e = VScalar !(Pixel cs e)                      | VUImage !Int !Int !(Vector (Pixel cs e))-  ++  dims (VUImage m n _) = (m, n)+  dims (VScalar _)     = (1, 1)+  {-# INLINE dims #-}+++instance BaseArray VU cs e => Array VU cs e where++  type Manifest VU = VU+   makeImage !(checkDims "VU.makeImage" -> (m, n)) !f =     VUImage m n $ V.generate (m * n) (f . toIx n)   {-# INLINE makeImage #-}    singleton = VScalar   {-# INLINE singleton #-}-  -  dims (VUImage m n _) = (m, n)-  dims _               = (1, 1)-  {-# INLINE dims #-}++  index00 (VScalar px) = px+  index00 (VUImage _ _ v) = v V.! 0+  {-# INLINE index00 #-}      map !f (VScalar px)    = VScalar (f px)   map !f (VUImage m n v) = VUImage m n (V.map f v)@@ -105,8 +114,7 @@    backpermute !(checkDims "VU.backpermute" -> (m, n)) !f (VUImage _ n' v) =     VUImage m n $ V.backpermute v $ V.generate (m*n) (fromIx n' . f . toIx n)-  backpermute !sz      _ (VScalar px)     =-    if sz == (1, 1) then VScalar px else makeImage sz (const px)+  backpermute !sz _ (VScalar px) = makeImage sz (const px)   {-# INLINE backpermute #-}      fromLists !ls = if isSquare@@ -117,17 +125,6 @@       !isSquare = (n > 0) && all (==n) (P.map length ls)   {-# INLINE fromLists #-} --instance Array VU cs e => ManifestArray VU cs e where--  unsafeIndex (VUImage _ n v) !ix = V.unsafeIndex v (fromIx n ix)-  unsafeIndex (VScalar px)      _ = px-  {-# INLINE unsafeIndex #-}--  deepSeqImage (VUImage m n v) = m `seq` n `seq` deepseq v-  deepSeqImage (VScalar px)    = seq px-  {-# INLINE deepSeqImage #-}-     fold !f !px0 (VUImage _ _ v) = V.foldl' f px0 v   fold !f !px0 (VScalar px)    = f px0 px   {-# INLINE fold #-}@@ -153,9 +150,28 @@   eq _ _ = False   {-# INLINE eq #-} +  compute (VUImage m n v) = m `seq` n `seq` v `deepseq` (VUImage m n v)+  compute (VScalar px)    = px `seq` (VScalar px)+  {-# INLINE compute #-} -instance ManifestArray VU cs e => SequentialArray VU cs e where+  toManifest = id+  {-# INLINE toManifest #-} ++instance Array VU cs e => MArray VU cs e where+  +  data MImage st VU cs e = MVImage !Int !Int (MV.MVector st (Pixel cs e))+                         | MVScalar (MV.MVector st (Pixel cs e))+++  unsafeIndex (VUImage _ n v) !ix = V.unsafeIndex v (fromIx n ix)+  unsafeIndex (VScalar px)      _ = px+  {-# INLINE unsafeIndex #-}++  deepSeqImage (VUImage m n v) = m `seq` n `seq` deepseq v+  deepSeqImage (VScalar px)    = seq px+  {-# INLINE deepSeqImage #-}+   foldl !f !a (VUImage _ _ v) = V.foldl' f a v   foldl !f !a (VScalar px)    = f a px   {-# INLINE foldl #-}@@ -185,11 +201,6 @@   {-# INLINE foldM_ #-}  -instance ManifestArray VU cs e => MutableArray VU cs e where--  data MImage st VU cs e = MVImage !Int !Int (MV.MVector st (Pixel cs e))-                         | MVScalar (MV.MVector st (Pixel cs e))-   mdims (MVImage m n _) = (m, n)   mdims (MVScalar _)    = (1, 1)   {-# INLINE mdims #-}@@ -258,7 +269,7 @@ toIx :: Int -- ^ @n@ columns      -> Int -- ^ Flat vector index      -> (Int, Int) -- ^ @(i, j)@ row, column index-toIx !n !k = (k `div` n, k `mod` n)+toIx !n !k = divMod k n {-# INLINE toIx #-}  

@@ -34,7 +34,7 @@ -- | This function magnifies an image by a positive factor and draws a grid -- around the original pixels. It is here simply as useful inspection tool. ----- >>> frog <- readImageRGB "images/frog.jpg"+-- >>> frog <- readImageRGB VU "images/frog.jpg" -- >>> writeImage "images/frog_eye_grid.png" $ pixelGrid 10 $ crop (51, 112) (20, 20) frog -- -- <<images/frog.jpg>> <<images/frog_eye_grid.png>>

@@ -47,7 +47,7 @@ -- construction, which is done by comparing either a single pixel with every -- pixel in an image or two same size images pointwise. For example: ----- >>> frog <- readImageY "images/frog.jpg"+-- >>> frog <- readImageY VU "images/frog.jpg" -- >>> frog .==. PixelY 0    -- (or: PixelY 0 .==. frog) -- >>> frog .<. flipH frog   -- (or: flipH frog .>. frog) --@@ -161,7 +161,7 @@  -- | Threshold a source image with an applicative pixel. ----- >>> yield <- readImageRGB "images/yield.jpg"+-- >>> yield <- readImageRGB VU "images/yield.jpg" -- >>> writeImageExact PNG [] "images/yield_bin.png" $ thresholdWith (PixelRGB (>0.55) (<0.6) (<0.5)) yield -- -- <<images/yield.jpg>> <<images/yield_bin.png>>@@ -222,7 +222,7 @@ -- -- <<images/figure.png>> eroded with <<images/struct.png>> is <<images/figure_erode.png>> ---erode :: ManifestArray arr Binary Bit =>+erode :: Array arr Binary Bit =>          Image arr Binary Bit -- ^ Structuring element.       -> Image arr Binary Bit -- ^ Binary source image.       -> Image arr Binary Bit@@ -236,7 +236,7 @@ -- -- <<images/figure.png>> dialated with <<images/struct.png>> is <<images/figure_dialate.png>> ---dialate :: ManifestArray arr Binary Bit =>+dialate :: Array arr Binary Bit =>            Image arr Binary Bit -- ^ Structuring element.         -> Image arr Binary Bit -- ^ Binary source image.         -> Image arr Binary Bit@@ -250,7 +250,7 @@ -- -- <<images/figure.png>> opened with <<images/struct.png>> is <<images/figure_open.png>> ---open :: ManifestArray arr Binary Bit =>+open :: Array arr Binary Bit =>         Image arr Binary Bit -- ^ Structuring element.      -> Image arr Binary Bit -- ^ Binary source image.      -> Image arr Binary Bit@@ -264,7 +264,7 @@ -- -- <<images/figure.png>> closed with <<images/struct.png>> is <<images/figure_close.png>> ---close :: ManifestArray arr Binary Bit =>+close :: Array arr Binary Bit =>          Image arr Binary Bit -- ^ Structuring element.       -> Image arr Binary Bit -- ^ Binary source image.       -> Image arr Binary Bit

@@ -31,7 +31,7 @@  -- | Construct a complex image from two images representing real and imaginary parts. ----- >>> frog <- readImageRGB "images/frog.jpg"+-- >>> frog <- readImageRGB VU "images/frog.jpg" -- >>> frog !+! 0 -- <Image VectorUnboxed RGB (Complex Double): 200x320> -- >>> frog !+! frog@@ -96,7 +96,7 @@  -- | Make a filter by using a function that works around a regular @(x, y)@ -- coordinate system.-makeFilter :: (ManifestArray arr cs e, RealFloat e) =>+makeFilter :: (Array arr cs e, RealFloat e) =>               (Int, Int)               -- ^ Dimensions of the filter. Both @m@ and @n@ have to be powers               -- of @2@, i.e. @m == 2^k@, where @k@ is some integer.@@ -111,7 +111,7 @@   -- | Apply a filter to an image created by 'makeFilter'.-applyFilter :: (ManifestArray arr cs e, ManifestArray arr cs (Complex e), RealFloat e) =>+applyFilter :: (Array arr cs e, Array arr cs (Complex e), RealFloat e) =>                Image arr cs e -- ^ Source image.             -> Image arr cs e -- ^ Filter.             -> Image arr cs e

@@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | -- Module      : Graphics.Image.Processing.Complex.Fourier -- Copyright   : (c) Alexey Kuleshevich 2016@@ -29,7 +30,7 @@           | Inverse  -- | Fast Fourier Transform-fft :: (ManifestArray arr cs (Complex e), RealFloat e) =>+fft :: (Array arr cs (Complex e), RealFloat e) =>        Image arr cs (Complex e)     -> Image arr cs (Complex e) fft = fft2d Forward@@ -37,7 +38,7 @@   -- | Inverse Fast Fourier Transform-ifft :: (ManifestArray arr cs (Complex e), RealFloat e) =>+ifft :: (Array arr cs (Complex e), RealFloat e) =>         Image arr cs (Complex e)      -> Image arr cs (Complex e) ifft = fft2d Inverse@@ -57,7 +58,7 @@   -- | Compute the DFT of a matrix. Array dimensions must be powers of two else `error`.-fft2d :: (ManifestArray arr cs (Complex e), Num e, RealFloat e) =>+fft2d :: (Array arr cs (Complex e), Num e, RealFloat e) =>          Mode       -> Image arr cs (Complex e)       -> Image arr cs (Complex e)@@ -76,11 +77,12 @@ {-# INLINE fft2d #-}  -fftGeneral :: (ManifestArray arr cs (Complex e), Num e, RealFloat e) =>+fftGeneral :: (Array arr cs (Complex e), Num e, RealFloat e) =>               Pixel cs e            -> Image arr cs (Complex e)            -> Image arr cs (Complex e) fftGeneral !sign !img = transpose $ go n 0 1 where+  imgM = toManifest img   !(m, n) = dims img   go !len !offset !stride     | len == 2 = makeImage (m, 2) swivel@@ -89,8 +91,8 @@                   (go (len `div` 2) (offset + stride) (stride * 2))     where       swivel (m', j) = case j of-        0 -> index img (m', offset) + index img (m', offset + stride)-        1 -> index img (m', offset) - index img (m', offset + stride)+        0 -> index imgM (m', offset) + index imgM (m', offset + stride)+        1 -> index imgM (m', offset) - index imgM (m', offset + stride)         _ -> error "FFT: Image must have exactly 2 columns. Please, report this bug."       combine !len' evens odds =           let odds' = traverse odds id

@@ -18,10 +18,10 @@   -convolve'' :: ManifestArray arr cs e =>+convolve'' :: Array arr cs e =>               Border (Pixel cs e) -> Image arr cs e -> Image arr cs e -> Image arr cs e convolve'' !border !kernel !img =-  img `deepSeqImage` kernel `deepSeqImage` traverse2 kernel img (const . const sz) stencil+  traverse2 (compute kernel) (compute img) (const . const sz) stencil   where     !(krnM, krnN)     = dims kernel     !krnM2            = krnM `div` 2@@ -46,14 +46,14 @@ -- -- Example using <https://en.wikipedia.org/wiki/Sobel_operator Sobel operator>: ----- >>> frog <- readImageY "frog.jpg"+-- >>> frog <- readImageY RP "images/frog.jpg" -- >>> let frogX = convolve Edge (fromLists [[-1, 0, 1], [-2, 0, 2], [-1, 0, 1]]) frog -- >>> let frogY = convolve Edge (fromLists [[-1,-2,-1], [ 0, 0, 0], [ 1, 2, 1]]) frog -- >>> displayImage $ normalize $ sqrt (frogX ^ 2 + frogY ^ 2) -- -- <<images/frogY.jpg>> <<images/frog_sobel.jpg>> ---convolve  :: ManifestArray arr cs e =>+convolve  :: Array arr cs e =>              Border (Pixel cs e)   -- ^ Approach to be used near the borders.           -> Image arr cs e -- ^ Kernel image.           -> Image arr cs e -- ^ Source image.@@ -63,14 +63,14 @@   -- | Convolve image's rows with a vector kernel represented by a list of pixels.-convolveRows :: ManifestArray arr cs e =>+convolveRows :: Array arr cs e =>                 Border (Pixel cs e) -> [Pixel cs e] -> Image arr cs e -> Image arr cs e convolveRows !out = convolve out . fromLists . (:[]) . reverse {-# INLINE convolveRows #-}   -- | Convolve image's columns with a vector kernel represented by a list of pixels.-convolveCols :: ManifestArray arr cs e =>+convolveCols :: Array arr cs e =>                 Border (Pixel cs e) -> [Pixel cs e] -> Image arr cs e -> Image arr cs e convolveCols !out = convolve out . fromLists . P.map (:[]) . reverse {-# INLINE convolveCols #-}

@@ -16,7 +16,7 @@   -- ** Concatenation   leftToRight, topToBottom,   -- ** Canvas-  translate, crop, superimpose,+  translate, canvasSize, crop, superimpose,   -- ** Flipping   flipV, flipH,   -- ** Rotation@@ -122,18 +122,63 @@ {-# INLINE topToBottom #-}  +-- | Shift an image towards its bottom right corner by @(delatM, deltaN)@ rows and+-- columns, while specifying a border resolution strategy.+--+-- >>> frog <- readImageRGB VU "images/frog.jpg"+-- >>> writeImage "images/frog_translate_wrap.jpg" $ translate Wrap (50, 100) frog+-- >>> writeImage "images/frog_translate_edge.jpg" $ translate Edge (50, 100) frog+--+-- <<images/frog.jpg>> <<images/frog_translate_wrap.jpg>> <<images/frog_translate_edge.jpg>>+-- +-- @since 1.2.0.0+-- translate   :: Array arr cs e-  => Border (Pixel cs e) -> (Int, Int) -> Image arr cs e -> Image arr cs e-translate atBorder  !(dm, dn) !img = traverse img id newPx where-  newPx !getPx !(i, j) = handleBorderIndex atBorder (dims img) getPx (i - dm, j - dn)-  {-# INLINE newPx #-}+  => Border (Pixel cs e) -- ^ Border resolution strategy+  -> (Int, Int) -- ^ Number of rows and columns image will be shifted by.+  -> Image arr cs e -> Image arr cs e+translate atBorder !(dm, dn) !img = traverse img id newPx+  where+    newPx !getPx !(i, j) =+      handleBorderIndex atBorder (dims img) getPx (i - dm, j - dn)+    {-# INLINE newPx #-} {-# INLINE translate #-}  +-- | Change the size of an image. Pixel values and positions will not change,+-- except the ones outside the border, which are handled according to supplied+-- resolution strategy.+--+-- <<images/haskell_40.png>>+--+-- For example, it can be used to make a tile from the image above, or simply+-- scale the canvas and place it in a middle:+--+-- >>> logo <- readImageRGBA VU "images/logo_40.png"+-- >>> let incBy (fm, fn) = (rows logo * fm, cols logo * fn)+-- >>> writeImage "images/logo_tile.png" $ canvasSize Wrap (incBy (6, 10)) logo+-- >>> writeImage "images/logo_center.png" $ translate (Fill 0) (incBy (2, 3)) $ canvasSize (Fill 0) (incBy (5, 7)) logo+--+-- <<images/logo_tile.png>> <<images/logo_center.png>>+--+-- @since 1.2.1.0+--+canvasSize+  :: Array arr cs e+  => Border (Pixel cs e) -- ^ Border resolution strategy+  -> (Int, Int) -- ^ New dimensions of the image+  -> Image arr cs e -- ^ Source image+  -> Image arr cs e+canvasSize atBorder !ds !img = traverse img (const ds) newPx+  where+    newPx !getPx !ix = handleBorderIndex atBorder (dims img) getPx ix+    {-# INLINE newPx #-}+{-# INLINE canvasSize #-}+ -- | Crop an image, i.e. retrieves a sub-image image with @m@ rows and @n@ -- columns. Make sure @(i + m, j + n)@ is not greater than dimensions of a--- source image.+-- source image, otherwise it will result in an error. crop :: Array arr cs e =>         (Int, Int)     -- ^ @(i, j)@ starting index from within a source image.      -> (Int, Int)     -- ^ @(m, n)@ dimensions of a new image.@@ -179,7 +224,7 @@  -- | Flip an image vertically. ----- >>> frog <- readImageRGB "images/frog.jpg"+-- >>> frog <- readImageRGB VU "images/frog.jpg" -- >>> writeImage "images/frog_flipV.jpg" $ flipV frog -- -- <<images/frog.jpg>> <<images/frog_flipV.jpg>>@@ -191,7 +236,7 @@  -- | Flip an image horizontally. ----- >>> frog <- readImageRGB "images/frog.jpg"+-- >>> frog <- readImageRGB VU "images/frog.jpg" -- >>> writeImage "images/frog_flipH.jpg" $ flipH frog -- -- <<images/frog.jpg>> <<images/frog_flipH.jpg>>@@ -203,7 +248,7 @@  -- | Rotate an image clockwise by 90°. ----- >>> frog <- readImageRGB "images/frog.jpg"+-- >>> frog <- readImageRGB VU "images/frog.jpg" -- >>> writeImage "images/frog_rotate90.jpg" $ rotate90 frog -- -- <<images/frog.jpg>> <<images/frog_rotate90.jpg>>@@ -215,7 +260,7 @@  -- | Rotate an image by 180°. ----- >>> frog <- readImageRGB "images/frog.jpg"+-- >>> frog <- readImageRGB VU "images/frog.jpg" -- >>> writeImage "images/frog_rotate180.jpg" $ rotate180 frog -- -- <<images/frog.jpg>> <<images/frog_rotate180.jpg>>@@ -227,7 +272,7 @@  -- | Rotate an image clockwise by 270°. ----- >>> frog <- readImageRGB "images/frog.jpg"+-- >>> frog <- readImageRGB VU "images/frog.jpg" -- >>> writeImage "images/frog_rotate270.jpg" $ rotate270 frog -- -- <<images/frog.jpg>> <<images/frog_rotate270.jpg>>@@ -240,7 +285,7 @@  -- | Rotate an image clockwise by an angle Θ in radians. ----- >>> frog <- readImageRGBA "images/frog.jpg"+-- >>> frog <- readImageRGBA VU "images/frog.jpg" -- >>> writeImage "images/frog_rotate330.png" $ rotate Bilinear (Fill 0) (11*pi/6) frog -- -- <<images/frog.jpg>> <<images/frog_rotate330.png>>@@ -273,7 +318,7 @@  -- | Resize an image using an interpolation method. ----- >>> frog <- readImageRGB "images/frog.jpg"+-- >>> frog <- readImageRGB VU "images/frog.jpg" -- >>> writeImage "images/frog_resize.jpg" $ resize Bilinear Edge (100, 640) frog -- -- <<images/frog_resize.jpg>>

@@ -39,8 +39,8 @@  instance Interpolation Nearest where -  interpolate Nearest border !sz !getPx !(round -> i, round -> j) =-    handleBorderIndex border sz getPx (i, j)+  interpolate Nearest border !sz !getPx !(i, j) =+    handleBorderIndex border sz getPx (round i, round j)   {-# INLINE interpolate #-}  

@@ -9,14 +9,14 @@ module Graphics.Image.Types (   module Graphics.Image.ColorSpace,   module Graphics.Image.IO.Formats,-  Array, Image, ManifestArray, SequentialArray, MutableArray, MImage,+  Array, Image, MArray, MImage,   Exchangable, Border(..),-  VU(..), RD(..), RS(..), RP(..),+  VU(..), RS(..), RP(..),   ) where   import Graphics.Image.ColorSpace import Graphics.Image.Interface import Graphics.Image.Interface.Vector (VU(..))-import Graphics.Image.Interface.Repa (RD(..), RS(..), RP(..))+import Graphics.Image.Interface.Repa (RS(..), RP(..)) import Graphics.Image.IO.Formats

@@ -24,7 +24,7 @@   arbitrary = PixelRGB <$> arbitrary <*> arbitrary <*> arbitrary  -instance (SequentialArray VU RGB e, Arbitrary e) => Arbitrary (Image VU RGB e) where+instance (MArray VU RGB e, Arbitrary e) => Arbitrary (Image VU RGB e) where   arbitrary = do     (Positive m, Positive n) <- arbitrary     II.mapM (const arbitrary) $ I.makeImage (m, n) (const $ PixelGray (0 :: Double))

@@ -50,7 +50,7 @@ instance Arbitrary (Pixel RGB Double) where   arbitrary = PixelRGB <$> arbitraryDouble <*> arbitraryDouble <*> arbitraryDouble -instance (SequentialArray arr cs e, Arbitrary (Pixel cs e)) => Arbitrary (Image arr cs e) where+instance (MArray arr cs e, Arbitrary (Pixel cs e)) => Arbitrary (Image arr cs e) where   arbitrary = do     (Positive (Small m), Positive (Small n)) <- arbitrary     I.makeImageM (m, n) (const arbitrary)@@ -61,7 +61,13 @@   arbitrary = do     (Positive (Small m), Positive (Small n)) <- arbitrary     getPx <- arbitrary-    return $ Identical (I.makeImage (m, n) getPx) (I.makeImage (m, n) getPx)+    if (m, n) == (1, 1)+      then do+        img1 <- elements [I.makeImage (m, n) getPx, I.singleton (getPx (0, 0))]+        img2 <- elements [I.makeImage (m, n) getPx, I.singleton (getPx (0, 0))]+        return $ Identical img1 img2+      else return $+           Identical (I.makeImage (m, n) getPx) (I.makeImage (m, n) getPx)   instance Arbitrary px => Arbitrary (Border px) where@@ -157,12 +163,12 @@     newPx getPx (i, j) = getPx ((i - dm) `mod` m, (j - dn) `mod` n)  -prop_toFormLists :: Image VU Y Word8 -> Bool-prop_toFormLists img = img == I.fromLists (IM.toLists img)+prop_toFormLists :: (Array arr Y Word8, MArray arr Y Word8) => arr -> Image arr Y Word8 -> Bool+prop_toFormLists _ img = img == I.fromLists (IM.toLists img)   prop_sameDims :: Array arr Y Word8 => arr -> Identical VU arr Y Word8 -> Bool-prop_sameDims _ (Identical img1 img2) = IM.dims img1 == IM.dims img2+prop_sameDims _ (Identical img1 img2) = I.dims img1 == I.dims img2  prop_sameImage   :: (Exchangable arr RS, Array arr Y Word8)@@ -226,30 +232,74 @@     (m, n) = I.dims img1  +prop_sameTraverse2+  :: (Exchangable arr RS, Array arr Y Word8)+  => arr+  -> ((Int, Int) -> (Int, Int) -> (Positive (Small Int), Positive (Small Int)))+  -> ((Int, Int) -> Pixel Y Word8 -> Pixel Y Word8 -> Pixel Y Word8)+  -> Identical VU arr Y Word8+  -> Identical VU arr Y Word8+  -> Bool+prop_sameTraverse2 _ g f (Identical img1a img2a) (Identical img1b img2b) =+  I.exchange RS (I.traverse2 img1a img1b g' f') ==+  I.exchange RS (I.traverse2 img2a img2b g' f')+  where+    g' dimsA dimsB =+      case g dimsA dimsB of+        (Positive (Small i), Positive (Small j)) -> (i, j)+    f' getPx1 getPx2 ix@(i, j) =+      f ix (getPx1 (i `mod` ma, j `mod` na)) (getPx2 (i `mod` mb, j `mod` nb))+    (ma, na) = I.dims img1a+    (mb, nb) = I.dims img1b+++prop_sameTranspose+  :: (Exchangable arr RS, Array arr Y Word8)+  => arr+  -> Identical VU arr Y Word8+  -> Bool+prop_sameTranspose _ (Identical img1 img2) =+  I.exchange RS (I.transpose img1) == I.exchange RS (I.transpose img2)+++prop_sameBackpermute+  :: (Exchangable arr RP, Array arr Y Word8)+  => arr+  -> (Positive (Small Int), Positive (Small Int))+  -> ((Int, Int) -> (Int, Int))+  -> Identical VU arr Y Word8+  -> Bool+prop_sameBackpermute _ (Positive (Small m), Positive (Small n)) f (Identical img1 img2) =+  I.exchange RP (I.backpermute (m, n) (f' . f) img1) ==+  I.exchange RP (I.backpermute (m, n) (f' . f) img2)+  where+    (m', n') = I.dims img1+    f' (i, j) = (i `mod` m', j `mod` n')++ spec :: Spec spec = do   describe "Interface Properties" $ do     it "borderIndex" $ property prop_borderIndex-    it "toFormLists" $ property prop_toFormLists+    it "toFormLists" $ property $ prop_toFormLists VU   describe "Representation Properties" $ do-    it "sameDims RD" $ property $ prop_sameDims RD     it "sameDims RS" $ property $ prop_sameDims RS     it "sameDims RP" $ property $ prop_sameDims RP-    it "sameImage RD" $ property $ prop_sameImage RD     it "sameImage RS" $ property $ prop_sameImage RS     it "sameImage RP" $ property $ prop_sameImage RP-    it "sameMap RD" $ property $ prop_sameMap RD     it "sameMap RS" $ property $ prop_sameMap RS     it "sameMap RP" $ property $ prop_sameMap RP-    it "sameImap RD" $ property $ prop_sameImap RD     it "sameImap RS" $ property $ prop_sameImap RS     it "sameImap RP" $ property $ prop_sameImap RP-    it "sameZipWith RD" $ property $ prop_sameZipWith RD     it "sameZipWith RS" $ property $ prop_sameZipWith RS     it "sameZipWith RP" $ property $ prop_sameZipWith RP-    it "sameIZipWith RD" $ property $ prop_sameIZipWith RD     it "sameIZipWith RS" $ property $ prop_sameIZipWith RS     it "sameIZipWith RP" $ property $ prop_sameIZipWith RP-    it "sameTraverse RD" $ property $ prop_sameTraverse RD     it "sameTraverse RS" $ property $ prop_sameTraverse RS     it "sameTraverse RP" $ property $ prop_sameTraverse RP+    it "sameTraverse2 RS" $ property $ prop_sameTraverse2 RS+    it "sameTraverse2 RP" $ property $ prop_sameTraverse2 RP+    it "sameTranspose RS" $ property $ prop_sameTranspose RS+    it "sameTranspose RP" $ property $ prop_sameTranspose RP+    it "sameBackpermute RS" $ property $ prop_sameBackpermute RS+    it "sameBackpermute RP" $ property $ prop_sameBackpermute RP

@@ -0,0 +1,114 @@+{-# LANGUAGE FlexibleContexts #-}+module Graphics.Image.ProcessingSpec (spec) where++import Test.Hspec+import Test.QuickCheck++import qualified Graphics.Image.Interface as I+import Graphics.Image.Types+import Graphics.Image.Processing++import Graphics.Image.InterfaceSpec (translateWrap, dummyImage10x20)++data Interpol+  = I1 Nearest+  | I2 Bilinear++instance Show Interpol where+  show (I1 i) = "I1 " ++ show i+  show (I2 i) = "I2 " ++ show i++instance Arbitrary Interpol where+  arbitrary = do+    ix <- arbitrary+    case ix `mod` (2 :: Int) of+      0 -> return $ I1 Nearest+      1 -> return $ I2 Bilinear+      _ -> error $ "Unknown interpolation: " ++ show ix+++prop_sampleRows :: Image VU Y Double -> Bool+prop_sampleRows img = img == downsampleRows (upsampleRows img)++prop_sampleCols :: Image VU Y Double -> Bool+prop_sampleCols img = img == downsampleCols (upsampleCols img)++prop_sample :: Image VU Y Double -> Bool+prop_sample img = img == downsample (upsample img)++prop_translateWrap :: (Int, Int) -> Image VU RGB Double -> Bool+prop_translateWrap shift img = translateWrap shift img == translate Wrap shift img++prop_cropSuperimpose :: (Positive (Small Int), Positive (Small Int))+                     -> (Positive (Small Int), Positive (Small Int))+                     -> Image VU Y Double -> Bool+prop_cropSuperimpose (Positive (Small iA), Positive (Small jA)) (Positive (Small mA), Positive (Small nA)) img =+  img == superimpose (i0, j0) (crop (i0, j0) (m', n') img) img+  where+    (m, n) = I.dims img+    (i0, j0) = (iA `mod` m, jA `mod` n)+    (m', n') = (1 + mA `mod` (m - i0), 1 + nA `mod` (n - j0))+    +prop_concatRotate :: Image VU Y Word8 -> Bool+prop_concatRotate img =+  topToBottom (rotate90 img) (rotate270 img) ==+  rotate90 (leftToRight img $ rotate180 img)+++prop_rotate90 :: Interpol -> Border (Pixel RGB Double) -> Image VU RGB Double -> Bool+prop_rotate90 (I1 i) border img = rotate90 img == rotate i border (pi/2) img+prop_rotate90 (I2 i) border img = rotate90 img == rotate i border (pi/2) img++prop_rotate180 :: Interpol -> Border (Pixel RGB Double) -> Image VU RGB Double -> Bool+prop_rotate180 (I1 i) border img = rotate180 img == rotate i border pi img+prop_rotate180 (I2 i) border img = rotate180 img == rotate i border pi img++prop_rotate270 :: Interpol -> Border (Pixel RGB Double) -> Image VU RGB Double -> Bool+prop_rotate270 (I1 i) border img = rotate270 img == rotate i border (3*pi/2) img+prop_rotate270 (I2 i) border img = rotate270 img == rotate i border (3*pi/2) img++prop_rotate360 :: Interpol -> Border (Pixel RGB Double) -> Image VU RGB Double -> Bool+prop_rotate360 (I1 i) border img = (rotate270 . rotate90) img == rotate i border (2*pi) img+prop_rotate360 (I2 i) border img = (rotate270 . rotate90) img == rotate i border (2*pi) img+++spec :: Spec+spec = do+  describe "Processing Properties" $+    do it "sampleRows" $ property prop_sampleRows+       it "sampleCols" $ property prop_sampleCols+       it "sample" $ property prop_sample+       it "translateWrap" $ property prop_translateWrap+       it "cropSuperimpose" $ property prop_cropSuperimpose+       it "concatRotate" $ property prop_concatRotate+       it "rotate90" $ property prop_rotate90+       it "rotate180" $ property prop_rotate180+       it "rotate270" $ property prop_rotate270+       it "rotate360" $ property prop_rotate360+  describe "Processing Errors" $+    do it "crop start index outside" $+         do shouldThrow (return $! crop (-1, -1) (1, 1) dummyImage10x20) anyException+            shouldThrow (return $! crop (10, 20) (1, 1) dummyImage10x20) anyException+            shouldThrow (return $! crop (15, 10) (1, 1) dummyImage10x20) anyException+            shouldThrow (return $! crop (5, 21) (1, 1) dummyImage10x20) anyException+       it "crop result image outside" $+         do shouldThrow (return $! crop (6, 6) (5, 15) dummyImage10x20) anyException+            shouldThrow (return $! crop (5, 15) (5, 15) dummyImage10x20) anyException+       it "crop negative dimensions" $+         do shouldThrow (return $! crop (1, 1) (-5, 15) dummyImage10x20) anyException+            shouldThrow (return $! crop (1, 1) (5, -15) dummyImage10x20) anyException+       it "upsample non-positive" $+         do shouldThrow (return $! upsampleF (0, 1) dummyImage10x20) anyException+            shouldThrow (return $! upsampleF (1, 0) dummyImage10x20) anyException+            shouldThrow (return $! upsampleF (-1, -1) dummyImage10x20) anyException+       it "downsample non-positive" $+         do shouldThrow (return $! downsampleF (0, 1) dummyImage10x20) anyException+            shouldThrow (return $! downsampleF (1, 0) dummyImage10x20) anyException+            shouldThrow (return $! downsampleF (-1, -1) dummyImage10x20) anyException+       it "concat dimension mismatch" $+         do shouldThrow+              (return $! leftToRight dummyImage10x20 $ I.transpose dummyImage10x20)+              anyException+            shouldThrow+              (return $! topToBottom dummyImage10x20 $ I.transpose dummyImage10x20)+              anyException