sydtest-webdriver-screenshot 0.0.0.2 → 0.1.0.0

raw patch · 2 files changed

+67/−11 lines, 2 filesdep +vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: vector

API changes (from Hackage documentation)

Files

• src/Test/Syd/Webdriver/Screenshot.hs +64/−9
• sydtest-webdriver-screenshot.cabal +3/−2

@@ -13,10 +13,12 @@ module Test.Syd.Webdriver.Screenshot where  import Codec.Picture as Picture+import Codec.Picture.Types (createMutableImage, mutableImageData) import Control.Monad import Control.Monad.Reader import qualified Data.ByteString as SB import qualified Data.ByteString.Lazy as LB+import qualified Data.Vector.Storable as Vector import Path import Path.IO import System.Exit@@ -57,11 +59,13 @@       goldenTestProduce = do         image <- normaliseImage contents         relFile <- parseRelFile fp+         tempDir <- resolveDir' "screenshot-comparison"         let tempFile = tempDir </> relFile         ensureDir $ parent tempFile         -- Write it to a file so we can compare it if it differs.         writePng (fromAbsFile tempFile) image+         pure $           Screenshot             { screenshotFile = tempFile,@@ -75,16 +79,67 @@         writePng (fromAbsFile resolvedFile) actual,       goldenTestCompare = \(Screenshot actualPath actual) (Screenshot expectedPath expected) ->         if actual == expected-          then Nothing-          else-            Just $-              ExpectationFailed $-                unlines-                  [ "Screenshots differ.",-                    "expected: " <> fromAbsFile expectedPath,-                    "actual: " <> fromAbsFile actualPath-                  ]+          then pure Nothing+          else do+            tempDir <- resolveDir' "screenshot-comparison"+            relFile <- parseRelFile fp+            diffRelFile <- replaceExtension ".diff" relFile >>= addExtension ".png"+            let diffFile = tempDir </> diffRelFile+            ensureDir $ parent diffFile+            writePng (fromAbsFile diffFile) (computeImageDiff actual expected)+            pure $+              Just $+                ExpectationFailed $+                  unlines+                    [ "Screenshots differ.",+                      "expected: " <> fromAbsFile expectedPath,+                      "actual: " <> fromAbsFile actualPath,+                      "diff: " <> fromAbsFile diffFile,+                      "similarity: " <> show (imageSimilarity actual expected)+                    ]     }++imageSimilarity :: Image PixelRGB8 -> Image PixelRGB8 -> Double+imageSimilarity actual expected =+  let width = max (imageWidth actual) (imageWidth expected)+      height = max (imageHeight actual) (imageHeight expected)+   in (/ fromIntegral (height * width)) $+        sum $+          flip map [0 .. width - 1] $ \w ->+            sum $+              flip map [0 .. height - 1] $ \h ->+                let actualPixel = pixelAt actual w h+                    expectedPixel = pixelAt expected w h+                 in diffPixel actualPixel expectedPixel++diffPixel :: PixelRGB8 -> PixelRGB8 -> Double+diffPixel (PixelRGB8 r1 g1 b1) (PixelRGB8 r2 g2 b2) =+  if and [r1 == r2, g1 == g2, b1 == b2]+    then 1+    else 0++computeImageDiff :: Image PixelRGB8 -> Image PixelRGB8 -> Image PixelRGB8+computeImageDiff actual expected =+  let width = max (imageWidth actual) (imageWidth expected)+      height = max (imageHeight actual) (imageHeight expected)+   in Image+        { imageWidth = width,+          imageHeight = height,+          imageData = Vector.create $ do+            mutableImage <- createMutableImage width height (PixelRGB8 0 0 0)+            forM_ [0 .. width - 1] $ \w ->+              forM_ [0 .. height - 1] $ \h -> do+                let actualPixel = pixelAt actual w h+                    expectedPixel = pixelAt expected w h+                writePixel mutableImage w h (computePixelDiff actualPixel expectedPixel)+            pure $ mutableImageData mutableImage+        }++computePixelDiff :: PixelRGB8 -> PixelRGB8 -> PixelRGB8+computePixelDiff (PixelRGB8 r1 g1 b1) (PixelRGB8 r2 g2 b2) =+  if or [r1 /= r2, g1 /= g2, b1 /= b2]+    then PixelRGB8 0 255 0+    else PixelRGB8 0 0 0  debugScreenshot :: FilePath -> WebdriverTestM app () debugScreenshot fp = do

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack  name:           sydtest-webdriver-screenshot-version:        0.0.0.2+version:        0.1.0.0 synopsis:       A webdriver screenshot companion library for sydtest category:       Testing author:         Tom Sydney Kerckhove@@ -34,6 +34,7 @@     , path-io     , sydtest     , sydtest-webdriver+    , vector     , webdriver   default-language: Haskell2010