From 903241502a6ad1a4845ac2d131ef7fc2b547400d Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 5 Jan 2016 17:22:19 -0400
Subject: use TopFilePath for associated files

Fixes several bugs with updates of pointer files. When eg, running
git annex drop --from localremote
it was updating the pointer file in the local repository, not the remote.
Also, fixes drop ../foo when run in a subdir, and probably lots of other
problems. Test suite drops from ~30 to 11 failures now.

TopFilePath is used to force thinking about what the filepath is relative
to.

The data stored in the sqlite db is still just a plain string, and
TopFilePath is a newtype, so there's no overhead involved in using it in
DataBase.Keys.
---
 Database/Keys.hs | 26 +++++++++++++-------------
 1 file changed, 13 insertions(+), 13 deletions(-)

(limited to 'Database')

diff --git a/Database/Keys.hs b/Database/Keys.hs
index aeb71ecde..8cea5c940 100644
--- a/Database/Keys.hs
+++ b/Database/Keys.hs
@@ -165,50 +165,50 @@ openDb createdb _ = withExclusiveLock gitAnnexKeysDbLock $ do
   where
 	open db = liftIO $ DbOpen <$> H.openDbQueue db "content"
 
-addAssociatedFile :: Key -> FilePath -> Annex ()
+addAssociatedFile :: Key -> TopFilePath -> Annex ()
 addAssociatedFile k f = runWriter $ addAssociatedFile' k f
 
-addAssociatedFile' :: Key -> FilePath -> Writer
+addAssociatedFile' :: Key -> TopFilePath -> Writer
 addAssociatedFile' k f = queueDb $ do
 	-- If the same file was associated with a different key before,
 	-- remove that.
 	delete $ from $ \r -> do
-		where_ (r ^. AssociatedFile ==. val f &&. r ^. AssociatedKey ==. val sk)
-	void $ insertUnique $ Associated sk f
+		where_ (r ^. AssociatedFile ==. val (getTopFilePath f) &&. r ^. AssociatedKey ==. val sk)
+	void $ insertUnique $ Associated sk (getTopFilePath f)
   where
 	sk = toSKey k
 
 {- Note that the files returned were once associated with the key, but
  - some of them may not be any longer. -}
-getAssociatedFiles :: Key -> Annex [FilePath]
+getAssociatedFiles :: Key -> Annex [TopFilePath]
 getAssociatedFiles = runReader . getAssociatedFiles' . toSKey
 
-getAssociatedFiles' :: SKey -> Reader [FilePath]
+getAssociatedFiles' :: SKey -> Reader [TopFilePath]
 getAssociatedFiles' sk = readDb $ do
 	l <- select $ from $ \r -> do
 		where_ (r ^. AssociatedKey ==. val sk)
 		return (r ^. AssociatedFile)
-	return $ map unValue l
+	return $ map (TopFilePath . 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 :: TopFilePath -> Annex [Key]
 getAssociatedKey = runReader . getAssociatedKey'
 
-getAssociatedKey' :: FilePath -> Reader [Key]
+getAssociatedKey' :: TopFilePath -> Reader [Key]
 getAssociatedKey' f = readDb $ do
 	l <- select $ from $ \r -> do
-		where_ (r ^. AssociatedFile ==. val f)
+		where_ (r ^. AssociatedFile ==. val (getTopFilePath f))
 		return (r ^. AssociatedKey)
 	return $ map (fromSKey . unValue) l
 
-removeAssociatedFile :: Key -> FilePath -> Annex ()
+removeAssociatedFile :: Key -> TopFilePath -> Annex ()
 removeAssociatedFile k = runWriter . removeAssociatedFile' (toSKey k)
 
-removeAssociatedFile' :: SKey -> FilePath -> Writer
+removeAssociatedFile' :: SKey -> TopFilePath -> Writer
 removeAssociatedFile' sk f = queueDb $ 
 	delete $ from $ \r -> do
-		where_ (r ^. AssociatedKey ==. val sk &&. r ^. AssociatedFile ==. val f)
+		where_ (r ^. AssociatedKey ==. val sk &&. r ^. AssociatedFile ==. val (getTopFilePath f))
 	
 {- Find all unlocked associated files. This is expensive, and so normally
  - the associated files are updated incrementally when changes are noticed. -}
-- 
cgit v1.2.3