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.
This commit is contained in:
Joey Hess 2011-11-16 02:23:34 -04:00
parent 272a67921c
commit 9290095fc2
10 changed files with 86 additions and 71 deletions

36
Git.hs
View file

@ -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 -}
refDescribe :: String -> String
refDescribe = remove "refs/heads/" . remove "refs/remotes/"
{- 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
@ -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