diff options
| -rw-r--r-- | Annex/Branch.hs | 57 | ||||
| -rw-r--r-- | Command/Unused.hs | 3 | ||||
| -rw-r--r-- | Git.hs | 17 | ||||
| -rw-r--r-- | Git/Ref.hs | 47 | ||||
| -rw-r--r-- | Init.hs | 2 | ||||
| -rw-r--r-- | Upgrade/V2.hs | 3 |
6 files changed, 75 insertions, 54 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 1dac8ef79..c8a538acd 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -12,10 +12,9 @@ module Annex.Branch ( change, commit, files, - refExists, + name, hasOrigin, - hasSomeBranch, - name + hasSibling, ) where import System.Exit @@ -27,6 +26,7 @@ import Annex.BranchState import Annex.Journal import qualified Git import qualified Git.UnionMerge +import qualified Git.Ref import Annex.CatFile {- Name of the branch that is used to store git-annex's information. -} @@ -84,12 +84,12 @@ updateIndex branchref = do liftIO (catchDefaultIO (readFileStrict lock) "") when (lockref /= branchref) $ do withIndex $ mergeIndex [fullname] - setIndexRef branchref + setIndexSha branchref {- Record that the branch's index has been updated to correspond to a - given ref of the branch. -} -setIndexRef :: Git.Ref -> Annex () -setIndexRef ref = do +setIndexSha :: Git.Ref -> Annex () +setIndexSha ref = do lock <- fromRepo gitAnnexIndexLock liftIO $ writeFile lock $ show ref ++ "\n" @@ -115,7 +115,7 @@ commitBranch :: Git.Ref -> String -> [Git.Ref] -> Annex () commitBranch branchref message parents = do updateIndex branchref committedref <- inRepo $ Git.commit message fullname parents - setIndexRef committedref + setIndexSha committedref parentrefs <- commitparents <$> catObject committedref when (racedetected branchref parentrefs) $ fixrace committedref parentrefs @@ -154,18 +154,19 @@ create = do {- Returns the ref of the branch, creating it first if necessary. -} getBranch :: Annex (Git.Ref) -getBranch = maybe (hasOrigin >>= go >>= use) (return) =<< getRef fullname +getBranch = maybe (hasOrigin >>= go >>= use) (return) =<< branchsha where go True = do inRepo $ Git.run "branch" [Param $ show name, Param $ show originname] fromMaybe (error $ "failed to create " ++ show name) - <$> getRef fullname + <$> branchsha go False = withIndex' True $ do inRepo $ Git.commit "branch created" fullname [] - use ref = do - setIndexRef ref - return ref + use sha = do + setIndexSha sha + return sha + branchsha = inRepo $ Git.Ref.sha fullname {- Stages the journal, and commits staged changes to the branch. -} commit :: String -> Annex () @@ -202,7 +203,7 @@ update = runUpdateOnce $ do let merge_desc = if null branches then "update" else "merging " ++ - unwords (map Git.refDescribe branches) ++ + unwords (map Git.Ref.describe branches) ++ " into " ++ show name unless (null branches) $ do showSideAction merge_desc @@ -263,38 +264,18 @@ tryFastForwardTo (first:rest) = do (False, True) -> findbest c rs -- worse (False, False) -> findbest c rs -- same -{- Checks if a git ref exists. -} -refExists :: Git.Ref -> Annex Bool -refExists ref = inRepo $ Git.runBool "show-ref" - [Param "--verify", Param "-q", Param $ show ref] - -{- Get the ref of a branch. (Must be a fully qualified branch name) -} -getRef :: Git.Branch -> Annex (Maybe Git.Ref) -getRef branch = process . L.unpack <$> showref - where - showref = inRepo $ Git.pipeRead [Param "show-ref", - Param "--hash", -- get the hash - Param $ show branch] - process [] = Nothing - process s = Just $ Git.Ref $ firstLine s - {- Does origin/git-annex exist? -} hasOrigin :: Annex Bool -hasOrigin = refExists originname +hasOrigin = inRepo $ Git.Ref.exists originname -{- Does the git-annex branch or a foo/git-annex branch exist? -} -hasSomeBranch :: Annex Bool -hasSomeBranch = not . null <$> siblingBranches +{- Does the git-annex branch or a sibling foo/git-annex branch exist? -} +hasSibling :: Annex Bool +hasSibling = not . null <$> siblingBranches {- List of git-annex (refs, branches), including the main one and any - from remotes. Duplicate refs are filtered out. -} siblingBranches :: Annex [(Git.Ref, Git.Branch)] -siblingBranches = do - r <- inRepo $ Git.pipeRead [Param "show-ref", Param $ show name] - return $ nubBy uref $ map (gen . words . L.unpack) (L.lines r) - where - gen l = (Git.Ref $ head l, Git.Ref $ last l) - uref (a, _) (b, _) = a == b +siblingBranches = inRepo $ Git.Ref.matching name {- Applies a function to modifiy the content of a file. - diff --git a/Command/Unused.hs b/Command/Unused.hs index be0107752..cd1cd1602 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -20,6 +20,7 @@ import Utility.TempFile import Logs.Location import qualified Annex import qualified Git +import qualified Git.Ref import qualified Git.LsFiles as LsFiles import qualified Git.LsTree as LsTree import qualified Backend @@ -190,7 +191,7 @@ getKeysReferenced = do {- List of keys referenced by symlinks in a git ref. -} getKeysReferencedInGit :: Git.Ref -> Annex [Key] getKeysReferencedInGit ref = do - showAction $ "checking " ++ Git.refDescribe ref + showAction $ "checking " ++ Git.Ref.describe ref findkeys [] =<< inRepo (LsTree.lsTree ref) where findkeys c [] = return c @@ -24,7 +24,6 @@ module Git ( repoIsHttp, repoIsLocalBare, repoDescribe, - refDescribe, repoLocation, workTree, workTreeFile, @@ -178,14 +177,6 @@ repoDescribe Repo { location = Url url } = show url repoDescribe Repo { location = Dir dir } = dir repoDescribe Repo { location = Unknown } = "UNKNOWN" -{- Converts a fully qualified git ref into a user-visible version. -} -refDescribe :: Ref -> String -refDescribe = remove "refs/heads/" . remove "refs/remotes/" . show - where - remove prefix s - | prefix `isPrefixOf` s = drop (length prefix) s - | otherwise = s - {- Location of the repo, either as a path or url. -} repoLocation :: Repo -> String repoLocation Repo { location = Url url } = show url @@ -463,16 +454,16 @@ shaSize :: Int shaSize = 40 {- Commits the index into the specified branch (or other ref), - - with the specified parent refs, and returns the new ref -} -commit :: String -> Ref -> [Ref] -> Repo -> IO Ref -commit message newref parentrefs repo = do + - with the specified parent refs, and returns the committed sha -} +commit :: String -> Branch -> [Ref] -> Repo -> IO Sha +commit message branch parentrefs repo = do tree <- getSha "write-tree" $ asString $ pipeRead [Param "write-tree"] repo sha <- getSha "commit-tree" $ asString $ ignorehandle $ pipeWriteRead (map Param $ ["commit-tree", show tree] ++ ps) (L.pack message) repo - run "update-ref" [Param $ show newref, Param $ show sha] repo + run "update-ref" [Param $ show branch, Param $ show sha] repo return sha where ignorehandle a = snd <$> a diff --git a/Git/Ref.hs b/Git/Ref.hs new file mode 100644 index 000000000..723bea681 --- /dev/null +++ b/Git/Ref.hs @@ -0,0 +1,47 @@ +{- git ref stuff + - + - Copyright 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Git.Ref where + +import qualified Data.ByteString.Lazy.Char8 as L + +import Common +import Git + +{- Converts a fully qualified git ref into a user-visible version. -} +describe :: Ref -> String +describe = remove "refs/heads/" . remove "refs/remotes/" . show + where + remove prefix s + | prefix `isPrefixOf` s = drop (length prefix) s + | otherwise = s + +{- Checks if a ref exists. -} +exists :: Ref -> Repo -> IO Bool +exists ref = runBool "show-ref" + [Param "--verify", Param "-q", Param $ show ref] + +{- Get the sha of a fully qualified git ref, if it exists. -} +sha :: Branch -> Repo -> IO (Maybe Sha) +sha branch repo = process . L.unpack <$> showref repo + where + showref = pipeRead [Param "show-ref", + Param "--hash", -- get the hash + Param $ show branch] + process [] = Nothing + process s = Just $ Ref $ firstLine s + +{- List of (refs, branches) matching a given ref spec. + - Duplicate refs are filtered out. -} +matching :: Ref -> Repo -> IO [(Git.Ref, Git.Branch)] +matching ref repo = do + r <- Git.pipeRead [Param "show-ref", Param $ show ref] repo + return $ nubBy uref $ map (gen . words . L.unpack) (L.lines r) + where + gen l = (Git.Ref $ head l, Git.Ref $ last l) + uref (a, _) (b, _) = a == b + @@ -39,7 +39,7 @@ ensureInitialized :: Annex () ensureInitialized = getVersion >>= maybe needsinit checkVersion where needsinit = do - annexed <- Annex.Branch.hasSomeBranch + annexed <- Annex.Branch.hasSibling if annexed then initialize Nothing else error "First run: git-annex init" diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs index 08bf83e83..3440d504b 100644 --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -9,6 +9,7 @@ module Upgrade.V2 where import Common.Annex import qualified Git +import qualified Git.Ref import qualified Annex.Branch import Logs.Location import Annex.Content @@ -86,7 +87,7 @@ logFiles dir = return . filter (".log" `isSuffixOf`) push :: Annex () push = do - origin_master <- Annex.Branch.refExists $ Git.Ref "origin/master" + origin_master <- inRepo $ Git.Ref.exists $ Git.Ref "origin/master" origin_gitannex <- Annex.Branch.hasOrigin case (origin_master, origin_gitannex) of (_, True) -> do |