summaryrefslogtreecommitdiff
path: root/Database
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-01-05 17:22:19 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-01-05 17:22:19 -0400
commit903241502a6ad1a4845ac2d131ef7fc2b547400d (patch)
treefba85c9751a19aa0873e0f2bd837a1b000588508 /Database
parentcf911557bf4bb27768c4fc5ac482e8f827807497 (diff)
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.
Diffstat (limited to 'Database')
-rw-r--r--Database/Keys.hs26
1 files changed, 13 insertions, 13 deletions
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. -}