wip

src/Data/BKTree.hs

@@ -1,16 +1,16 @@
-{-# LANGUAGE DeriveFoldable      #-}
+{-# LANGUAGE DeriveFoldable    #-}
-{-# LANGUAGE DeriveFunctor       #-}
+{-# LANGUAGE DeriveFunctor     #-}
-{-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE DeriveTraversable   #-}
+{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE KindSignatures      #-}
+{-# LANGUAGE KindSignatures    #-}
-{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE LambdaCase        #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE TypeFamilies      #-}
-{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE ScopedTypeVariables      #-}
 module Data.BKTree where
 
-import           Data.Functor.Foldable
 import           Data.Functor.Foldable.TH
+import           Data.Functor.Foldable
 import           GHC.Generics             (Generic)
 
 -- Point for testing purposes
@@ -27,12 +27,6 @@ data BKTree a = Empty
 
 makeBaseFunctor ''BKTree
 
-empty :: BKTree a
-empty = Empty
-
-singleton :: Metric a => a -> BKTree a
-singleton a = insert a empty
-
 insert :: Metric a => a -> BKTree a -> BKTree a
 insert a = \case
   Empty -> Node a []

src/Main.hs

@@ -8,8 +8,8 @@ module Main where
 
 import           Codec.Picture
 import           Codec.Picture.Extra (scaleBilinear)
+import           Data.Bifunctor      (second)
 import           Data.Bits
-import qualified Data.BKTree         as BK
 import           Data.List           (foldl')
 import           Data.Word           (Word64)
 import           Options.Generic
@@ -17,6 +17,7 @@ import           Pipes
 import           Pipes.Files
 import qualified Pipes.Prelude       as P
 import           Pipes.Safe          (runSafeT)
+import qualified Data.BKTree as BK
 
 
 data Cmd = Cmd { source    :: FilePath
@@ -26,14 +27,14 @@ data Cmd = Cmd { source    :: FilePath
 
 data Fingerprint =
   Fingerprint { imagePath :: FilePath
-              , hash      :: !Word64
+              , hash :: !Word64
               } deriving Show
 
 instance BK.Metric Fingerprint where
   -- hamming distance
   distance (Fingerprint _ a) (Fingerprint _ b) =
     let xored = a `xor` b
-    in foldr (\shiftA acc -> acc + if 1 `shift` shiftA .&. xored > 0 then 1 else 0) 0 [0..63]
+    in _
 
 
 fingerprint :: DynamicImage -> Word64
@@ -53,4 +54,5 @@ 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)
+      for (find source (glob "*.jpg" <> regular) >-> P.mapM (\path -> fmap (path,) <$> liftIO (readImage path)) >-> P.map (fmap (second fingerprint))) (liftIO . print)
+  putStrLn "Hello, Haskell!"