improve type signatures with a Ref newtype

In git, a Ref can be a Sha, or a Branch, or a Tag. I added type aliases for
those. Note that this does not prevent mixing up of eg, refs and branches
at the type level. Since git really doesn't care, except rare cases like
git update-ref, or git tag -d, that seems ok for now.

There's also a tree-ish, but let's just use Ref for it. A given Sha or Ref
may or may not be a tree-ish, depending on the object type, so there seems
no point in trying to represent it at the type level.

Annex/Branch.hs

@@ -31,19 +31,17 @@ import qualified Git.UnionMerge
 import qualified Annex
 import Annex.CatFile
 
-type GitRef = String
-
 {- Name of the branch that is used to store git-annex's information. -}
-name :: GitRef
+name :: Git.Ref
-name = "git-annex"
+name = Git.Ref "git-annex"
 
 {- Fully qualified name of the branch. -}
-fullname :: GitRef
+fullname :: Git.Ref
-fullname = "refs/heads/" ++ name
+fullname = Git.Ref $ "refs/heads/" ++ show name
 
 {- Branch's name in origin. -}
-originname :: GitRef
+originname :: Git.Ref
-originname = "origin/" ++ name
+originname = Git.Ref $ "origin/" ++ show name
 
 {- A separate index file for the branch. -}
 index :: Git.Repo -> FilePath
@@ -104,7 +102,8 @@ create :: Annex ()
 create = unlessM hasBranch $ do
 	e <- hasOrigin
 	if e
-		then inRepo $ Git.run "branch" [Param name, Param originname]
+		then inRepo $ Git.run "branch"
+			[Param $ show name, Param $ show originname]
 		else withIndex' True $
 			inRepo $ Git.commit "branch created" fullname []
 
@@ -140,8 +139,8 @@ update = onceonly $ do
 		let merge_desc = if null branches
 			then "update" 
 			else "merging " ++
-				(unwords $ map Git.refDescribe branches) ++ 
+				(unwords $ map (show . Git.refDescribe) branches) ++ 
-				" into " ++ name
+				" into " ++ show name
 		unless (null branches) $ do
 			showSideAction merge_desc
 			{- Note: This merges the branches into the index.
@@ -164,12 +163,12 @@ update = onceonly $ do
 
 {- Checks if the second branch has any commits not present on the first
  - branch. -}
-changedBranch :: String -> String -> Annex Bool
+changedBranch :: Git.Branch -> Git.Branch -> Annex Bool
 changedBranch origbranch newbranch = not . L.null <$> diffs
 	where
 		diffs = inRepo $ Git.pipeRead
 			[ Param "log"
-			, Param (origbranch ++ ".." ++ newbranch)
+			, Param (show origbranch ++ ".." ++ show newbranch)
 			, Params "--oneline -n1"
 			]
 
@@ -181,7 +180,7 @@ changedBranch origbranch newbranch = not . L.null <$> diffs
  - every commit present in all the other refs, as well as in the
  - git-annex branch.
  -}
-tryFastForwardTo :: [String] -> Annex Bool
+tryFastForwardTo :: [Git.Ref] -> Annex Bool
 tryFastForwardTo [] = return True
 tryFastForwardTo (first:rest) = do
 	-- First, check that the git-annex branch does not contain any
@@ -194,7 +193,7 @@ tryFastForwardTo (first:rest) = do
 	where
 		no_ff = return False
 		do_ff branch = do
-			inRepo $ Git.run "update-ref" [Param fullname, Param branch]
+			inRepo $ Git.run "update-ref" [Param $ show fullname, Param $ show branch]
 			return True
 		findbest c [] = return $ Just c
 		findbest c (r:rs)
@@ -220,9 +219,9 @@ disableUpdate = Annex.changeState setupdated
 				old = Annex.branchstate s
 
 {- Checks if a git ref exists. -}
-refExists :: GitRef -> Annex Bool
+refExists :: Git.Ref -> Annex Bool
 refExists ref = inRepo $ Git.runBool "show-ref"
-	[Param "--verify", Param "-q", Param ref]
+	[Param "--verify", Param "-q", Param $ show ref]
 
 {- Does the main git-annex branch exist? -}
 hasBranch :: Annex Bool
@@ -238,12 +237,12 @@ hasSomeBranch = not . null <$> siblingBranches
 
 {- List of git-annex (refs, branches), including the main one and any
  - from remotes. Duplicate refs are filtered out. -}
-siblingBranches :: Annex [(String, String)]
+siblingBranches :: Annex [(Git.Ref, Git.Branch)]
 siblingBranches = do
-	r <- inRepo $ Git.pipeRead [Param "show-ref", Param name]
+	r <- inRepo $ Git.pipeRead [Param "show-ref", Param $ show name]
-	return $ nubBy uref $ map (pair . words . L.unpack) (L.lines r)
+	return $ nubBy uref $ map (gen . words . L.unpack) (L.lines r)
 	where
-		pair l = (head l, last l)
+		gen l = (Git.Ref $ head l, Git.Ref $ last l)
 		uref (a, _) (b, _) = a == b
 
 {- Applies a function to modifiy the content of a file.
@@ -291,7 +290,7 @@ get' staleok file = fromcache =<< getCache file
 files :: Annex [FilePath]
 files = withIndexUpdate $ do
 	bfiles <- inRepo $ Git.pipeNullSplit
-		[Params "ls-tree --name-only -r -z", Param fullname]
+		[Params "ls-tree --name-only -r -z", Param $ show fullname]
 	jfiles <- getJournalledFiles
 	return $ jfiles ++ bfiles
 
@@ -346,10 +345,10 @@ stageJournalFiles = do
 			hClose toh
 			exitSuccess
 		hClose toh
-		s <- hGetContents fromh
+		shas <- map Git.Ref . lines <$> hGetContents fromh
 		-- update the index, also in just one command
 		Git.UnionMerge.update_index g $
-			index_lines (lines s) $ map fileJournal fs
+			index_lines shas (map fileJournal fs)
 		hClose fromh
 		forceSuccess pid
 		mapM_ removeFile paths

Annex/CatFile.hs

@@ -13,10 +13,11 @@ module Annex.CatFile (
 import qualified Data.ByteString.Lazy.Char8 as L
 
 import Common.Annex
+import qualified Git
 import qualified Git.CatFile
 import qualified Annex
 
-catFile :: String -> FilePath -> Annex L.ByteString
+catFile :: Git.Branch -> FilePath -> Annex L.ByteString
 catFile branch file = do
 	h <- catFileHandle
 	liftIO $ Git.CatFile.catFile h branch file

Command/Uninit.hs

@@ -26,9 +26,9 @@ check :: Annex ()
 check = do
 	b <- current_branch	
 	when (b == Annex.Branch.name) $ error $
-		"cannot uninit when the " ++ b ++ " branch is checked out"
+		"cannot uninit when the " ++ show b ++ " branch is checked out"
 	where
-		current_branch = head . lines . B.unpack <$> revhead
+		current_branch = Git.Ref . head . lines . B.unpack <$> revhead
 		revhead = inRepo $ Git.pipeRead 
 			[Params "rev-parse --abbrev-ref HEAD"]
 
@@ -57,5 +57,5 @@ cleanup = do
 	liftIO $ removeDirectoryRecursive annexdir
 	-- avoid normal shutdown
 	saveState
-	inRepo $ Git.run "branch" [Param "-D", Param Annex.Branch.name]
+	inRepo $ Git.run "branch" [Param "-D", Param $ show Annex.Branch.name]
 	liftIO exitSuccess

Command/Unused.hs

@@ -152,12 +152,13 @@ excludeReferenced l = do
 		(S.fromList l)
 	where
 		-- Skip the git-annex branches, and get all other unique refs.
-		refs = map last .
+		refs = map Git.Ref . 
+			last .
 			nubBy cmpheads .
 			filter ourbranches .
 			map words . lines . L.unpack
 		cmpheads a b = head a == head b
-		ourbranchend = '/' : Annex.Branch.name
+		ourbranchend = '/' : show (Annex.Branch.name)
 		ourbranches ws = not $ ourbranchend `isSuffixOf` last ws
 		removewith [] s = return $ S.toList s
 		removewith (a:as) s
@@ -188,7 +189,7 @@ getKeysReferenced = do
 	return $ map fst $ catMaybes keypairs
 
 {- List of keys referenced by symlinks in a git ref. -}
-getKeysReferencedInGit :: String -> Annex [Key]
+getKeysReferencedInGit :: Git.Ref -> Annex [Key]
 getKeysReferencedInGit ref = do
 	showAction $ "checking " ++ Git.refDescribe ref
 	findkeys [] =<< inRepo (LsTree.lsTree ref)

Git.hs

@@ -10,6 +10,10 @@
 
 module Git (
 	Repo,
+	Ref(..),
+	Branch,
+	Sha,
+	Tag,
 	repoFromCwd,
 	repoFromAbsPath,
 	repoFromUnknown,
@@ -94,6 +98,18 @@ data Repo = Repo {
 	remoteName :: Maybe String 
 } deriving (Show, Eq)
 
+{- A git ref. Can be a sha1, or a branch or tag name. -}
+newtype Ref = Ref String
+	deriving (Eq)
+
+instance Show Ref where
+	show (Ref v) = v
+
+{- Aliases for Ref. -}
+type Branch = Ref
+type Sha = Ref
+type Tag = Ref
+
 newFrom :: RepoLocation -> Repo
 newFrom l = 
 	Repo {
@@ -162,9 +178,9 @@ 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 -}
+{- Converts a fully qualified git ref into a user-visible version. -}
-refDescribe :: String -> String
+refDescribe :: Ref -> String
-refDescribe = remove "refs/heads/" . remove "refs/remotes/"
+refDescribe = remove "refs/heads/" . remove "refs/remotes/" . show
 	where
 		remove prefix s
 			| prefix `isPrefixOf` s = drop (length prefix) s
@@ -432,7 +448,7 @@ useIndex index = do
 
 {- Runs an action that causes a git subcommand to emit a sha, and strips
    any trailing newline, returning the sha. -}
-getSha :: String -> IO String -> IO String
+getSha :: String -> IO String -> IO Sha
 getSha subcommand a = do
 	t <- a
 	let t' = if last t == '\n'
@@ -440,27 +456,27 @@ getSha subcommand a = do
 		else t
 	when (length t' /= shaSize) $
 		error $ "failed to read sha from git " ++ subcommand ++ " (" ++ t' ++ ")"
-	return t'
+	return $ Ref t'
 
 {- Size of a git sha. -}
 shaSize :: Int
 shaSize = 40
 
-{- Commits the index into the specified branch, 
+{- Commits the index into the specified branch (or other ref), 
  - with the specified parent refs. -}
-commit :: String -> String -> [String] -> Repo -> IO ()
+commit :: String -> Ref -> [Ref] -> Repo -> IO ()
 commit message newref parentrefs repo = do
 	tree <- getSha "write-tree" $ asString $
 		pipeRead [Param "write-tree"] repo
 	sha <- getSha "commit-tree" $ asString $
 		ignorehandle $ pipeWriteRead
-			(map Param $ ["commit-tree", tree] ++ ps)
+			(map Param $ ["commit-tree", show tree] ++ ps)
 			(L.pack message) repo
-	run "update-ref" [Param newref, Param sha] repo
+	run "update-ref" [Param $ show newref, Param $ show sha] repo
 	where
 		ignorehandle a = snd <$> a
 		asString a = L.unpack <$> a
-		ps = concatMap (\r -> ["-p", r]) parentrefs
+		ps = concatMap (\r -> ["-p", show r]) parentrefs
 
 {- Runs git config and populates a repo with its config. -}
 configRead :: Repo -> IO Repo

Git/CatFile.hs

@@ -37,14 +37,14 @@ catFileStop (pid, from, to) = do
 	forceSuccess pid
 
 {- Reads a file from a specified branch. -}
-catFile :: CatFileHandle -> String -> FilePath -> IO L.ByteString
+catFile :: CatFileHandle -> Branch -> FilePath -> IO L.ByteString
-catFile h branch file = catObject h (branch ++ ":" ++ file)
+catFile h branch file = catObject h $ Ref $ show branch ++ ":" ++ file
 
 {- Uses a running git cat-file read the content of an object.
  - Objects that do not exist will have "" returned. -}
-catObject :: CatFileHandle -> String -> IO L.ByteString
+catObject :: CatFileHandle -> Ref -> IO L.ByteString
 catObject (_, from, to) object = do
-	hPutStrLn to object
+	hPutStrLn to $ show object
 	hFlush to
 	header <- hGetLine from
 	case words header of
@@ -53,7 +53,7 @@ catObject (_, from, to) object = do
 			  validobjtype objtype -> handle size
 			| otherwise -> empty
 		_
-			| header == object ++ " missing" -> empty
+			| header == show object ++ " missing" -> empty
 			| otherwise -> error $ "unknown response from git cat-file " ++ header
 	where
 		handle size = case reads size of

Git/LsTree.hs

@@ -19,8 +19,6 @@ import qualified Data.ByteString.Lazy.Char8 as L
 import Git
 import Utility.SafeCommand
 
-type Treeish = String
-
 data TreeItem = TreeItem
 	{ mode :: FileMode
 	, typeobj :: String
@@ -28,10 +26,10 @@ data TreeItem = TreeItem
 	, file :: FilePath
 	} deriving Show
 
-{- Lists the contents of a Treeish -}
+{- Lists the contents of a Ref -}
-lsTree :: Treeish -> Repo -> IO [TreeItem]
+lsTree :: Ref -> Repo -> IO [TreeItem]
 lsTree t repo = map parseLsTree <$>
-	pipeNullSplitB [Params "ls-tree --full-tree -z -r --", File t] repo
+	pipeNullSplitB [Params "ls-tree --full-tree -z -r --", File $ show t] repo
 
 {- Parses a line of ls-tree output.
  - (The --long format is not currently supported.) -}

Git/UnionMerge.hs

@@ -22,12 +22,14 @@ import Common
 import Git
 import Git.CatFile
 
+type Streamer = (String -> IO ()) -> IO ()
+
 {- Performs a union merge between two branches, staging it in the index.
  - Any previously staged changes in the index will be lost.
  -
  - Should be run with a temporary index file configured by Git.useIndex.
  -}
-merge :: String -> String -> Repo -> IO ()
+merge :: Ref -> Ref -> Repo -> IO ()
 merge x y repo = do
 	h <- catFileStart repo
 	stream_update_index repo
@@ -38,7 +40,7 @@ merge x y repo = do
 
 {- Merges a list of branches into the index. Previously staged changed in
  - the index are preserved (and participate in the merge). -}
-merge_index :: CatFileHandle -> Repo -> [String] -> IO ()
+merge_index :: CatFileHandle -> Repo -> [Ref] -> IO ()
 merge_index h repo bs =
 	stream_update_index repo $ map (\b -> merge_tree_index b h repo) bs
 
@@ -48,8 +50,6 @@ merge_index h repo bs =
 update_index :: Repo -> [String] -> IO ()
 update_index repo ls = stream_update_index repo [\s -> mapM_ s ls]
 
-type Streamer = (String -> IO ()) -> IO ()
-
 {- Streams content into update-index. -}
 stream_update_index :: Repo -> [Streamer] -> IO ()
 stream_update_index repo as = do
@@ -66,22 +66,22 @@ stream_update_index repo as = do
 
 {- Generates a line suitable to be fed into update-index, to add
  - a given file with a given sha. -}
-update_index_line :: String -> FilePath -> String
+update_index_line :: Sha -> FilePath -> String
-update_index_line sha file = "100644 blob " ++ sha ++ "\t" ++ file
+update_index_line sha file = "100644 blob " ++ show sha ++ "\t" ++ file
 
-{- Gets the contents of a tree. -}
+{- Gets the current tree for a ref. -}
-ls_tree :: String -> Repo -> Streamer
+ls_tree :: Ref -> Repo -> Streamer
-ls_tree x repo streamer = mapM_ streamer =<< pipeNullSplit params repo
+ls_tree (Ref x) repo streamer = mapM_ streamer =<< pipeNullSplit params repo
 	where
 		params = map Param ["ls-tree", "-z", "-r", "--full-tree", x]
 
 {- For merging two trees. -}
-merge_trees :: String -> String -> CatFileHandle -> Repo -> Streamer
+merge_trees :: Ref -> Ref -> CatFileHandle -> Repo -> Streamer
-merge_trees x y h = calc_merge h $ "diff-tree":diff_opts ++ [x, y]
+merge_trees (Ref x) (Ref y) h = calc_merge h $ "diff-tree":diff_opts ++ [x, y]
 
 {- For merging a single tree into the index. -}
-merge_tree_index :: String -> CatFileHandle -> Repo -> Streamer
+merge_tree_index :: Ref -> CatFileHandle -> Repo -> Streamer
-merge_tree_index x h = calc_merge h $ "diff-index":diff_opts ++ ["--cached", x]
+merge_tree_index (Ref x) h = calc_merge h $ "diff-index":diff_opts ++ ["--cached", x]
 
 diff_opts :: [String]
 diff_opts = ["--raw", "-z", "-r", "--no-renames", "-l0"]
@@ -101,7 +101,7 @@ calc_merge ch differ repo streamer = gendiff >>= go
  - a line suitable for update_index that union merges the two sides of the
  - diff. -}
 mergeFile :: String -> FilePath -> CatFileHandle -> Repo -> IO (Maybe String)
-mergeFile info file h repo = case filter (/= nullsha) [asha, bsha] of
+mergeFile info file h repo = case filter (/= nullsha) [Ref asha, Ref bsha] of
 	[] -> return Nothing
 	(sha:[]) -> return $ Just $ update_index_line sha file
 	shas -> do
@@ -110,11 +110,11 @@ mergeFile info file h repo = case filter (/= nullsha) [asha, bsha] of
 		return $ Just $ update_index_line sha file
 	where
 		[_colonamode, _bmode, asha, bsha, _status] = words info
-		nullsha = replicate shaSize '0'
+		nullsha = Ref $ replicate shaSize '0'
 		unionmerge = L.unlines . nub . L.lines
 
-{- Injects some content into git, returning its hash. -}
+{- Injects some content into git, returning its Sha. -}
-hashObject :: L.ByteString -> Repo -> IO String
+hashObject :: L.ByteString -> Repo -> IO Sha
 hashObject content repo = getSha subcmd $ do
 	(h, s) <- pipeWriteRead (map Param params) content repo
 	L.length s `seq` do

Upgrade/V2.hs

@@ -86,7 +86,7 @@ logFiles dir = return . filter (".log" `isSuffixOf`)
 
 push :: Annex ()
 push = do
-	origin_master <- Annex.Branch.refExists "origin/master"
+	origin_master <- Annex.Branch.refExists $ Git.Ref "origin/master"
 	origin_gitannex <- Annex.Branch.hasOrigin
 	case (origin_master, origin_gitannex) of
 		(_, True) -> do
@@ -103,7 +103,7 @@ push = do
 			Annex.Branch.update -- just in case
 			showAction "pushing new git-annex branch to origin"
 			showOutput
-			inRepo $ Git.run "push" [Param "origin", Param Annex.Branch.name]
+			inRepo $ Git.run "push" [Param "origin", Param $ show Annex.Branch.name]
 		_ -> do
 			-- no origin exists, so just let the user
 			-- know about the new branch

git-union-merge.hs

@@ -37,7 +37,7 @@ parseArgs = do
 
 main :: IO ()
 main = do
-	[aref, bref, newref] <- parseArgs
+	[aref, bref, newref] <- map Git.Ref <$> parseArgs
 	g <- Git.configRead =<< Git.repoFromCwd
 	_ <- Git.useIndex (tmpIndex g)
 	setup g