diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/Codec/Picture/Extra.hs b/Codec/Picture/Extra.hs --- a/Codec/Picture/Extra.hs +++ b/Codec/Picture/Extra.hs @@ -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 -- 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 diff --git a/JuicyPixels-extra.cabal b/JuicyPixels-extra.cabal --- a/JuicyPixels-extra.cabal +++ b/JuicyPixels-extra.cabal @@ -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 -maintainer: Mark Karpov -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 +author: Mark Karpov +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 diff --git a/LICENSE.md b/LICENSE.md --- a/LICENSE.md +++ b/LICENSE.md @@ -1,4 +1,4 @@ -Copyright © 2016–2018 Mark Karpov +Copyright © 2016–present Mark Karpov All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -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 diff --git a/data-examples/lenna-scaled-up.png b/data-examples/lenna-scaled-up.png Binary files a/data-examples/lenna-scaled-up.png and b/data-examples/lenna-scaled-up.png differ diff --git a/tests/Codec/Picture/ExtraSpec.hs b/tests/Codec/Picture/ExtraSpec.hs --- a/tests/Codec/Picture/ExtraSpec.hs +++ b/tests/Codec/Picture/ExtraSpec.hs @@ -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