summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-12-12 18:23:24 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-12-12 18:30:33 -0400
commit543d0d250104c1f5908e1b7b258d36d95488a029 (patch)
tree7342d994ac8932ed92b1e14108fdc6bb8e84d84e
parentda95cbadca5b7ef3058b91a384d5f3a48cc39039 (diff)
split out Git/Ref.hs
-rw-r--r--Annex/Branch.hs57
-rw-r--r--Command/Unused.hs3
-rw-r--r--Git.hs17
-rw-r--r--Git/Ref.hs47
-rw-r--r--Init.hs2
-rw-r--r--Upgrade/V2.hs3
6 files changed, 75 insertions, 54 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index 1dac8ef79..c8a538acd 100644
--- a/Annex/Branch.hs
+++ b/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.
-
diff --git a/Command/Unused.hs b/Command/Unused.hs
index be0107752..cd1cd1602 100644
--- a/Command/Unused.hs
+++ b/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
diff --git a/Git.hs b/Git.hs
index 1da5997c1..9af68a194 100644
--- a/Git.hs
+++ b/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
diff --git a/Git/Ref.hs b/Git/Ref.hs
new file mode 100644
index 000000000..723bea681
--- /dev/null
+++ b/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
+
diff --git a/Init.hs b/Init.hs
index d03e10031..c8deadf3b 100644
--- a/Init.hs
+++ 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"
diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs
index 08bf83e83..3440d504b 100644
--- a/Upgrade/V2.hs
+++ b/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