ExtraSpec.hs

{-# LANGUAGE FlexibleContexts #-}

module Codec.Picture.ExtraSpec
  ( main,
    spec,
  )
where

import Codec.Picture
import Codec.Picture.Extra
import Control.Monad
import Data.Function (on)
import Foreign (Storable)
import Test.Hspec

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
  describe "scaleBilinear" scaleBilinearSpec
  describe "crop" cropSpec
  describe "trim" trimSpec
  describe "flipHorizontally" flipHorizontallySpec
  describe "flipVertically" flipVerticallySpec
  describe "rotateLeft90Spec" rotateLeft90Spec
  describe "rotateRight90Spec" rotateRight90Spec
  describe "rotate180" rotate180Spec
  describe "beside" besideSpec
  describe "below" belowSpec
  describe "square" squareSpec

scaleBilinearSpec :: Spec
scaleBilinearSpec = do
  context "when called with orginial dimensions" $
    it "produces the same image" $
      checkWithFiles
        (scaleBilinear 512 512)
        "data-examples/macaque.png"
        "data-examples/macaque.png"
  context "when we scale down" $
    it "produces correct image" $
      checkWithFiles
        (scaleBilinear 100 100)
        "data-examples/macaque.png"
        "data-examples/macaque-scaled-down.png"
  context "when we scale up" $
    it "produces correct image" $
      checkWithFiles
        (scaleBilinear 600 600)
        "data-examples/macaque.png"
        "data-examples/macaque-scaled-up.png"
  context "when we scale to 1 width" $
    it "produces correct image" $
      checkWithFiles
        (scaleBilinear 1 512)
        "data-examples/macaque.png"
        "data-examples/macaque-width-1.png"
  context "when we scale to 1 height" $
    it "produces correct image" $
      checkWithFiles
        (scaleBilinear 512 1)
        "data-examples/macaque.png"
        "data-examples/macaque-height-1.png"
  context "when we scale to 0x0" $
    it "produces the empty image" $
      checkWithFiles
        (scaleBilinear 0 0)
        "data-examples/macaque.png"
        "data-examples/empty.png"

cropSpec :: Spec
cropSpec = do
  context "when we pass arguments within image size (square)" $
    it "produces correct image" $
      checkWithFiles
        (crop 211 210 178 191)
        "data-examples/macaque.png"
        "data-examples/macaque-cropped.png"
  context "when we pass arguments within image size (vertical)" $
    it "produces correct image" $
      checkWithFiles
        (crop 0 512 512 512)
        "data-examples/macaque-below.png"
        "data-examples/macaque.png"

trimSpec :: Spec
trimSpec = do
  context "when we pass an image without transparency" $
    it "does nothing" $
      checkWithFiles
        trim
        "data-examples/macaque.png"
        "data-examples/macaque.png"
  context "when passing an image with transparency" $ do
    it "does nothing if there are no fully transparent edges" $
      checkWithFilesAlpha
        trim
        "data-examples/macaque-transparent-cropped.png"
        "data-examples/macaque-transparent-cropped.png"
    it "removed the transparent edges" $
      checkWithFilesAlpha
        trim
        "data-examples/macaque-transparent.png"
        "data-examples/macaque-transparent-cropped.png"
  context "when passing a fully transparent image" $
    it "returns an empty image" $ do
      (Right (ImageRGBA8 original)) <- readImage "data-examples/fully-transparent.png"
      let trimmed = trim original
      imageWidth trimmed `shouldBe` 1
      imageHeight trimmed `shouldBe` 1

flipHorizontallySpec :: Spec
flipHorizontallySpec =
  context "when we flip horizontally" $
    it "produces correct image" $
      checkWithFiles
        flipHorizontally
        "data-examples/macaque.png"
        "data-examples/macaque-horizontal-flip.png"

flipVerticallySpec :: Spec
flipVerticallySpec =
  context "when we flip vertically" $
    it "produces correct image" $
      checkWithFiles
        flipVertically
        "data-examples/macaque.png"
        "data-examples/macaque-vertical-flip.png"

rotateLeft90Spec :: Spec
rotateLeft90Spec =
  context "when we rotate to the left by 90°" $
    it "produces correct image" $
      checkWithFiles
        rotateLeft90
        "data-examples/macaque.png"
        "data-examples/macaque-left-rotated.png"

rotateRight90Spec :: Spec
rotateRight90Spec =
  context "when we rotate to the right by 90°" $
    it "produces correct image" $
      checkWithFiles
        rotateRight90
        "data-examples/macaque.png"
        "data-examples/macaque-right-rotated.png"

rotate180Spec :: Spec
rotate180Spec =
  context "when we rotate by 180°" $
    it "produces correct image" $
      checkWithFiles
        rotate180
        "data-examples/macaque.png"
        "data-examples/macaque-180-rotated.png"

besideSpec :: Spec
besideSpec =
  context "when we place images beside each other" $
    it "produces correct image" $
      checkWithFiles
        (\x -> beside [x, x])
        "data-examples/macaque.png"
        "data-examples/macaque-beside.png"

belowSpec :: Spec
belowSpec =
  context "when we place images below each other" $
    it "produces correct image" $
      checkWithFiles
        (\x -> below [x, x])
        "data-examples/macaque.png"
        "data-examples/macaque-below.png"

squareSpec :: Spec
squareSpec = do
  context "when we pass an already square image" $ do
    it "does nothing" $
      checkWithFiles
        (square $ PixelRGB8 0 0 0)
        "data-examples/macaque.png"
        "data-examples/macaque.png"
    it "does nothing (alpha)" $
      checkWithFilesAlpha
        (square $ PixelRGBA8 0 0 0 0)
        "data-examples/macaque-transparent.png"
        "data-examples/macaque-transparent.png"
  context "when we pass a non-square image" $ do
    it "adds the required filler to wider than heigh image" $ do
      (Right (ImageRGB8 original)) <- readImage "data-examples/macaque-beside.png"
      let squared = square (PixelRGB8 0 0 0) original
      imageWidth squared `shouldBe` 1024
      imageHeight squared `shouldBe` 1024
    it "adds the required filler to higher than wide image" $ do
      (Right (ImageRGB8 original)) <- readImage "data-examples/macaque-below.png"
      let squared = square (PixelRGB8 0 0 0) original
      imageWidth squared `shouldBe` 1024
      imageHeight squared `shouldBe` 1024

-- | 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
  f original `blindlySatisfy` sameImage result

-- | `checkWithFiles` for images with an alpha channel.
checkWithFilesAlpha ::
  -- | Transformation to test
  (Image PixelRGBA8 -> Image PixelRGBA8) ->
  -- | Where to get the original image
  FilePath ->
  -- | Where to get the image to compare with
  FilePath ->
  Expectation
checkWithFilesAlpha f opath fpath = do
  (Right (ImageRGBA8 original)) <- readImage opath
  (Right (ImageRGBA8 result)) <- readImage fpath
  f original `blindlySatisfy` sameImage result

-- | 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")

-- | The equality test for images.
sameImage :: (Eq a, Eq (PixelBaseComponent a), Storable (PixelBaseComponent a)) => Image a -> Image a -> Bool
sameImage a b =
  ((==) `on` imageWidth) a b
    && ((==) `on` imageHeight) a b
    && ((==) `on` imageData) a b