packages feed

JuicyPixels-extra 0.4.1 → 0.5.0

raw patch · 8 files changed

+295/−235 lines, 8 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

CHANGELOG.md view
@@ -1,3 +1,11 @@+## Juicy Pixels Extra 0.5.0++* Changed how edge pixels are calculated when scaling via bilinear+  interpolation is used. [See PR+  21](https://github.com/mrkkrp/JuicyPixels-extra/pull/21).++* Dropped support for GHC 8.2 and older.+ ## Juicy Pixels Extra 0.4.1  * Fixed left rotation so that `rotateLeft90 . rotateRight90` is now identity
Codec/Picture/Extra.hs view
@@ -1,138 +1,148 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+ -- | -- Module      :  Codec.Picture.Extra--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com> -- Stability   :  experimental -- Portability :  portable ----- Utilities for image transformation with JuicyPixels.--{-# LANGUAGE CPP                 #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE RankNTypes          #-}-{-# LANGUAGE RecordWildCards     #-}-{-# LANGUAGE ScopedTypeVariables #-}-+-- A collection of functions to scale, crop, flip images with JuicyPixels. module Codec.Picture.Extra   ( -- * Scaling-    scaleBilinear+    scaleBilinear,+     -- * Cropping-  , crop+    crop,+     -- * Rotation-  , flipHorizontally-  , flipVertically-  , rotateLeft90-  , rotateRight90-  , rotate180+    flipHorizontally,+    flipVertically,+    rotateLeft90,+    rotateRight90,+    rotate180,+     -- * Other-  , beside-  , below )+    beside,+    below,+  ) where  import Codec.Picture+import qualified Codec.Picture.Types as M import Control.Monad.ST import Data.List (foldl1')-import qualified Codec.Picture.Types as M  -- | Scale an image using bi-linear interpolation.--scaleBilinear-  :: ( Pixel a-     , Bounded (PixelBaseComponent a)-     , Integral (PixelBaseComponent a)-     )-  => Int               -- ^ Desired width-  -> Int               -- ^ Desired height-  -> Image a           -- ^ Original image-  -> Image a           -- ^ Scaled image+scaleBilinear ::+  ( Pixel a,+    Bounded (PixelBaseComponent a),+    Integral (PixelBaseComponent a)+  ) =>+  -- | Desired width+  Int ->+  -- | Desired height+  Int ->+  -- | Original image+  Image a ->+  -- | Scaled image+  Image a scaleBilinear width height img@Image {..} = runST $ do   mimg <- M.newMutableImage width height   let sx, sy :: Float-      sx = fromIntegral imageWidth  / fromIntegral width+      sx = fromIntegral imageWidth / fromIntegral width       sy = fromIntegral imageHeight / fromIntegral height       go x' y'         | x' >= width = go 0 (y' + 1)         | y' >= height = M.unsafeFreezeImage mimg         | otherwise = do-            let xf = fromIntegral x' * sx-                yf = fromIntegral y' * sy-                x, y :: Int-                x  = floor xf-                y  = floor yf-                δx = xf - fromIntegral x-                δy = yf - fromIntegral y-                pixelAt' i j =-                  if i >= imageWidth || j >= imageHeight-                    then toBlack (pixelAt img 0 0)-                    else pixelAt img i j-            writePixel mimg x' y' $-              mulp (pixelAt' x y) ((1 - δx) * (1 - δy)) `addp`-              mulp (pixelAt' (x + 1) y) (δx * (1 - δy)) `addp`-              mulp (pixelAt' x (y + 1)) ((1 - δx) * δy) `addp`-              mulp (pixelAt' (x + 1) (y + 1)) (δx * δy)-            go (x' + 1) y'+          let xf = fromIntegral x' * sx+              yf = fromIntegral y' * sy+              x, y :: Int+              x = floor xf+              y = floor yf+              δx = xf - fromIntegral x+              δy = yf - fromIntegral y+              pixelAt' i j =+                pixelAt img (min (pred imageWidth) i) (min (pred imageHeight) j)+          writePixel mimg x' y' $+            mulp (pixelAt' x y) ((1 - δx) * (1 - δy))+              `addp` mulp (pixelAt' (x + 1) y) (δx * (1 - δy))+              `addp` mulp (pixelAt' x (y + 1)) ((1 - δx) * δy)+              `addp` mulp (pixelAt' (x + 1) (y + 1)) (δx * δy)+          go (x' + 1) y'   go 0 0  #define scaleBilinear_spec(pixel) \ {-# SPECIALIZE scaleBilinear :: Int -> Int -> Image pixel -> Image pixel #-} -scaleBilinear_spec(M.PixelRGBA16)-scaleBilinear_spec(M.PixelRGBA8)-scaleBilinear_spec(M.PixelCMYK16)-scaleBilinear_spec(M.PixelCMYK8)-scaleBilinear_spec(M.PixelYCbCr8)-scaleBilinear_spec(M.PixelRGB16)-scaleBilinear_spec(M.PixelYCbCrK8)-scaleBilinear_spec(M.PixelRGB8)-scaleBilinear_spec(M.PixelYA16)-scaleBilinear_spec(M.PixelYA8)-scaleBilinear_spec(M.Pixel32)-scaleBilinear_spec(M.Pixel16)-scaleBilinear_spec(M.Pixel8)--toBlack :: Pixel a => a -> a-toBlack = colorMap (const 0)-{-# INLINE toBlack #-}+scaleBilinear_spec (M.PixelRGBA16)+scaleBilinear_spec (M.PixelRGBA8)+scaleBilinear_spec (M.PixelCMYK16)+scaleBilinear_spec (M.PixelCMYK8)+scaleBilinear_spec (M.PixelYCbCr8)+scaleBilinear_spec (M.PixelRGB16)+scaleBilinear_spec (M.PixelYCbCrK8)+scaleBilinear_spec (M.PixelRGB8)+scaleBilinear_spec (M.PixelYA16)+scaleBilinear_spec (M.PixelYA8)+scaleBilinear_spec (M.Pixel32)+scaleBilinear_spec (M.Pixel16)+scaleBilinear_spec (M.Pixel8)  mulp :: (Pixel a, Integral (PixelBaseComponent a)) => a -> Float -> a mulp pixel x = colorMap (floor . (* x) . fromIntegral) pixel {-# INLINE mulp #-} -addp-  :: forall a. ( Pixel a-               , Bounded (PixelBaseComponent a)-               , Integral (PixelBaseComponent a)-               ) => a -> a -> a+addp ::+  forall a.+  ( Pixel a,+    Bounded (PixelBaseComponent a),+    Integral (PixelBaseComponent a)+  ) =>+  a ->+  a ->+  a addp = mixWith (const f)   where-    f x y = fromIntegral $-      (maxBound :: PixelBaseComponent a) `min` (fromIntegral x + fromIntegral y)+    f x y =+      fromIntegral $+        (maxBound :: PixelBaseComponent a) `min` (fromIntegral x + fromIntegral y) {-# INLINE addp #-} --- | Crop a given image. If supplied coordinates are greater than size of--- original image, image boundaries are used instead.--crop :: Pixel a-  => Int               -- ^ Index (X axis) of first pixel to include-  -> Int               -- ^ Index (Y axis) of first pixel to include-  -> Int               -- ^ Width of resulting image-  -> Int               -- ^ Height of resulting image-  -> Image a           -- ^ Original image-  -> Image a           -- ^ Cropped image+-- | Crop an image. If the supplied coordinates are greater than the size of+-- the image, the image boundaries are used instead.+crop ::+  Pixel a =>+  -- | Index (X axis) of first pixel to include+  Int ->+  -- | Index (Y axis) of first pixel to include+  Int ->+  -- | Width of resulting image+  Int ->+  -- | Height of resulting image+  Int ->+  -- | Original image+  Image a ->+  -- | Cropped image+  Image a crop x' y' w' h' img@Image {..} =   generateImage gen w h   where     gen i j = pixelAt img (x + i) (y + j)-    x = min (imageWidth  - 1) x'+    x = min (imageWidth - 1) x'     y = min (imageHeight - 1) y'-    w = min (imageWidth  - x) w'-    h = min (imageHeight  - y) h'+    w = min (imageWidth - x) w'+    h = min (imageHeight - y) h' {-# INLINEABLE crop #-}  -- | Flip an image horizontally.- flipHorizontally :: Pixel a => Image a -> Image a flipHorizontally img@Image {..} =   generateImage gen imageWidth imageHeight@@ -141,7 +151,6 @@ {-# INLINEABLE flipHorizontally #-}  -- | Flip an image vertically.- flipVertically :: Pixel a => Image a -> Image a flipVertically img@Image {..} =   generateImage gen imageWidth imageHeight@@ -150,7 +159,6 @@ {-# INLINEABLE flipVertically #-}  -- | Rotate an image to the left by 90°.- rotateLeft90 :: Pixel a => Image a -> Image a rotateLeft90 img@Image {..} =   generateImage gen imageHeight imageWidth@@ -159,7 +167,6 @@ {-# INLINEABLE rotateLeft90 #-}  -- | Rotate an image to the right by 90°.- rotateRight90 :: Pixel a => Image a -> Image a rotateRight90 img@Image {..} =   generateImage gen imageHeight imageWidth@@ -170,7 +177,6 @@ -- | Rotate an image by 180°, i.e flip both vertically and horizontally. -- -- @since 0.2.0- rotate180 :: Pixel a => Image a -> Image a rotate180 img@(Image w h _) = generateImage g w h   where@@ -181,7 +187,6 @@ -- are of differnet heights the smallest height is used. -- -- @since 0.2.0- beside :: Pixel a => [Image a] -> Image a beside = foldl1' go   where@@ -199,7 +204,6 @@ -- images are of differnet widths the smallest width is used. -- -- @since 0.2.0- below :: Pixel a => [Image a] -> Image a below = foldl1' go   where
JuicyPixels-extra.cabal view
@@ -1,72 +1,81 @@-name:                 JuicyPixels-extra-version:              0.4.1-cabal-version:        1.18-tested-with:          GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5-license:              BSD3-license-file:         LICENSE.md-author:               Mark Karpov <markkarpov92@gmail.com>-maintainer:           Mark Karpov <markkarpov92@gmail.com>-homepage:             https://github.com/mrkkrp/JuicyPixels-extra-bug-reports:          https://github.com/mrkkrp/JuicyPixels-extra/issues-category:             Graphics, Image-synopsis:             Efficiently scale, crop, flip images with JuicyPixels-build-type:           Simple-description:          Efficiently scale, crop, flip images with JuicyPixels.-extra-doc-files:      CHANGELOG.md-                    , README.md-data-files:           data-examples/*.png+cabal-version:   1.18+name:            JuicyPixels-extra+version:         0.5.0+license:         BSD3+license-file:    LICENSE.md+maintainer:      Mark Karpov <markkarpov92@gmail.com>+author:          Mark Karpov <markkarpov92@gmail.com>+tested-with:     ghc ==8.8.4 ghc ==8.10.4 ghc ==9.0.1+homepage:        https://github.com/mrkkrp/JuicyPixels-extra+bug-reports:     https://github.com/mrkkrp/JuicyPixels-extra/issues+synopsis:        Efficiently scale, crop, flip images with JuicyPixels+description:     Efficiently scale, crop, flip images with JuicyPixels.+category:        Graphics, Image+build-type:      Simple+data-files:      data-examples/*.png+extra-doc-files:+    CHANGELOG.md+    README.md  source-repository head-  type:               git-  location:           https://github.com/mrkkrp/JuicyPixels-extra.git+    type:     git+    location: https://github.com/mrkkrp/JuicyPixels-extra.git  flag dev-  description:        Turn on development settings.-  manual:             True-  default:            False+    description: Turn on development settings.+    default:     False+    manual:      True  library-  build-depends:      base              >= 4.9 && < 5-                    , JuicyPixels       >= 3.2.6.4 && < 3.4-  exposed-modules:    Codec.Picture.Extra-  if flag(dev)-    ghc-options:      -Wall -Werror-  else-    ghc-options:      -O2 -Wall-  if flag(dev)-    ghc-options:      -Wcompat-                      -Wincomplete-record-updates-                      -Wincomplete-uni-patterns-                      -Wnoncanonical-monad-instances-                      -Wnoncanonical-monadfail-instances-  default-language:   Haskell2010+    exposed-modules:  Codec.Picture.Extra+    default-language: Haskell2010+    build-depends:+        base >=4.13 && <5,+        JuicyPixels >=3.2.6.4 && <3.4 +    if flag(dev)+        ghc-options: -Wall -Werror++    else+        ghc-options: -O2 -Wall++    if flag(dev)+        ghc-options:+            -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns+            -Wnoncanonical-monad-instances+ test-suite tests-  main-is:            Spec.hs-  hs-source-dirs:     tests-  type:               exitcode-stdio-1.0-  build-depends:      base              >= 4.9 && < 5-                    , JuicyPixels       >= 3.2.6.4 && < 3.4-                    , JuicyPixels-extra-                    , hspec             >= 2.0-  build-tools:        hspec-discover    >= 2.0 && < 3.0-  other-modules:      Codec.Picture.ExtraSpec-  if flag(dev)-    ghc-options:      -Wall -Werror-  else-    ghc-options:      -O2 -Wall-  default-language:   Haskell2010+    type:             exitcode-stdio-1.0+    main-is:          Spec.hs+    build-tools:      hspec-discover >=2.0 && <3.0+    hs-source-dirs:   tests+    other-modules:    Codec.Picture.ExtraSpec+    default-language: Haskell2010+    build-depends:+        base >=4.13 && <5,+        JuicyPixels >=3.2.6.4 && <3.4,+        JuicyPixels-extra,+        hspec >=2.0 +    if flag(dev)+        ghc-options: -Wall -Werror++    else+        ghc-options: -O2 -Wall+ benchmark bench-  main-is:            Main.hs-  hs-source-dirs:     bench-  type:               exitcode-stdio-1.0-  build-depends:      base              >= 4.9 && < 5-                    , JuicyPixels       >= 3.2.6.4 && < 3.4-                    , JuicyPixels-extra-                    , criterion         >= 0.6.2.1 && < 1.6-  if flag(dev)-    ghc-options:      -O2 -Wall -Werror-  else-    ghc-options:      -O2 -Wall-  default-language:   Haskell2010+    type:             exitcode-stdio-1.0+    main-is:          Main.hs+    hs-source-dirs:   bench+    default-language: Haskell2010+    build-depends:+        base >=4.13 && <5,+        JuicyPixels >=3.2.6.4 && <3.4,+        JuicyPixels-extra,+        criterion >=0.6.2.1 && <1.6++    if flag(dev)+        ghc-options: -O2 -Wall -Werror++    else+        ghc-options: -O2 -Wall
LICENSE.md view
@@ -1,4 +1,4 @@-Copyright © 2016–2018 Mark Karpov+Copyright © 2016–present Mark Karpov  All rights reserved.
README.md view
@@ -4,13 +4,19 @@ [![Hackage](https://img.shields.io/hackage/v/JuicyPixels-extra.svg?style=flat)](https://hackage.haskell.org/package/JuicyPixels-extra) [![Stackage Nightly](http://stackage.org/package/JuicyPixels-extra/badge/nightly)](http://stackage.org/nightly/package/JuicyPixels-extra) [![Stackage LTS](http://stackage.org/package/JuicyPixels-extra/badge/lts)](http://stackage.org/lts/package/JuicyPixels-extra)-[![Build Status](https://travis-ci.org/mrkkrp/JuicyPixels-extra.svg?branch=master)](https://travis-ci.org/mrkkrp/JuicyPixels-extra)+![CI](https://github.com/mrkkrp/JuicyPixels-extra/workflows/CI/badge.svg?branch=master) -Missing primitives you shouldn't need to re-implement yourself. I think the-Haddocks are pretty self-explanatory, so head straight to them.+A collection of functions to scale, crop, flip images with JuicyPixels. +## Contribution++Issues, bugs, and questions may be reported in [the GitHub issue tracker for+this project](https://github.com/mrkkrp/JuicyPixels-extra/issues).++Pull requests are also welcome.+ ## License -Copyright © 2016–2019 Mark Karpov+Copyright © 2016–present Mark Karpov  Distributed under BSD 3 clause license.
bench/Main.hs view
@@ -5,49 +5,69 @@ import Criterion.Main  main :: IO ()-main = defaultMain-  [ bgroup "scaleBilinear"-    [ baction "512 × 512"   (scaleBilinear 512 512)   "data-examples/lenna.png"-    , baction "256 × 256"   (scaleBilinear 256 256)   "data-examples/lenna.png"-    , baction "1024 × 1024" (scaleBilinear 1024 1024) "data-examples/lenna.png" ]-  , bgroup "crop"-    [ baction "on 256 horizontally" (crop 256 0 256 512) "data-examples/lenna.png"-    , baction "on 265 vertically"   (crop 0 256 512 256) "data-examples/lenna.png" ]-  , bgroup "flipHorizontally"-    [ baction "512 × 512" flipHorizontally "data-examples/lenna.png"-    , baction "100 × 100" flipHorizontally "data-examples/lenna-scaled-down.png"+main =+  defaultMain+    [ bgroup+        "scaleBilinear"+        [ baction "512 × 512" (scaleBilinear 512 512) "data-examples/lenna.png",+          baction "256 × 256" (scaleBilinear 256 256) "data-examples/lenna.png",+          baction "1024 × 1024" (scaleBilinear 1024 1024) "data-examples/lenna.png"+        ],+      bgroup+        "crop"+        [ baction "on 256 horizontally" (crop 256 0 256 512) "data-examples/lenna.png",+          baction "on 265 vertically" (crop 0 256 512 256) "data-examples/lenna.png"+        ],+      bgroup+        "flipHorizontally"+        [ baction "512 × 512" flipHorizontally "data-examples/lenna.png",+          baction "100 × 100" flipHorizontally "data-examples/lenna-scaled-down.png"+        ],+      bgroup+        "flipVertically"+        [ baction "512 × 512" flipVertically "data-examples/lenna.png",+          baction "100 × 100" flipVertically "data-examples/lenna-scaled-down.png"+        ],+      bgroup+        "rotateLeft90"+        [ baction "512 × 512" rotateLeft90 "data-examples/lenna.png",+          baction "100 × 100" rotateLeft90 "data-examples/lenna-scaled-down.png"+        ],+      bgroup+        "rotateRight90"+        [ baction "512 × 512" rotateRight90 "data-examples/lenna.png",+          baction "100 × 100" rotateRight90 "data-examples/lenna-scaled-down.png"+        ],+      bgroup+        "rotate180"+        [ baction "512 × 512" rotate180 "data-examples/lenna.png",+          baction "100 × 100" rotate180 "data-examples/lenna-scaled-down.png"+        ],+      bgroup+        "beside"+        [ baction "1024 × 512" beside' "data-examples/lenna.png",+          baction "200 × 100" beside' "data-examples/lenna-scaled-down.png"+        ],+      bgroup+        "below"+        [ baction "512 × 1024" below' "data-examples/lenna.png",+          baction "100 × 200" below' "data-examples/lenna-scaled-down.png"+        ]     ]-  , bgroup "flipVertically"-    [ baction "512 × 512" flipVertically "data-examples/lenna.png"-    , baction "100 × 100" flipVertically "data-examples/lenna-scaled-down.png" ]-  , bgroup "rotateLeft90"-    [ baction "512 × 512" rotateLeft90 "data-examples/lenna.png"-    , baction "100 × 100" rotateLeft90 "data-examples/lenna-scaled-down.png" ]-  , bgroup "rotateRight90"-    [ baction "512 × 512" rotateRight90 "data-examples/lenna.png"-    , baction "100 × 100" rotateRight90 "data-examples/lenna-scaled-down.png" ]-  , bgroup "rotate180"-    [ baction "512 × 512" rotate180 "data-examples/lenna.png"-    , baction "100 × 100" rotate180 "data-examples/lenna-scaled-down.png" ]-  , bgroup "beside"-    [ baction "1024 × 512" beside' "data-examples/lenna.png"-    , baction "200 × 100"  beside' "data-examples/lenna-scaled-down.png" ]-  , bgroup "below"-    [ baction "512 × 1024" below' "data-examples/lenna.png"-    , baction "100 × 200"  below' "data-examples/lenna-scaled-down.png" ]-  ]   where     beside' img = beside [img, img]-    below'  img = below  [img, img]---- | Run a benchmark given function to benchmark and where to get image to--- pass as an input.+    below' img = below [img, img] -baction-  :: String            -- ^ Name of the benchmark-  -> (Image PixelRGB8 -> Image PixelRGB8) -- ^ Transformation to perform-  -> FilePath          -- ^ Where to get image to start with-  -> Benchmark+-- | Run a benchmark given a function to benchmark and where to get image to+-- pass as the input.+baction ::+  -- | Name of the benchmark+  String ->+  -- | The transformation to perform+  (Image PixelRGB8 -> Image PixelRGB8) ->+  -- | Where to get the image to start with+  FilePath ->+  Benchmark baction name f path = env getImg (bench name . nf f)   where     getImg = do
data-examples/lenna-scaled-up.png view

binary file changed (985586 → 985068 bytes)

tests/Codec/Picture/ExtraSpec.hs view
@@ -1,6 +1,7 @@ module Codec.Picture.ExtraSpec-  ( main-  , spec )+  ( main,+    spec,+  ) where  import Codec.Picture@@ -14,31 +15,34 @@  spec :: Spec spec = do-  describe "scaleBilinear"     scaleBilinearSpec-  describe "crop"              cropSpec-  describe "flipHorizontally"  flipHorizontallySpec-  describe "flipVertically"    flipVerticallySpec-  describe "rotateLeft90Spec"  rotateLeft90Spec+  describe "scaleBilinear" scaleBilinearSpec+  describe "crop" cropSpec+  describe "flipHorizontally" flipHorizontallySpec+  describe "flipVertically" flipVerticallySpec+  describe "rotateLeft90Spec" rotateLeft90Spec   describe "rotateRight90Spec" rotateRight90Spec-  describe "rotate180"         rotate180Spec-  describe "beside"            besideSpec-  describe "below"             belowSpec+  describe "rotate180" rotate180Spec+  describe "beside" besideSpec+  describe "below" belowSpec  scaleBilinearSpec :: Spec scaleBilinearSpec = do   context "when called with orginial dimensions" $     it "produces the same image" $-      checkWithFiles (scaleBilinear 512 512)+      checkWithFiles+        (scaleBilinear 512 512)         "data-examples/lenna.png"         "data-examples/lenna.png"   context "when we scale down" $     it "produces correct image" $-      checkWithFiles (scaleBilinear 100 100)+      checkWithFiles+        (scaleBilinear 100 100)         "data-examples/lenna.png"         "data-examples/lenna-scaled-down.png"   context "when we scale up" $     it "produces correct image" $-      checkWithFiles (scaleBilinear 600 600)+      checkWithFiles+        (scaleBilinear 600 600)         "data-examples/lenna.png"         "data-examples/lenna-scaled-up.png" @@ -46,12 +50,14 @@ cropSpec = do   context "when we pass arguments within image size (square)" $     it "produces correct image" $-      checkWithFiles (crop 211 210 178 191)+      checkWithFiles+        (crop 211 210 178 191)         "data-examples/lenna.png"         "data-examples/lenna-cropped.png"   context "when we pass arguments within image size (vertical)" $     it "produces correct image" $-      checkWithFiles (crop 0 512 512 512)+      checkWithFiles+        (crop 0 512 512 512)         "data-examples/lenna-below.png"         "data-examples/lenna.png" @@ -59,7 +65,8 @@ flipHorizontallySpec =   context "when we flip horizontally" $     it "produces correct image" $-      checkWithFiles flipHorizontally+      checkWithFiles+        flipHorizontally         "data-examples/lenna.png"         "data-examples/lenna-horizontal-flip.png" @@ -67,7 +74,8 @@ flipVerticallySpec =   context "when we flip vertically" $     it "produces correct image" $-      checkWithFiles flipVertically+      checkWithFiles+        flipVertically         "data-examples/lenna.png"         "data-examples/lenna-vertical-flip.png" @@ -75,7 +83,8 @@ rotateLeft90Spec =   context "when we rotate to the left by 90°" $     it "produces correct image" $-      checkWithFiles rotateLeft90+      checkWithFiles+        rotateLeft90         "data-examples/lenna.png"         "data-examples/lenna-left-rotated.png" @@ -83,7 +92,8 @@ rotateRight90Spec =   context "when we rotate to the right by 90°" $     it "produces correct image" $-      checkWithFiles rotateRight90+      checkWithFiles+        rotateRight90         "data-examples/lenna.png"         "data-examples/lenna-right-rotated.png" @@ -91,7 +101,8 @@ rotate180Spec =   context "when we rotate by 180°" $     it "produces correct image" $-      checkWithFiles rotate180+      checkWithFiles+        rotate180         "data-examples/lenna.png"         "data-examples/lenna-180-rotated.png" @@ -99,7 +110,8 @@ besideSpec =   context "when we place images beside each other" $     it "produces correct image" $-      checkWithFiles (\x -> beside [x,x])+      checkWithFiles+        (\x -> beside [x, x])         "data-examples/lenna.png"         "data-examples/lenna-beside.png" @@ -107,34 +119,35 @@ belowSpec =   context "when we place images below each other" $     it "produces correct image" $-      checkWithFiles (\x -> below [x,x])+      checkWithFiles+        (\x -> below [x, x])         "data-examples/lenna.png"         "data-examples/lenna-below.png" --- | Run given transforming function on image loaded from one file and--- compare resulting image with contents of another file.--checkWithFiles-  :: (Image PixelRGB8 -> Image PixelRGB8) -- ^ Transformation to test-  -> FilePath          -- ^ Where to get the original image-  -> FilePath          -- ^ Where to get image to compare with-  -> Expectation+-- | Run a transforming on the image loaded from a file and compare the+-- resulting image with the contents of another file.+checkWithFiles ::+  -- | Transformation to test+  (Image PixelRGB8 -> Image PixelRGB8) ->+  -- | Where to get the original image+  FilePath ->+  -- | Where to get the image to compare with+  FilePath ->+  Expectation checkWithFiles f opath fpath = do   (Right (ImageRGB8 original)) <- readImage opath-  (Right (ImageRGB8 result))   <- readImage fpath+  (Right (ImageRGB8 result)) <- readImage fpath   f original `blindlySatisfy` sameImage result --- | The same as 'shouldSatisfy', but doesn't care if its argument is+-- | The same as 'shouldSatisfy', but doesn't care if its argument is an -- instance of 'Show' or not.- blindlySatisfy :: a -> (a -> Bool) -> Expectation v `blindlySatisfy` p =   unless (p v) (expectationFailure "predicate failed") --- | Equality test for images.-+-- | The equality test for images. sameImage :: Image PixelRGB8 -> Image PixelRGB8 -> Bool sameImage a b =-  ((==) `on` imageWidth)  a b &&-  ((==) `on` imageHeight) a b &&-  ((==) `on` imageData)   a b+  ((==) `on` imageWidth) a b+    && ((==) `on` imageHeight) a b+    && ((==) `on` imageData) a b