List and build fingerprints

imageduplicates.cabal

@@ -17,8 +17,21 @@ cabal-version:       >=1.10
 
 executable imageduplicates
   main-is:             Main.hs
+  ghc-options:         -Wall -threaded -rtsopts -O2
   -- other-modules:
   -- other-extensions:
   build-depends:       base >=4.11 && <4.12
+                     , JuicyPixels
+                     , JuicyPixels-extra
+                     , bytestring
+                     , generic-lens
+                     , lens
+                     , mtl
+                     , optparse-generic
+                     , pipes
+                     , pipes-files
+                     , pipes-safe
+                     , text
+                     , transformers
   hs-source-dirs:      src
   default-language:    Haskell2010

src/Main.hs

@@ -1,4 +1,40 @@
+{-# LANGUAGE DeriveAnyClass      #-}
+{-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RecordWildCards     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Main where
 
+import           Codec.Picture
+import           Codec.Picture.Extra (scaleBilinear)
+import           Data.Bits
+import           Data.List           (foldl')
+import           Data.Word           (Word64)
+import           Options.Generic
+import           Pipes
+import           Pipes.Files
+import qualified Pipes.Prelude       as P
+import           Pipes.Safe          (runSafeT)
+
+data Cmd = Cmd { source    :: FilePath
+               , target    :: FilePath
+               , recursive :: Bool
+               } deriving (Show, Generic, ParseRecord)
+
+fingerprint :: DynamicImage -> Word64
+fingerprint = hash . grey . scale . convertRGB8
+  where
+    scale :: Image PixelRGB8 -> Image PixelRGB8
+    scale = scaleBilinear 8 8
+    grey :: Image PixelRGB8 -> Image Pixel8
+    grey = pixelMap (\(PixelRGB8 r g b) -> ceiling ((fromIntegral r * 0.3) + (fromIntegral g * 0.59) + (fromIntegral b * 0.11)))
+    hash :: Image Pixel8 -> Word64
+    hash img = -- the average fingerprint method
+      let avg = fromIntegral (foldl' (\acc (x,y) -> acc + fromIntegral (pixelAt img x y)) 0 [(x,y) | x <- [0..7], y <- [0..7]] `div` 64)
+      in foldr (\(shiftA, b) acc -> if b then 1 `shift` shiftA .|. acc else acc) 0 $ zip [0..] [pixelAt img x y > avg | x <- [0..7], y <- [0..7]]
+
 main :: IO ()
-main = putStrLn "Hello, Haskell!"
+main = do
+  Cmd{..} <- getRecord "Image duplicate finder"
+  runSafeT (runEffect (for (find source (glob "*.jpg" <> regular) >-> P.mapM (liftIO . readImage) >-> P.map (fmap fingerprint)) (liftIO . print)))
+  putStrLn "Hello, Haskell!"