diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # phash +## 0.1.4.6 + + * Add support for `.avif` images + ## 0.1.4.5 * Modest performance improvements diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,5 @@ # phash -[![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/perceptual-hash/badge)](https://matrix.hackage.haskell.org/package/perceptual-hash) -[![Hackage](https://img.shields.io/hackage/v/perceptual-hash.svg)](http://hackage.haskell.org/package/perceptual-hash) -[![Dependencies of latest version on Hackage](https://img.shields.io/hackage-deps/v/perceptual-hash.svg)](https://hackage.haskell.org/package/perceptual-hash) - This is a Haskell [library](http://hackage.haskell.org/package/perceptual-hash) to detect (potential) duplicate images. @@ -49,45 +45,99 @@ ### Performance -This library has similar performance to the pHash library for PNG -images. +This library has performs better on WebP, AVIF images and worse on JPEG images compared to the pHash library. ``` benchmarking fileHash/cat.png -time 20.67 ms (20.60 ms .. 20.78 ms) +time 21.50 ms (21.23 ms .. 21.70 ms) 1.000 R² (0.999 R² .. 1.000 R²) -mean 20.84 ms (20.76 ms .. 21.01 ms) -std dev 246.3 μs (149.5 μs .. 396.7 μs) +mean 21.54 ms (21.39 ms .. 21.88 ms) +std dev 525.3 μs (224.2 μs .. 946.8 μs) benchmarking fileHash/frog.jpeg -time 17.82 ms (17.62 ms .. 18.05 ms) - 0.999 R² (0.999 R² .. 1.000 R²) -mean 17.54 ms (17.45 ms .. 17.65 ms) -std dev 272.3 μs (194.9 μs .. 369.3 μs) +time 21.33 ms (20.57 ms .. 22.01 ms) + 0.997 R² (0.996 R² .. 0.999 R²) +mean 19.84 ms (19.53 ms .. 20.24 ms) +std dev 822.7 μs (654.3 μs .. 1.070 ms) +variance introduced by outliers: 13% (moderately inflated) benchmarking fileHash/frog.png -time 12.02 ms (11.95 ms .. 12.11 ms) - 1.000 R² (0.999 R² .. 1.000 R²) -mean 12.08 ms (12.04 ms .. 12.13 ms) -std dev 115.0 μs (90.79 μs .. 144.7 μs) +time 12.31 ms (11.88 ms .. 12.66 ms) + 0.997 R² (0.994 R² .. 0.999 R²) +mean 12.46 ms (12.34 ms .. 12.58 ms) +std dev 314.3 μs (256.0 μs .. 385.0 μs) +benchmarking fileHash/liz-taylor.webp +time 69.02 ms (68.00 ms .. 70.23 ms) + 0.999 R² (0.997 R² .. 1.000 R²) +mean 71.69 ms (70.28 ms .. 74.98 ms) +std dev 3.688 ms (1.345 ms .. 6.107 ms) +variance introduced by outliers: 16% (moderately inflated) + +benchmarking fileHash/liz-taylor.png +time 72.32 ms (70.35 ms .. 74.49 ms) + 0.998 R² (0.996 R² .. 1.000 R²) +mean 73.83 ms (72.60 ms .. 75.38 ms) +std dev 2.414 ms (1.655 ms .. 3.614 ms) + +benchmarking fileHash/fashion.png +time 142.0 ms (131.6 ms .. 153.4 ms) + 0.997 R² (0.991 R² .. 1.000 R²) +mean 145.8 ms (142.0 ms .. 153.9 ms) +std dev 7.690 ms (2.694 ms .. 11.43 ms) +variance introduced by outliers: 13% (moderately inflated) + +benchmarking fileHash/fashion.avif +time 172.2 ms (161.5 ms .. 187.6 ms) + 0.996 R² (0.991 R² .. 1.000 R²) +mean 175.1 ms (169.3 ms .. 185.3 ms) +std dev 12.16 ms (5.052 ms .. 18.42 ms) +variance introduced by outliers: 13% (moderately inflated) + benchmarking foreignHash/cat.png -time 18.86 ms (18.79 ms .. 18.97 ms) - 1.000 R² (1.000 R² .. 1.000 R²) -mean 18.92 ms (18.87 ms .. 18.99 ms) -std dev 149.7 μs (129.0 μs .. 183.6 μs) +time 21.06 ms (20.88 ms .. 21.19 ms) + 1.000 R² (0.999 R² .. 1.000 R²) +mean 20.94 ms (20.80 ms .. 21.06 ms) +std dev 320.2 μs (225.5 μs .. 418.3 μs) benchmarking foreignHash/frog.jpeg -time 8.533 ms (8.480 ms .. 8.574 ms) - 1.000 R² (0.999 R² .. 1.000 R²) -mean 8.686 ms (8.644 ms .. 8.745 ms) -std dev 129.0 μs (97.99 μs .. 164.8 μs) +time 9.255 ms (9.168 ms .. 9.378 ms) + 0.999 R² (0.999 R² .. 1.000 R²) +mean 9.234 ms (9.201 ms .. 9.273 ms) +std dev 94.68 μs (79.14 μs .. 120.7 μs) benchmarking foreignHash/frog.png -time 9.697 ms (9.649 ms .. 9.735 ms) +time 10.37 ms (10.28 ms .. 10.47 ms) + 0.999 R² (0.999 R² .. 1.000 R²) +mean 10.42 ms (10.37 ms .. 10.48 ms) +std dev 135.4 μs (106.5 μs .. 184.9 μs) + +benchmarking foreignHash/liz-taylor.webp +time 368.7 ms (352.4 ms .. 391.1 ms) + 1.000 R² (0.999 R² .. 1.000 R²) +mean 362.3 ms (357.6 ms .. 366.4 ms) +std dev 5.133 ms (1.154 ms .. 6.530 ms) +variance introduced by outliers: 19% (moderately inflated) + +benchmarking foreignHash/liz-taylor.png +time 71.58 ms (71.12 ms .. 72.03 ms) 1.000 R² (1.000 R² .. 1.000 R²) -mean 9.746 ms (9.717 ms .. 9.775 ms) -std dev 84.08 μs (70.14 μs .. 97.91 μs) +mean 71.84 ms (71.66 ms .. 72.24 ms) +std dev 502.0 μs (339.8 μs .. 710.2 μs) + +benchmarking foreignHash/fashion.png +time 162.1 ms (160.6 ms .. 162.8 ms) + 1.000 R² (1.000 R² .. 1.000 R²) +mean 163.4 ms (162.9 ms .. 164.3 ms) +std dev 990.0 μs (544.6 μs .. 1.476 ms) +variance introduced by outliers: 12% (moderately inflated) + +benchmarking foreignHash/fashion.avif +time 705.5 ms (669.6 ms .. 757.2 ms) + 0.999 R² (0.998 R² .. 1.000 R²) +mean 716.4 ms (710.3 ms .. 728.3 ms) +std dev 11.54 ms (1.129 ms .. 13.84 ms) +variance introduced by outliers: 19% (moderately inflated) ``` ### Foreign Library diff --git a/app/Parallel.cpphs b/app/Parallel.cpphs deleted file mode 100644 --- a/app/Parallel.cpphs +++ /dev/null @@ -1,54 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} - -module Parallel ( pathMaps ) where - -import Control.Concurrent.STM (atomically) -import Control.Concurrent.STM.TVar (TVar, modifyTVar', newTVarIO, readTVarIO) -import Data.Functor (($>)) -import Data.List.NonEmpty (NonEmpty (..), (<|)) -import qualified Data.Map as M -import Data.Word (Word64) -import PerceptualHash (fileHash) -import System.Directory.Parallel (parTraverseAll) -import System.FilePath (takeExtension) - -imgExtension :: String -> Bool -imgExtension ".jpg" = True -imgExtension ".jpeg" = True -imgExtension ".png" = True -imgExtension ".gif" = True -imgExtension ".hdr" = True -imgExtension ".pic" = True -imgExtension ".bmp" = True -imgExtension ".TGA" = True -imgExtension ".tga" = True -imgExtension ".tif" = True -imgExtension ".tiff" = True -#ifdef WEBP -imgExtension ".webp" = True -#endif -imgExtension _ = False - -insertHash :: FilePath -> IO (M.Map Word64 (NonEmpty FilePath) -> M.Map Word64 (NonEmpty FilePath)) -insertHash fp = do - hash <- fileHash fp - case hash of - Right x -> - pure $ \hashes -> - let go (Just others) = Just (fp <| others) - go Nothing = Just (fp :| []) - in M.alter go x hashes - Left err -> putStrLn ("WARNING: skipping " ++ fp ++ "\n" ++ err) $> id - -stepMap :: TVar (M.Map Word64 (NonEmpty FilePath)) -> FilePath -> IO () -stepMap var fp = do - mod' <- insertHash fp - atomically $ modifyTVar' var mod' - -pathMaps :: [FilePath] -> IO (M.Map Word64 (NonEmpty FilePath)) -pathMaps fps = do - total <- newTVarIO mempty - parTraverseAll (stepMap total) fileFilter (\_ -> pure True) fps - readTVarIO total - - where fileFilter = pure . imgExtension . takeExtension diff --git a/app/Parallel.hs b/app/Parallel.hs new file mode 100644 --- /dev/null +++ b/app/Parallel.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Parallel ( pathMaps ) where + +import Control.Concurrent.STM (atomically) +import Control.Concurrent.STM.TVar (TVar, modifyTVar', newTVarIO, readTVarIO) +import Data.Functor (($>)) +import Data.List.NonEmpty (NonEmpty (..), (<|)) +import qualified Data.Map as M +import Data.Word (Word64) +import PerceptualHash (fileHash) +import System.Directory.Parallel (parTraverseAll) +import System.FilePath (takeExtension) + +imgExtension :: String -> Bool +imgExtension ".jpg" = True +imgExtension ".jpeg" = True +imgExtension ".png" = True +imgExtension ".gif" = True +imgExtension ".hdr" = True +imgExtension ".pic" = True +imgExtension ".bmp" = True +imgExtension ".TGA" = True +imgExtension ".tga" = True +imgExtension ".tif" = True +imgExtension ".tiff" = True +imgExtension ".webp" = True +imgExtension ".avif" = True +imgExtension _ = False + +insertHash :: FilePath -> IO (M.Map Word64 (NonEmpty FilePath) -> M.Map Word64 (NonEmpty FilePath)) +insertHash fp = do + hash <- fileHash fp + case hash of + Right x -> + pure $ \hashes -> + let go (Just others) = Just (fp <| others) + go Nothing = Just (fp :| []) + in M.alter go x hashes + Left err -> putStrLn ("WARNING: skipping " ++ fp ++ "\n" ++ err) $> id + +stepMap :: TVar (M.Map Word64 (NonEmpty FilePath)) -> FilePath -> IO () +stepMap var fp = do + mod' <- insertHash fp + atomically $ modifyTVar' var mod' + +pathMaps :: [FilePath] -> IO (M.Map Word64 (NonEmpty FilePath)) +pathMaps fps = do + total <- newTVarIO mempty + parTraverseAll (stepMap total) fileFilter (\_ -> pure True) fps + readTVarIO total + + where fileFilter = pure . imgExtension . takeExtension diff --git a/bench/Bench.cpphs b/bench/Bench.cpphs --- a/bench/Bench.cpphs +++ b/bench/Bench.cpphs @@ -9,7 +9,7 @@ import System.FilePath (takeFileName) mkBGroup :: NFData a => String -> (FilePath -> IO a) -> Benchmark -mkBGroup str f = bgroup str (toBench <$> [catPath, frogJpeg, frogPng, lizTaylorWebp, lizTaylorPng]) +mkBGroup str f = bgroup str (toBench <$> [catPath, frogJpeg, frogPng, lizTaylorWebp, lizTaylorPng, fashionPng, fashionAvif]) where toBench fp = bench (takeFileName fp) $ nfIO (f fp) catPath = "demo-data/cat.png" @@ -17,6 +17,8 @@ frogPng = "demo-data/frog.png" lizTaylorWebp = "demo-data/liz-taylor.webp" lizTaylorPng = "demo-data/liz-taylor.png" + fashionPng = "demo-data/fashion.png" + fashionAvif = "demo-data/fashion.avif" main :: IO () main = diff --git a/demo-data/fashion.avif b/demo-data/fashion.avif new file mode 100644 Binary files /dev/null and b/demo-data/fashion.avif differ diff --git a/demo-data/fashion.png b/demo-data/fashion.png new file mode 100644 Binary files /dev/null and b/demo-data/fashion.png differ diff --git a/perceptual-hash.cabal b/perceptual-hash.cabal --- a/perceptual-hash.cabal +++ b/perceptual-hash.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: perceptual-hash -version: 0.1.4.5 +version: 0.1.4.6 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2019-2021 Vanessa McHale @@ -18,6 +18,8 @@ demo-data/meme-watermark.jpg demo-data/liz-taylor.webp demo-data/liz-taylor.png + demo-data/fashion.avif + demo-data/fashion.png extra-source-files: include/hs_phash.h extra-doc-files: @@ -44,7 +46,6 @@ library exposed-modules: PerceptualHash - build-tool-depends: cpphs:cpphs hs-source-dirs: src other-modules: Median default-language: Haskell2010 @@ -57,19 +58,15 @@ vector, primitive, bytestring, - JuicyPixels - - if !flag(disable-webp) - build-depends: webp - - if !flag(disable-webp) - cpp-options: -DWEBP + JuicyPixels, + avif, + webp >=0.1.0.3 if flag(llvm) ghc-options: -fllvm if flag(with-phash) - pkgconfig-depends: pHash + extra-libraries: pHash if flag(with-phash) exposed-modules: ForeignHash @@ -115,7 +112,6 @@ executable phash main-is: Main.hs - build-tool-depends: cpphs:cpphs hs-source-dirs: app other-modules: Paths_perceptual_hash @@ -152,7 +148,6 @@ test-suite perceptual-hash-test type: exitcode-stdio-1.0 main-is: Spec.hs - build-tool-depends: cpphs:cpphs hs-source-dirs: test default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-N -K1K" diff --git a/src/PerceptualHash.cpphs b/src/PerceptualHash.cpphs deleted file mode 100644 --- a/src/PerceptualHash.cpphs +++ /dev/null @@ -1,110 +0,0 @@ -{-# OPTIONS_GHC -fspecialize-aggressively #-} - -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeFamilies #-} - -module PerceptualHash ( imgHash - , fileHash - , hammingDistance - ) where - -import qualified Codec.Picture as JuicyPixels -#ifdef WEBP -import Codec.Picture.WebP (decodeRgb8) -#endif -import Control.Monad.ST (runST) -import Data.Bits (Bits, popCount, shiftL, xor, (.|.)) -import qualified Data.ByteString as BS -import Data.List (isSuffixOf) -import qualified Data.Vector.Generic as V -import qualified Data.Vector.Storable as VS -import Data.Word (Word64, Word8) -import Graphics.Image (Array, Bilinear (..), Border (Edge, Reflect), Image, - Pixel (PixelX, PixelY), RGB, RSU (..), VS, X, Y, - convert, convolve, crop, makeImage, readImage, - resize, transpose, (|*|)) -import Graphics.Image.Interface (fromVector, toVector) -import qualified Graphics.Image.Interface as Hip -import Graphics.Image.Interface.Repa (fromRepaArrayS, toRepaArray) -import Median (median) - --- | See --- [wiki](https://en.wikipedia.org/wiki/Hamming_distance#Algorithm_example). --- --- @since 0.1.4.0 -{-# SPECIALIZE hammingDistance :: Word64 -> Word64 -> Int #-} -hammingDistance :: Bits a => a -> a -> Int -hammingDistance x y = popCount (x `xor` y) - -dct32 :: (Floating e, Array arr Y e) => Image arr Y e -dct32 = makeImage (32,32) gen - where gen (i,j) = PixelY $ sqrt(2/n) * cos((fromIntegral ((2*i) * (j-1)) * pi)/(2*n)) - n = 32 - -idMat :: (Fractional e, Array arr X e) => Image arr X e -idMat = makeImage (7,7) (\_ -> PixelX (1/49)) - -{-# INLINE meanFilter #-} -meanFilter :: (Fractional e, Array arr X e, Array arr cs e) => Image arr cs e -> Image arr cs e -meanFilter = {-# SCC "meanFilter" #-} convolve Reflect idMat - -{-# INLINE size32 #-} -size32 :: Array arr cs e => Image arr cs e -> Image arr cs e -size32 = resize Bilinear Edge (32,32) - -crop8 :: Array arr cs e => Image arr cs e -> Image arr cs e -crop8 = crop (0,0) (8,8) - -medianImmut :: (Ord e, Fractional e, V.Vector v e) => v e -> e -medianImmut v = runST $ - median =<< V.thaw v - -dct :: (Floating e, Array arr Y e) => Image arr Y e -> Image arr Y e -dct img = dct32 |*| img |*| transpose dct32 - -{-# INLINE imgHash #-} --- | DCT based hash. See --- [Zauner](https://www.phash.org/docs/pubs/thesis_zauner.pdf). --- --- It is suggested that you use this with the Repa backend. -imgHash :: (Ord e, Floating e, Array arr Y e, Array arr X e, V.Vector (Hip.Vector arr) Bool, V.Vector (Hip.Vector arr) e) => Image arr Y e -> Word64 -imgHash = asWord64 . aboveMed . V.map (\(PixelY x) -> x) . toVector . crop8 . dct . size32 . meanFilter - -asWord64 :: V.Vector v Bool => v Bool -> Word64 -asWord64 = V.foldl' (\acc x -> (acc `shiftL` 1) .|. boolToWord64 x) 0 - where boolToWord64 :: Bool -> Word64 - boolToWord64 False = 0 - boolToWord64 True = 1 - -aboveMed :: (Fractional e, V.Vector v e, V.Vector v Bool, Ord e) => v e -> v Bool -aboveMed v = - let med = medianImmut v - in V.map ( IO (Image VS RGB Word8) -fileWebp fp = do - contents <- BS.readFile fp - let (JuicyPixels.Image m n pixels) = decodeRgb8 contents - pure $ fromVector (m, n) $ VS.unsafeCast pixels - -{-# INLINE readWebp #-} -readWebp :: FilePath -> IO (Image VS Y Double) -readWebp = fmap convert . fileWebp - -fileHashWebp :: FilePath -> IO Word64 -fileHashWebp = fmap (imgHash . convRepa) . readWebp - -- faster - where convRepa = fromRepaArrayS . toRepaArray - -fileHash :: FilePath -> IO (Either String Word64) -fileHash fp | ".webp" `isSuffixOf` fp = pure <$> fileHashWebp fp - | otherwise = fileHashHip fp -#else -fileHash :: FilePath -> IO (Either String Word64) -fileHash = fileHashHip -#endif - -fileHashHip :: FilePath -> IO (Either String Word64) -fileHashHip = fmap (fmap (imgHash :: Image RSU Y Double -> Word64)) . readImage diff --git a/src/PerceptualHash.hs b/src/PerceptualHash.hs new file mode 100644 --- /dev/null +++ b/src/PerceptualHash.hs @@ -0,0 +1,118 @@ +{-# OPTIONS_GHC -fspecialize-aggressively #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} + +module PerceptualHash ( imgHash + , fileHash + , hammingDistance + ) where + +import Codec.Avif (decode) +import qualified Codec.Picture as JuicyPixels +import Codec.Picture.WebP (decodeRgb8) +import Control.Monad.ST (runST) +import Data.Bits (Bits, popCount, shiftL, xor, (.|.)) +import qualified Data.ByteString as BS +import Data.List (isSuffixOf) +import qualified Data.Vector.Generic as V +import qualified Data.Vector.Storable as VS +import Data.Word (Word64, Word8) +import Graphics.Image (Array, Bilinear (..), Border (Edge, Reflect), Image, + Pixel (PixelX, PixelY), RGB, RGBA, RSU (..), VS, X, + Y, convert, convolve, crop, makeImage, readImage, + resize, transpose, (|*|)) +import Graphics.Image.Interface (fromVector, toVector) +import qualified Graphics.Image.Interface as Hip +import Graphics.Image.Interface.Repa (fromRepaArrayS, toRepaArray) +import Median (median) + +-- | See +-- [wiki](https://en.wikipedia.org/wiki/Hamming_distance#Algorithm_example). +-- +-- @since 0.1.4.0 +{-# SPECIALIZE hammingDistance :: Word64 -> Word64 -> Int #-} +hammingDistance :: Bits a => a -> a -> Int +hammingDistance x y = popCount (x `xor` y) + +dct32 :: (Floating e, Array arr Y e) => Image arr Y e +dct32 = makeImage (32,32) gen + where gen (i,j) = PixelY $ sqrt(2/n) * cos((fromIntegral (i * (j-1)) * pi)/n) + n = 32 + +idMat :: (Fractional e, Array arr X e) => Image arr X e +idMat = makeImage (7,7) (\_ -> PixelX (1/49)) + +{-# INLINE meanFilter #-} +meanFilter :: (Fractional e, Array arr X e, Array arr cs e) => Image arr cs e -> Image arr cs e +meanFilter = {-# SCC "meanFilter" #-} convolve Reflect idMat + +{-# INLINE size32 #-} +size32 :: Array arr cs e => Image arr cs e -> Image arr cs e +size32 = resize Bilinear Edge (32,32) + +crop8 :: Array arr cs e => Image arr cs e -> Image arr cs e +crop8 = crop (0,0) (8,8) + +medianImmut :: (Ord e, Fractional e, V.Vector v e) => v e -> e +medianImmut v = runST $ + median =<< V.thaw v + +dct :: (Floating e, Array arr Y e) => Image arr Y e -> Image arr Y e +dct img = dct32 |*| img |*| transpose dct32 + +{-# INLINE imgHash #-} +-- | DCT based hash. See +-- [Zauner](https://www.phash.org/docs/pubs/thesis_zauner.pdf). +-- +-- It is suggested that you use this with the Repa backend. +imgHash :: (Ord e, Floating e, Array arr Y e, Array arr X e, V.Vector (Hip.Vector arr) Bool, V.Vector (Hip.Vector arr) e) => Image arr Y e -> Word64 +imgHash = asWord64 . aboveMed . V.map (\(PixelY x) -> x) . toVector . crop8 . dct . size32 . meanFilter + +asWord64 :: V.Vector v Bool => v Bool -> Word64 +asWord64 = V.foldl' (\acc x -> (acc `shiftL` 1) .|. boolToWord64 x) 0 + where boolToWord64 :: Bool -> Word64 + boolToWord64 False = 0 + boolToWord64 True = 1 + +aboveMed :: (Fractional e, V.Vector v e, V.Vector v Bool, Ord e) => v e -> v Bool +aboveMed v = + let med = medianImmut v + in V.map ( IO (Image VS RGB Word8) +fileWebp fp = do + contents <- BS.readFile fp + let (JuicyPixels.Image m n pixels) = decodeRgb8 contents + pure $ fromVector (n, m) $ VS.unsafeCast pixels + +{-# INLINE readWebp #-} +readWebp :: FilePath -> IO (Image VS Y Double) +readWebp = fmap convert . fileWebp + +fileHashWebp :: FilePath -> IO Word64 +fileHashWebp = fmap (imgHash . convRepa) . readWebp + -- faster + where convRepa = fromRepaArrayS . toRepaArray + +fileHash :: FilePath -> IO (Either String Word64) +fileHash fp | ".webp" `isSuffixOf` fp = pure <$> fileHashWebp fp + | ".avif" `isSuffixOf` fp = pure <$> fileHashAvif fp + | otherwise = fileHashHip fp + +{-# INLINE readAvif #-} +readAvif :: FilePath -> IO (Image VS Y Double) +readAvif = fmap convert . fileAvif + +fileHashAvif :: FilePath -> IO Word64 +fileHashAvif = fmap (imgHash . convRepa) . readAvif + where convRepa = fromRepaArrayS . toRepaArray + +{-# INLINE fileAvif #-} +fileAvif :: FilePath -> IO (Image VS RGBA Word8) +fileAvif fp = do + (JuicyPixels.Image m n pixels) <- decode <$> BS.readFile fp + pure $ fromVector (n, m) $ VS.unsafeCast pixels + +fileHashHip :: FilePath -> IO (Either String Word64) +fileHashHip = fmap (fmap (imgHash :: Image RSU Y Double -> Word64)) . readImage diff --git a/test/Spec.cpphs b/test/Spec.cpphs deleted file mode 100644 --- a/test/Spec.cpphs +++ /dev/null @@ -1,28 +0,0 @@ -import PerceptualHash (fileHash) -import Test.Hspec - -main :: IO () -main = hspec $ - describe "fileHash" $ do - - parallel $ it "should match when same" $ do - actual <- fileHash "demo-data/frog.jpeg" - expected <- fileHash "demo-data/frog.png" - actual `shouldBe` expected - - parallel $ it "should match when same" $ do - actual <- fileHash "demo-data/meme-watermark.jpg" - expected <- fileHash "demo-data/meme.png" - actual `shouldBe` expected - - parallel $ it "should not match when different" $ do - actual <- fileHash "demo-data/cat.png" - expected <- fileHash "demo-data/frog.png" - actual `shouldSatisfy` (/= expected) - -#ifdef WEBP - parallel $ it "should match when same" $ do - actual <- fileHash "demo-data/liz-taylor.webp" - expected <- fileHash "demo-data/liz-taylor.png" - actual `shouldBe` expected -#endif diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,31 @@ +import PerceptualHash (fileHash) +import Test.Hspec + +main :: IO () +main = hspec $ + describe "fileHash" $ do + + parallel $ it "should match when same" $ do + actual <- fileHash "demo-data/frog.jpeg" + expected <- fileHash "demo-data/frog.png" + actual `shouldBe` expected + + parallel $ it "should match when same" $ do + actual <- fileHash "demo-data/meme-watermark.jpg" + expected <- fileHash "demo-data/meme.png" + actual `shouldBe` expected + + parallel $ it "should not match when different" $ do + actual <- fileHash "demo-data/cat.png" + expected <- fileHash "demo-data/frog.png" + actual `shouldSatisfy` (/= expected) + + parallel $ it "should match when same" $ do + actual <- fileHash "demo-data/fashion.avif" + expected <- fileHash "demo-data/fashion.png" + actual `shouldBe` expected + + parallel $ it "should match when same" $ do + actual <- fileHash "demo-data/liz-taylor.webp" + expected <- fileHash "demo-data/liz-taylor.png" + actual `shouldBe` expected