Base feature set done

imageduplicates.cabal

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

src/Main.hs

@@ -4,12 +4,16 @@
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections       #-}
+{-# LANGUAGE TypeApplications    #-}
 module Main where
 
 import           Codec.Picture
 import           Codec.Picture.Extra (scaleBilinear)
+import           Control.Exception   (SomeException, try)
+import           Control.Monad       (forM_, void, when)
 import           Data.Bits
 import qualified Data.BKTree         as BK
+import           Data.Either         (rights)
 import           Data.List           (foldl')
 import           Data.Word           (Word64)
 import           Options.Generic
@@ -17,6 +21,8 @@ import           Pipes
 import           Pipes.Files
 import qualified Pipes.Prelude       as P
 import           Pipes.Safe          (runSafeT)
+import           System.Directory    (createDirectoryIfMissing, createFileLink)
+import           System.FilePath     (takeFileName, (</>))
 
 
 data Cmd = Cmd { source    :: FilePath
@@ -51,6 +57,13 @@ fingerprint = hash . grey . scale . convertRGB8
 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 (\(path, img) -> Fingerprint path (fingerprint img)))) (liftIO . print)
+  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)))))
+  let index = foldl' (flip BK.insert) BK.empty fingerprints
+  forM_ fingerprints $ \fp -> do
+    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')))