From bf460a0a98d7e4c7f4eac525fcf300629db582b6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 8 Nov 2011 15:34:10 -0400 Subject: 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. --- Annex/Branch.hs | 60 +++++++++++++++++++++++--------------------------------- Annex/CatFile.hs | 3 +-- Annex/Content.hs | 32 ++++++++++++------------------ Annex/Queue.hs | 3 +-- Annex/UUID.hs | 14 ++++++------- Annex/Version.hs | 10 ++++------ 6 files changed, 50 insertions(+), 72 deletions(-) (limited to 'Annex') diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 163c9ec60..189289ad3 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -56,21 +56,19 @@ index g = gitAnnexDir g "index" - and merge in changes from other branches. -} genIndex :: Git.Repo -> IO () -genIndex g = Git.UnionMerge.ls_tree g fullname >>= Git.UnionMerge.update_index g +genIndex g = Git.UnionMerge.ls_tree fullname g >>= Git.UnionMerge.update_index g {- Runs an action using the branch's index file. -} withIndex :: Annex a -> Annex a withIndex = withIndex' False withIndex' :: Bool -> Annex a -> Annex a withIndex' bootstrapping a = do - g <- gitRepo - let f = index g - + f <- fromRepo $ index bracketIO (Git.useIndex f) id $ do unlessM (liftIO $ doesFileExist f) $ do unless bootstrapping create liftIO $ createDirectoryIfMissing True $ takeDirectory f - unless bootstrapping $ liftIO $ genIndex g + unless bootstrapping $ inRepo genIndex a withIndexUpdate :: Annex a -> Annex a @@ -103,19 +101,17 @@ getCache file = getState >>= go {- Creates the branch, if it does not already exist. -} create :: Annex () create = unlessM hasBranch $ do - g <- gitRepo e <- hasOrigin if e - then liftIO $ Git.run g "branch" [Param name, Param originname] + then inRepo $ Git.run "branch" [Param name, Param originname] else withIndex' True $ - liftIO $ Git.commit g "branch created" fullname [] + inRepo $ Git.commit "branch created" fullname [] {- Stages the journal, and commits staged changes to the branch. -} commit :: String -> Annex () commit message = whenM journalDirty $ lockJournal $ do stageJournalFiles - g <- gitRepo - withIndex $ liftIO $ Git.commit g message fullname [fullname] + withIndex $ inRepo $ Git.commit message fullname [fullname] {- Ensures that the branch is up-to-date; should be called before data is - read from it. Runs only once per git-annex run. @@ -134,7 +130,6 @@ commit message = whenM journalDirty $ lockJournal $ do -} update :: Annex () update = onceonly $ do - g <- gitRepo -- check what needs updating before taking the lock dirty <- journalDirty c <- filterM (changedBranch name . snd) =<< siblingBranches @@ -151,10 +146,10 @@ update = onceonly $ do - documentation advises users not to directly - modify the branch. -} - liftIO $ Git.UnionMerge.merge_index g branches + inRepo $ \g -> Git.UnionMerge.merge_index g branches ff <- if dirty then return False else tryFastForwardTo refs - unless ff $ - liftIO $ Git.commit g "update" fullname (nub $ fullname:refs) + unless ff $ inRepo $ + Git.commit "update" fullname (nub $ fullname:refs) invalidateCache where onceonly a = unlessM (branchUpdated <$> getState) $ do @@ -165,14 +160,13 @@ update = onceonly $ do {- Checks if the second branch has any commits not present on the first - branch. -} changedBranch :: String -> String -> Annex Bool -changedBranch origbranch newbranch = do - g <- gitRepo - diffs <- liftIO $ Git.pipeRead g [ - Param "log", - Param (origbranch ++ ".." ++ newbranch), - Params "--oneline -n1" - ] - return $ not $ L.null diffs +changedBranch origbranch newbranch = not . L.null <$> diffs + where + diffs = inRepo $ Git.pipeRead + [ Param "log" + , Param (origbranch ++ ".." ++ newbranch) + , Params "--oneline -n1" + ] {- Given a set of refs that are all known to have commits not - on the git-annex branch, tries to update the branch by a @@ -195,8 +189,7 @@ tryFastForwardTo (first:rest) = do where no_ff = return False do_ff branch = do - g <- gitRepo - liftIO $ Git.run g "update-ref" [Param fullname, Param branch] + inRepo $ Git.run "update-ref" [Param fullname, Param branch] return True findbest c [] = return $ Just c findbest c (r:rs) @@ -223,10 +216,8 @@ disableUpdate = Annex.changeState setupdated {- Checks if a git ref exists. -} refExists :: GitRef -> Annex Bool -refExists ref = do - g <- gitRepo - liftIO $ Git.runBool g "show-ref" - [Param "--verify", Param "-q", Param ref] +refExists ref = inRepo $ Git.runBool "show-ref" + [Param "--verify", Param "-q", Param ref] {- Does the main git-annex branch exist? -} hasBranch :: Annex Bool @@ -244,8 +235,7 @@ hasSomeBranch = not . null <$> siblingBranches - from remotes. Duplicate refs are filtered out. -} siblingBranches :: Annex [(String, String)] siblingBranches = do - g <- gitRepo - r <- liftIO $ Git.pipeRead g [Param "show-ref", Param name] + r <- inRepo $ Git.pipeRead [Param "show-ref", Param name] return $ nubBy uref $ map (pair . words . L.unpack) (L.lines r) where pair l = (head l, last l) @@ -280,8 +270,7 @@ get file = fromcache =<< getCache file {- Lists all files on the branch. There may be duplicates in the list. -} files :: Annex [FilePath] files = withIndexUpdate $ do - g <- gitRepo - bfiles <- liftIO $ Git.pipeNullSplit g + bfiles <- inRepo $ Git.pipeNullSplit [Params "ls-tree --name-only -r -z", Param fullname] jfiles <- getJournalledFiles return $ jfiles ++ bfiles @@ -349,8 +338,8 @@ stageJournalFiles = do where index_lines shas = map genline . zip shas genline (sha, file) = Git.UnionMerge.update_index_line sha file - git_hash_object g = Git.gitCommandLine g - [Param "hash-object", Param "-w", Param "--stdin-paths"] + git_hash_object g = Git.gitCommandLine + [Param "hash-object", Param "-w", Param "--stdin-paths"] g {- Checks if there are changes in the journal. -} @@ -379,8 +368,7 @@ fileJournal = replace "//" "_" . replace "_" "/" - contention with other git-annex processes. -} lockJournal :: Annex a -> Annex a lockJournal a = do - g <- gitRepo - let file = gitAnnexJournalLock g + file <- fromRepo $ gitAnnexJournalLock bracketIO (lock file) unlock a where lock file = do diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs index 2707ed3ea..a043e1ae3 100644 --- a/Annex/CatFile.hs +++ b/Annex/CatFile.hs @@ -17,8 +17,7 @@ catFile :: String -> FilePath -> Annex String catFile branch file = maybe startup go =<< Annex.getState Annex.catfilehandle where startup = do - g <- gitRepo - h <- liftIO $ Git.CatFile.catFileStart g + h <- inRepo $ Git.CatFile.catFileStart Annex.changeState $ \s -> s { Annex.catfilehandle = Just h } go h go h = liftIO $ Git.CatFile.catFile h branch file 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 diff --git a/Annex/Queue.hs b/Annex/Queue.hs index 4c1182750..f611cf02e 100644 --- a/Annex/Queue.hs +++ b/Annex/Queue.hs @@ -34,8 +34,7 @@ flush silent = do unless (0 == Git.Queue.size q) $ do unless silent $ showSideAction "Recording state in git" - g <- gitRepo - q' <- liftIO $ Git.Queue.flush g q + q' <- inRepo $ Git.Queue.flush q store q' store :: Git.Queue.Queue -> Annex () diff --git a/Annex/UUID.hs b/Annex/UUID.hs index d3d674dcc..6fc04c0f0 100644 --- a/Annex/UUID.hs +++ b/Annex/UUID.hs @@ -45,23 +45,23 @@ getUUID = getRepoUUID =<< gitRepo {- Looks up a repo's UUID. May return "" if none is known. -} getRepoUUID :: Git.Repo -> Annex UUID getRepoUUID r = do - g <- gitRepo - - let c = cached g + c <- fromRepo cached let u = getUncachedUUID r if c /= u && u /= NoUUID then do - updatecache g u + updatecache u return u else return c where - cached g = toUUID $ Git.configGet g cachekey "" - updatecache g u = when (g /= r) $ storeUUID cachekey u + cached g = toUUID $ Git.configGet cachekey "" g + updatecache u = do + g <- gitRepo + when (g /= r) $ storeUUID cachekey u cachekey = "remote." ++ fromMaybe "" (Git.repoRemoteName r) ++ ".annex-uuid" getUncachedUUID :: Git.Repo -> UUID -getUncachedUUID r = toUUID $ Git.configGet r configkey "" +getUncachedUUID = toUUID . Git.configGet configkey "" {- Make sure that the repo has an annex.uuid setting. -} prepUUID :: Annex () diff --git a/Annex/Version.hs b/Annex/Version.hs index 935f777ab..9e694faf1 100644 --- a/Annex/Version.hs +++ b/Annex/Version.hs @@ -26,12 +26,10 @@ versionField :: String versionField = "annex.version" getVersion :: Annex (Maybe Version) -getVersion = do - g <- gitRepo - let v = Git.configGet g versionField "" - if not $ null v - then return $ Just v - else return Nothing +getVersion = handle <$> fromRepo (Git.configGet versionField "") + where + handle [] = Nothing + handle v = Just v setVersion :: Annex () setVersion = setConfig versionField defaultVersion -- cgit v1.2.3