perceptual-hash 0.1.2.0 → 0.1.3.0

raw patch · 7 files changed

+72/−13 lines, 7 filesdep +deepseqdep ~basenew-component:flib:hsphash

Dependencies added: deepseq

Dependency ranges changed: base

Files

• CHANGELOG.md +6/−0
• README.md +1/−1
• app/Parallel.hs +19/−5
• bench/Bench.cpphs +2/−2
• foreign-src/Export.hs +14/−0
• perceptual-hash.cabal +27/−2
• src/PerceptualHash.hs +3/−3

@@ -1,5 +1,11 @@ # phash +## 0.1.3.0++  * CLI tool now supports several more image formats+  * `--debug` flag more useful+  * `fileHash` now returns an `Either String`+ ## 0.1.2.0    * Add `demo-data` field so tests don't fail

@@ -39,5 +39,5 @@ [GHC](https://www.haskell.org/ghc/download.html). Then:  ```-cabal new-install perceptual-hash+cabal install perceptual-hash -w ghc-8.6.5 ```

@@ -1,7 +1,10 @@+{-# 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)@@ -13,15 +16,26 @@ imgExtension ".jpg"  = True imgExtension ".jpeg" = True imgExtension ".png"  = True-imgExtension _       = False -- gif doesn't work with CImg AFAICT+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 _       = False  insertHash :: FilePath -> IO (M.Map Word64 (NonEmpty FilePath) -> M.Map Word64 (NonEmpty FilePath)) insertHash fp = do     hash <- fileHash fp-    pure $ \hashes ->-        case M.lookup hash hashes of-            Just others -> M.insert hash (fp <| others) hashes-            Nothing     -> M.insert hash (fp :| []) hashes+    case hash of+        Right x ->+            pure $ \hashes ->+                case M.lookup x hashes of+                    Just others -> M.insert x (fp <| others) hashes+                    Nothing     -> M.insert x (fp :| []) hashes+        Left err -> putStrLn ("WARNING: skipping " ++ fp ++ "\n" ++ err) $> id  stepMap :: TVar (M.Map Word64 (NonEmpty FilePath)) -> FilePath -> IO () stepMap var fp = do

@@ -1,14 +1,14 @@ module Main (main) where +import           Control.DeepSeq (NFData) import           Criterion.Main-import           Data.Word       (Word64) #ifdef FOREIGN_PHASH import           ForeignHash     (foreignFileHash) #endif import           PerceptualHash  (fileHash) import           System.FilePath (takeFileName) -mkBGroup :: String -> (FilePath -> IO Word64) -> Benchmark+mkBGroup :: NFData a => String -> (FilePath -> IO a) -> Benchmark mkBGroup str f = bgroup str (toBench <$> [catPath, frogJpeg, frogPng])      where toBench fp = bench (takeFileName fp) $ nfIO (f fp)

@@ -0,0 +1,14 @@+module Export ()  where++import           Control.Monad    ((<=<))+import           Data.Word        (Word64)+import           Foreign.C.String+import           PerceptualHash++-- | Hash an image at a given filepath+hs_phash :: CString -> IO Word64+hs_phash = fmap go . fileHash <=< peekCString+    where go Left{}    = 0+          go (Right x) = x++foreign export ccall hs_phash :: CString -> IO Word64

@@ -1,6 +1,6 @@ cabal-version:   2.0 name:            perceptual-hash-version:         0.1.2.0+version:         0.1.3.0 license:         BSD3 license-file:    LICENSE copyright:       Copyright: (c) 2019 Vanessa McHale@@ -65,6 +65,29 @@     if impl(ghc >=8.4)         ghc-options: -Wmissing-export-lists +foreign-library hsphash+    type:             native-shared+    hs-source-dirs:   foreign-src+    other-modules:    Export+    default-language: Haskell2010+    ghc-options:      -Wall+    build-depends:+        base -any,+        perceptual-hash -any++    lib-version-info: 1:0:0++    if os(windows)+        options: standalone++    if impl(ghc >=8.0)+        ghc-options:+            -Wincomplete-uni-patterns -Wincomplete-record-updates+            -Wredundant-constraints -Widentities++    if impl(ghc >=8.4)+        ghc-options: -Wmissing-export-lists+ executable phash     main-is:          Main.hs     hs-source-dirs:   app@@ -75,6 +98,7 @@      autogen-modules:  Paths_perceptual_hash     default-language: Haskell2010+    other-extensions: ScopedTypeVariables     ghc-options:      -Wall -threaded -rtsopts "-with-rtsopts=-N -qg"     build-depends:         base >=4.9 && <5,@@ -130,7 +154,8 @@         base -any,         perceptual-hash -any,         criterion -any,-        filepath -any+        filepath -any,+        deepseq -any      if flag(llvm)         ghc-options: -fllvm

@@ -11,7 +11,7 @@ import           Data.Word                (Word64) import           Graphics.Image           (Array, Bilinear (..), Border (Edge, Reflect), Image,                                            Pixel (PixelX, PixelY), RSU (..), X, Y, convolve, crop,-                                           makeImage, readImageY, resize, transpose, (|*|))+                                           makeImage, readImage, resize, transpose, (|*|)) import           Graphics.Image.Interface (toVector) import qualified Graphics.Image.Interface as Hip import           Median                   (median)@@ -61,5 +61,5 @@     let med = medianImmut v     in V.map (<med) v -fileHash :: FilePath -> IO Word64-fileHash = fmap imgHash . readImageY RSU+fileHash :: FilePath -> IO (Either String Word64)+fileHash = fmap (fmap (imgHash :: Image RSU Y Double -> Word64)) . readImage