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

Optional range

Browse Source
This commit is contained in:
Mats Rauhala 2019-01-02 20:04:46 +02:00
parent 4139562a49
commit 27a236619e
1 changed files with 5 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/Main.hs
View File

@ -14,6 +14,7 @@ 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.List (foldl') import Data.List (foldl')
import Data.Maybe (fromMaybe)
import Data.Word (Word64) import Data.Word (Word64)
import Options.Generic import Options.Generic
import Pipes import Pipes
@ -26,7 +27,7 @@ import System.FilePath (takeFileName, (</>))
data Cmd = Cmd { source :: FilePath data Cmd = Cmd { source :: FilePath
, target :: FilePath , target :: FilePath
, recursive :: Bool , range :: Maybe Int
} deriving (Show, Generic, ParseRecord) } deriving (Show, Generic, ParseRecord)
data Fingerprint = data Fingerprint =
@ -59,7 +60,7 @@ main = do
-- XXX: This is a really long line, split it up -- XXX: This is a really long line, split it up
index <- runSafeT (P.fold (\acc -> either (const acc) (\x -> x `seq` BK.insert x acc)) BK.empty id (find source (glob "*.jpg" <> regular) >-> P.mapM (\path -> liftIO (putStrLn path) >> fmap (path,) <$> liftIO (readImage path)) >-> P.map (fmap (\(path, img) -> Fingerprint path (fingerprint img))))) index <- runSafeT (P.fold (\acc -> either (const acc) (\x -> x `seq` BK.insert x acc)) BK.empty id (find source (glob "*.jpg" <> regular) >-> P.mapM (\path -> liftIO (putStrLn path) >> fmap (path,) <$> liftIO (readImage path)) >-> P.map (fmap (\(path, img) -> Fingerprint path (fingerprint img)))))
forM_ index $ \fp -> do forM_ index $ \fp -> do
let similar = BK.search 1 fp index let similar = BK.search (fromMaybe 1 range) fp index
when (length similar > 1) $ do when (length similar > 1) $ do
print similar print similar
let targetDir = target </> show (hash fp) let targetDir = target </> show (hash fp)