add getAssociatedKey

I guess this is just as efficient as the getAssociatedFiles query, but I
have not tried to optimise the database yet.

diff --git a/Database/Keys.hs b/Database/Keys.hs
index 78d583d6332af70f1570bae812239d0e3f432904..62c7c25eb45a67ef3729f382f8a48c205b82525a 100644 (file)
--- a/Database/Keys.hs
+++ b/Database/Keys.hs
@@ -17,6 +17,7 @@ module Database.Keys (
        shutdown,
        addAssociatedFile,
        getAssociatedFiles,
+       getAssociatedKey,
        removeAssociatedFile,
        storeInodeCaches,
        addInodeCaches,
@@ -118,6 +119,19 @@ getAssociatedFiles' sk = do
                return (r ^. AssociatedFile)
        return $ map unValue l
 
+{- Gets any keys that are on record as having a particular associated file.
+ - (Should be one or none but the database doesn't enforce that.) -}
+getAssociatedKey :: FilePath -> Annex [Key]
+getAssociatedKey f = withDbHandle $ \h -> H.queryDb h $
+       getAssociatedKey' f
+
+getAssociatedKey' :: FilePath -> SqlPersistM [Key]
+getAssociatedKey' f = do
+       l <- select $ from $ \r -> do
+               where_ (r ^. AssociatedFile ==. val f)
+               return (r ^. AssociatedKey)
+       return $ map (fromSKey . unValue) l
+
 removeAssociatedFile :: Key -> FilePath -> Annex ()
 removeAssociatedFile k f = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $
        delete $ from $ \r -> do