summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/Branch.hs47
-rw-r--r--Annex/CatFile.hs3
-rw-r--r--Command/Uninit.hs6
-rw-r--r--Command/Unused.hs7
-rw-r--r--Git.hs36
-rw-r--r--Git/CatFile.hs10
-rw-r--r--Git/LsTree.hs8
-rw-r--r--Git/UnionMerge.hs34
-rw-r--r--Upgrade/V2.hs4
-rw-r--r--git-union-merge.hs2
10 files changed, 86 insertions, 71 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index a75773e19..a62a1384c 100644
--- a/Annex/Branch.hs
+++ b/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-annex"
+name :: Git.Ref
+name = Git.Ref "git-annex"
{- Fully qualified name of the branch. -}
-fullname :: GitRef
-fullname = "refs/heads/" ++ name
+fullname :: Git.Ref
+fullname = Git.Ref $ "refs/heads/" ++ show name
{- Branch's name in origin. -}
-originname :: GitRef
-originname = "origin/" ++ name
+originname :: Git.Ref
+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) ++
- " into " ++ name
+ (unwords $ map (show . Git.refDescribe) branches) ++
+ " 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]
- return $ nubBy uref $ map (pair . words . L.unpack) (L.lines r)
+ r <- inRepo $ Git.pipeRead [Param "show-ref", Param $ show name]
+ 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
diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs
index 0541f7269..1d996edfd 100644
--- a/Annex/CatFile.hs
+++ b/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
diff --git a/Command/Uninit.hs b/Command/Uninit.hs
index ca18c478c..48f5b1ac1 100644
--- a/Command/Uninit.hs
+++ b/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
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 34d8ac232..ccb9c48d8 100644
--- a/Command/Unused.hs
+++ b/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)
diff --git a/Git.hs b/Git.hs
index 3f3f74632..ba5d831fe 100644
--- a/Git.hs
+++ b/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
diff --git a/Git/CatFile.hs b/Git/CatFile.hs
index 83c123508..c1cafb8ba 100644
--- a/Git/CatFile.hs
+++ b/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 h branch file = catObject h (branch ++ ":" ++ file)
+catFile :: CatFileHandle -> Branch -> FilePath -> IO L.ByteString
+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
diff --git a/Git/LsTree.hs b/Git/LsTree.hs
index 1fcdf13ed..8aa16a308 100644
--- a/Git/LsTree.hs
+++ b/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 -}
-lsTree :: Treeish -> Repo -> IO [TreeItem]
+{- Lists the contents of a Ref -}
+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.) -}
diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs
index 60ccd6dcd..edc8cb20b 100644
--- a/Git/UnionMerge.hs
+++ b/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 file = "100644 blob " ++ sha ++ "\t" ++ file
+update_index_line :: Sha -> FilePath -> String
+update_index_line sha file = "100644 blob " ++ show sha ++ "\t" ++ file
-{- Gets the contents of a tree. -}
-ls_tree :: String -> Repo -> Streamer
-ls_tree x repo streamer = mapM_ streamer =<< pipeNullSplit params repo
+{- Gets the current tree for a ref. -}
+ls_tree :: Ref -> Repo -> Streamer
+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 x y h = calc_merge h $ "diff-tree":diff_opts ++ [x, y]
+merge_trees :: Ref -> Ref -> CatFileHandle -> Repo -> Streamer
+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 x h = calc_merge h $ "diff-index":diff_opts ++ ["--cached", x]
+merge_tree_index :: Ref -> CatFileHandle -> Repo -> Streamer
+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. -}
-hashObject :: L.ByteString -> Repo -> IO String
+{- Injects some content into git, returning its Sha. -}
+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
diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs
index 6a46ad8a1..e76d99b3e 100644
--- a/Upgrade/V2.hs
+++ b/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
diff --git a/git-union-merge.hs b/git-union-merge.hs
index 10ae84217..1cec4a0f8 100644
--- a/git-union-merge.hs
+++ b/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
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-19 07:01:54 +0000