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:
parent
272a67921c
commit
9290095fc2
10 changed files with 86 additions and 71 deletions
36
Git.hs
36
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 -}
|
||||
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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue