MasseR/imageduplicates
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Compare commits

base: MasseR:4b6b9b8f197b3fdd81f597c50acbe98fa8103780
Branches Tags
MasseR:master
..
compare: MasseR:828fd6aead938f4ed12214a3c4cb96cecbf02825
Branches Tags
MasseR:master

No commits in common. "4b6b9b8f197b3fdd81f597c50acbe98fa8103780" and "828fd6aead938f4ed12214a3c4cb96cecbf02825" have entirely different histories.
4b6b9b8f19 ... 828fd6aead

1 changed files with 3 additions and 8 deletions
Show Stats Expand all files Collapse all files

11
src/Main.hs
View File

@ -3,12 +3,10 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Main where
import Codec.Picture
import Codec.Picture.Extra (scaleBilinear)
import Data.Bifunctor (second)
import Data.Bits
import Data.List (foldl')
import Data.Word (Word64)
@ -18,7 +16,6 @@ import Pipes.Files
import qualified Pipes.Prelude as P
import Pipes.Safe (runSafeT)
data Cmd = Cmd { source :: FilePath
, target :: FilePath
, recursive :: Bool
@ -30,16 +27,14 @@ fingerprint = hash . grey . scale . convertRGB8
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 :: Double)) + (fromIntegral g * 0.59) + (fromIntegral b * 0.11)))
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 :: Int) [(x,y) | x <- [0..7], y <- [0..7]] `div` 64)
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 = do
Cmd{..} <- getRecord "Image duplicate finder"
runSafeT $
runEffect $
for (find source (glob "*.jpg" <> regular) >-> P.mapM (\path -> fmap (path,) <$> liftIO (readImage path)) >-> P.map (fmap (second fingerprint))) (liftIO . print)
runSafeT (runEffect (for (find source (glob "*.jpg" <> regular) >-> P.mapM (liftIO . readImage) >-> P.map (fmap fingerprint)) (liftIO . print)))
putStrLn "Hello, Haskell!"