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

Compare commits

base: MasseR:c7e074b73fa641d2264119980c829ba6921ea5a9
Branches Tags
MasseR:master
..
compare: MasseR:b61ca540117d17b2fc7fef8edc15430c2aa60d90
Branches Tags
MasseR:master

No commits in common. "c7e074b73fa641d2264119980c829ba6921ea5a9" and "b61ca540117d17b2fc7fef8edc15430c2aa60d90" have entirely different histories.
c7e074b73f ... b61ca54011

2 changed files with 3 additions and 18 deletions
Show Stats Expand all files Collapse all files

2
imageduplicates.cabal
View File

@ -35,7 +35,5 @@ executable imageduplicates
, recursion-schemes , recursion-schemes
, text , text
, transformers , transformers
, directory
, filepath
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010

19
src/Main.hs
View File

@ -4,16 +4,12 @@
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
module Main where module Main where
import Codec.Picture import Codec.Picture
import Codec.Picture.Extra (scaleBilinear) import Codec.Picture.Extra (scaleBilinear)
import Control.Exception (SomeException, try)
import Control.Monad (forM_, void, when)
import Data.Bits import Data.Bits
import qualified Data.BKTree as BK import qualified Data.BKTree as BK
import Data.Either (rights)
import Data.List (foldl') import Data.List (foldl')
import Data.Word (Word64) import Data.Word (Word64)
import Options.Generic import Options.Generic
@ -21,8 +17,6 @@ import Pipes
import Pipes.Files import Pipes.Files
import qualified Pipes.Prelude as P import qualified Pipes.Prelude as P
import Pipes.Safe (runSafeT) import Pipes.Safe (runSafeT)
import System.Directory (createDirectoryIfMissing, createFileLink)
import System.FilePath (takeFileName, (</>))
data Cmd = Cmd { source :: FilePath data Cmd = Cmd { source :: FilePath
@ -57,13 +51,6 @@ fingerprint = hash . grey . scale . convertRGB8
main :: IO () main :: IO ()
main = do main = do
Cmd{..} <- getRecord "Image duplicate finder" Cmd{..} <- getRecord "Image duplicate finder"
fingerprints <- rights <$> runSafeT (P.toListM (find source (glob "*.jpg" <> regular) >-> P.mapM (\path -> fmap (path,) <$> liftIO (readImage path)) >-> P.map (fmap (\(path, img) -> Fingerprint path (fingerprint img))))) runSafeT $
let index = foldl' (flip BK.insert) BK.empty fingerprints runEffect $
forM_ fingerprints $ \fp -> do for (find source (glob "*.jpg" <> regular) >-> P.mapM (\path -> fmap (path,) <$> liftIO (readImage path)) >-> P.map (fmap (\(path, img) -> Fingerprint path (fingerprint img)))) (liftIO . print)
let similar = BK.search 1 fp index
when (length similar > 1) $ do
print similar
let targetDir = target </> show (hash fp)
createDirectoryIfMissing True targetDir
forM_ similar $ \fp' -> do
void $ try @SomeException (createFileLink (imagePath fp') (targetDir </> takeFileName (imagePath fp')))