phash (empty) → 0.0.1
raw patch · 8 files changed
+218/−0 lines, 8 filesdep +HUnitdep +basedep +smallchecksetup-changed
Dependencies added: HUnit, base, smallcheck, tasty, tasty-hunit, tasty-smallcheck
Files
- LICENSE +25/−0
- README.md +27/−0
- Setup.hs +3/−0
- phash.cabal +44/−0
- src/Data/PHash.hs +25/−0
- src/Data/PHash/Image.hs +22/−0
- src/Data/PHash/Types.hs +16/−0
- test/Test.hs +56/−0
+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2014, Michael Xavier. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,27 @@+# phash: Haskell bindings to pHash, the open source perceptual hash library++PHash is a library for generating perceptual hashes of media files. These+bindings currently only support images. You can compare these hashes to detect+visually similar images.++## Installation Notes+Note that this library does not come bundled with the source code for pHash.+You must install that yourself. Your package manager may have it available as+`libphash`. If that is not available, you can install it from source from+http://phash.org.++## Usage++```haskell+import Data.PHash++main = do+ Just h1 = imageHash "somefile.jpg"+ print h1+ print =<< imagesSimilar "somefile.jpg" "similarfile.jpg" reasonableThreshold+ where reasonableThreshold = 15+```++# Credit+All credit goes to the original pHash authors. For more information about pHash+visit http://phash.org
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ phash.cabal view
@@ -0,0 +1,44 @@+name: phash+version: 0.0.1+synopsis: Haskell bindings to pHash, the open source perceptual hash library+description: See http://www.phash.org/ for more info. Note that you+ must have libphash installed on your system to use this+ library. Check your system library.+license: MIT+license-file: LICENSE+author: Michael Xavier <michael@michaelxavier.net>+maintainer: Michael Xavier <michael@michaelxavier.net>+copyright: Copyright: (c) 2014 Michael Xavier+category: Data+build-type: Simple+cabal-version: >= 1.10+extra-source-files: README.md+homepage: http://github.com/michaelxavier/phash+bug-reports: http://github.com/michaelxavier/phash/issues++library+ exposed-modules: Data.PHash+ exposed-modules: Data.PHash.Image+ exposed-modules: Data.PHash.Types+ build-depends: base >= 4.6 && < 4.7+ hs-source-dirs: src+ default-language: Haskell2010+ extra-libraries: pHash++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Test.hs+ default-language: Haskell2010+ hs-source-dirs: src, test+ extra-libraries: pthread+ extra-libraries: pHash+ build-depends: base >= 4.6 && < 4.7+ build-depends: tasty >= 0.7 && < 1.0+ build-depends: tasty-smallcheck >= 0.2 && < 1.0+ build-depends: tasty-hunit >= 0.4.1 && < 1.0+ build-depends: HUnit >= 1.2.5.2 && < 2.0+ build-depends: smallcheck++source-repository head+ Type: git+ Location: https://github.com/michaelxavier/phash
+ src/Data/PHash.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Data.PHash ( hammingDistance+ , imagesSimilar+ , module Data.PHash.Image+ , module Data.PHash.Types ) where++import Control.Applicative ( (<$>)+ , (<*>) )+import Foreign.C.Types++import Data.PHash.Image+import Data.PHash.Types++hammingDistance :: PHash -> PHash -> Int+hammingDistance x y = unwrap $ c_ph_hamming_distance (toCPHash x) (toCPHash y)+ where unwrap (CInt i) = fromIntegral i++imagesSimilar :: FilePath -> FilePath -> Int -> IO (Maybe Bool)+imagesSimilar p1 p2 threshold = do+ h1 <- imageHash p1+ h2 <- imageHash p2+ return $ checkDistance <$> h1 <*> h2+ where checkDistance h1 h2 = (<=threshold) $ hammingDistance h1 h2++foreign import ccall "pHash.h ph_hamming_distance" c_ph_hamming_distance :: CULong -> CULong -> CInt
+ src/Data/PHash/Image.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Data.PHash.Image ( imageHash ) where++import Control.Applicative ((<$>))+import Foreign+import Foreign.C.String+import Foreign.C.Types++import Data.PHash.Types++imageHash :: FilePath -> IO (Maybe PHash)+imageHash path = withCString path $ \cs ->+ with startingPhash $ \pHPtr -> do+ res <- c_ph_dct_imagehash cs pHPtr+ if success res+ then Just . fromCPHash <$> peek pHPtr+ else return Nothing+ where startingPhash = CULong 0+ success (CInt (-1)) = False+ success _ = True++foreign import ccall "pHash.h ph_dct_imagehash" c_ph_dct_imagehash :: CString -> Ptr CULong -> IO CInt
+ src/Data/PHash/Types.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Data.PHash.Types ( PHash(..)+ , toCPHash+ , fromCPHash ) where++import Data.Word ( Word64 )+import Foreign.C.Types ( CULong(..) )++newtype PHash = PHash Word64 deriving (Show, Eq, Num)++toCPHash :: PHash -> CULong+toCPHash (PHash x) = CULong x++fromCPHash :: CULong -> PHash+fromCPHash (CULong x) = PHash x+
+ test/Test.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+import Control.Applicative+import Test.Tasty+import Test.Tasty.SmallCheck+import Test.Tasty.HUnit+import Test.SmallCheck.Series++import Data.PHash++main = defaultMain tests++tests :: TestTree+tests = testGroup "tests" [imageTests, hammingTests]++imageTests :: TestTree+imageTests = testGroup "imageHash" [+ testCase "file missing" $ do+ result <- imageHash "bogus"+ result @?= Nothing,+ testCase "file exists" $ do+ result <- imageHash "test/fixtures/grump.jpg"+ result @?= Just (PHash 17549625427362946731),+ testCase "match same image" $ do+ result <- imagesSimilar "test/fixtures/grump.jpg" "test/fixtures/grump.jpg" 1+ result @?= Just True,+ testCase "match desaturated image" $ do+ result <- imagesSimilar "test/fixtures/grump.jpg" "test/fixtures/grump_gray.jpg" 1+ result @?= Just True,+ testCase "match brighter image" $ do+ result <- imagesSimilar "test/fixtures/grump.jpg" "test/fixtures/grump_bright.jpg" 2+ result @?= Just True,+ testCase "does not match brighter image with too-low threshold" $ do+ result <- imagesSimilar "test/fixtures/grump.jpg" "test/fixtures/grump_bright.jpg" 1+ result @?= Just False,+ testCase "does not match different image" $ do+ result <- imagesSimilar "test/fixtures/grump.jpg" "test/fixtures/grump_flip.jpg" 15+ result @?= Just False,+ testCase "Returns Nothing on error on one file" $ do+ result <- imagesSimilar "test/fixtures/grump.jpg" "bogus" 15+ result @?= Nothing,+ testCase "Returns Nothing on error on both files" $ do+ result <- imagesSimilar "bogus" "also_bogus" 15+ result @?= Nothing+ ]++hammingTests :: TestTree+hammingTests = testGroup "hammingTests" [+ testProperty "hammingDistance a a = 0" $+ \ph -> hammingDistance ph ph == 0,+ testProperty "hammingDistance a a+1 /= 0" $+ \ph -> hammingDistance ph (ph + 1) /= 0+ ]++instance Monad m => Serial m PHash where+ series = PHash . fromInteger <$> series