summaryrefslogtreecommitdiff
path: root/Annex/Content.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-11-08 15:34:10 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-11-08 16:27:20 -0400
commitbf460a0a98d7e4c7f4eac525fcf300629db582b6 (patch)
treebff7cd09529c40fa8cb76fd92428cc41e24ad808 /Annex/Content.hs
parent2ff8915365099501382183af9855e739fc234861 (diff)
reorder repo parameters last
Many functions took the repo as their first parameter. Changing it consistently to be the last parameter allows doing some useful things with currying, that reduce boilerplate. In particular, g <- gitRepo is almost never needed now, instead use inRepo to run an IO action in the repo, and fromRepo to get a value from the repo. This also provides more opportunities to use monadic and applicative combinators.
Diffstat (limited to 'Annex/Content.hs')
-rw-r--r--Annex/Content.hs32
1 files changed, 13 insertions, 19 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index aafdf6f2e..fc2c2d092 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -37,18 +37,18 @@ import Config
{- Checks if a given key is currently present in the gitAnnexLocation. -}
inAnnex :: Key -> Annex Bool
inAnnex key = do
- g <- gitRepo
- when (Git.repoIsUrl g) $ error "inAnnex cannot check remote repo"
- liftIO $ doesFileExist $ gitAnnexLocation g key
+ whenM (fromRepo Git.repoIsUrl) $
+ error "inAnnex cannot check remote repo"
+ inRepo $ doesFileExist . gitAnnexLocation key
{- Calculates the relative path to use to link a file to a key. -}
calcGitLink :: FilePath -> Key -> Annex FilePath
calcGitLink file key = do
- g <- gitRepo
cwd <- liftIO getCurrentDirectory
let absfile = fromMaybe whoops $ absNormPath cwd file
+ top <- fromRepo Git.workTree
return $ relPathDirToFile (parentDir absfile)
- (Git.workTree g) </> ".git" </> annexLocation key
+ top </> ".git" </> annexLocation key
where
whoops = error $ "unable to normalize " ++ file
@@ -65,8 +65,7 @@ logStatus key status = do
- the annex as a key's content. -}
getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool
getViaTmp key action = do
- g <- gitRepo
- let tmp = gitAnnexTmpLocation g key
+ tmp <- fromRepo $ gitAnnexTmpLocation key
-- Check that there is enough free disk space.
-- When the temp file already exists, count the space
@@ -84,8 +83,7 @@ getViaTmp key action = do
prepTmp :: Key -> Annex FilePath
prepTmp key = do
- g <- gitRepo
- let tmp = gitAnnexTmpLocation g key
+ tmp <- fromRepo $ gitAnnexTmpLocation key
liftIO $ createDirectoryIfMissing True (parentDir tmp)
return tmp
@@ -162,8 +160,7 @@ checkDiskSpace' adjustment key = do
-}
moveAnnex :: Key -> FilePath -> Annex ()
moveAnnex key src = do
- g <- gitRepo
- let dest = gitAnnexLocation g key
+ dest <- fromRepo $ gitAnnexLocation key
let dir = parentDir dest
e <- liftIO $ doesFileExist dest
if e
@@ -177,8 +174,7 @@ moveAnnex key src = do
withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a
withObjectLoc key a = do
- g <- gitRepo
- let file = gitAnnexLocation g key
+ file <- fromRepo $gitAnnexLocation key
let dir = parentDir file
a (dir, file)
@@ -201,9 +197,9 @@ fromAnnex key dest = withObjectLoc key $ \(dir, file) -> liftIO $ do
- returns the file it was moved to. -}
moveBad :: Key -> Annex FilePath
moveBad key = do
- g <- gitRepo
- let src = gitAnnexLocation g key
- let dest = gitAnnexBadDir g </> takeFileName src
+ src <- fromRepo $ gitAnnexLocation key
+ bad <- fromRepo $ gitAnnexBadDir
+ let dest = bad </> takeFileName src
liftIO $ do
createDirectoryIfMissing True (parentDir dest)
allowWrite (parentDir src)
@@ -214,9 +210,7 @@ moveBad key = do
{- List of keys whose content exists in .git/annex/objects/ -}
getKeysPresent :: Annex [Key]
-getKeysPresent = do
- g <- gitRepo
- getKeysPresent' $ gitAnnexObjectDir g
+getKeysPresent = getKeysPresent' =<< fromRepo gitAnnexObjectDir
getKeysPresent' :: FilePath -> Annex [Key]
getKeysPresent' dir = do
exists <- liftIO $ doesDirectoryExist dir