diff options
Diffstat (limited to 'Annex')
| -rw-r--r-- | Annex/Branch.hs | 60 | ||||
| -rw-r--r-- | Annex/CatFile.hs | 3 | ||||
| -rw-r--r-- | Annex/Content.hs | 32 | ||||
| -rw-r--r-- | Annex/Queue.hs | 3 | ||||
| -rw-r--r-- | Annex/UUID.hs | 14 | ||||
| -rw-r--r-- | Annex/Version.hs | 10 |
6 files changed, 50 insertions, 72 deletions
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 |