split out Git/Ref.hs

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.
  -

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

Git.hs

@@ -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

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
+

Init.hs

@@ -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"

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