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

Compare commits

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

2 Commits
828fd6aead ... 4b6b9b8f19

Author SHA1 Message Date
Mats Rauhala
4b6b9b8f19 Retain filename 2019-01-01 17:30:55 +02:00
Mats Rauhala
f8f0cf5a56 Some type applications 2019-01-01 17:22:57 +02:00
1 changed files with 8 additions and 3 deletions
Show Stats Expand all files Collapse all files

11
src/Main.hs
View File

@ -3,10 +3,12 @@
{-# 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)
@ -16,6 +18,7 @@ import Pipes.Files
import qualified Pipes.Prelude as P
import Pipes.Safe (runSafeT)
data Cmd = Cmd { source :: FilePath
, target :: FilePath
, recursive :: Bool
@ -27,14 +30,16 @@ 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) + (fromIntegral g * 0.59) + (fromIntegral b * 0.11)))
grey = pixelMap (\(PixelRGB8 r g b) -> ceiling ((fromIntegral r * (0.3 :: Double)) + (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)
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)
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 (liftIO . readImage) >-> P.map (fmap fingerprint)) (liftIO . print)))
runSafeT $
runEffect $
for (find source (glob "*.jpg" <> regular) >-> P.mapM (\path -> fmap (path,) <$> liftIO (readImage path)) >-> P.map (fmap (second fingerprint))) (liftIO . print)
putStrLn "Hello, Haskell!"