Compare commits

..

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

View File

@ -3,12 +3,10 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Main where module Main where
import Codec.Picture import Codec.Picture
import Codec.Picture.Extra (scaleBilinear) import Codec.Picture.Extra (scaleBilinear)
import Data.Bifunctor (second)
import Data.Bits import Data.Bits
import Data.List (foldl') import Data.List (foldl')
import Data.Word (Word64) import Data.Word (Word64)
@ -18,7 +16,6 @@ import Pipes.Files
import qualified Pipes.Prelude as P import qualified Pipes.Prelude as P
import Pipes.Safe (runSafeT) import Pipes.Safe (runSafeT)
data Cmd = Cmd { source :: FilePath data Cmd = Cmd { source :: FilePath
, target :: FilePath , target :: FilePath
, recursive :: Bool , recursive :: Bool
@ -30,16 +27,14 @@ fingerprint = hash . grey . scale . convertRGB8
scale :: Image PixelRGB8 -> Image PixelRGB8 scale :: Image PixelRGB8 -> Image PixelRGB8
scale = scaleBilinear 8 8 scale = scaleBilinear 8 8
grey :: Image PixelRGB8 -> Image Pixel8 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 :: Image Pixel8 -> Word64
hash img = -- the average fingerprint method 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]] 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 :: IO ()
main = do main = do
Cmd{..} <- getRecord "Image duplicate finder" Cmd{..} <- getRecord "Image duplicate finder"
runSafeT $ runSafeT (runEffect (for (find source (glob "*.jpg" <> regular) >-> P.mapM (liftIO . readImage) >-> P.map (fmap fingerprint)) (liftIO . print)))
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!" putStrLn "Hello, Haskell!"