From 15ffb8b60e26bd8707c132f2452cb4adbe7e6d02 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 4 Mar 2015 15:25:13 -0400
Subject: sync: Fix committing when in a direct mode repo that has no HEAD ref.

Seen for example, a newly checked out git submodule. In this case,
.git/HEAD is a raw sha, rather than the usual reference to a ref.

Removed currentSha in passing, since it was a more roundabout way of
doing what headSha does, and headSha is more robust.
---
 Command/Proxy.hs |  4 ++--
 Command/Sync.hs  | 18 +++++++++---------
 Git/Branch.hs    |  3 ---
 Git/Ref.hs       |  3 +++
 debian/changelog |  2 ++
 5 files changed, 16 insertions(+), 14 deletions(-)

diff --git a/Command/Proxy.hs b/Command/Proxy.hs
index 59a6bf959..9ccea5796 100644
--- a/Command/Proxy.hs
+++ b/Command/Proxy.hs
@@ -13,8 +13,8 @@ import Config
 import Utility.Tmp
 import Utility.Env
 import Annex.Direct
-import qualified Git.Branch
 import qualified Git.Sha
+import qualified Git.Ref
 
 cmd :: [Command]
 cmd = [notBareRepo $
@@ -35,7 +35,7 @@ start (c:ps) = liftIO . exitWith =<< ifM isDirect
   where
 	go tmp = do
 		oldref <- fromMaybe Git.Sha.emptyTree
-			<$> inRepo Git.Branch.currentSha
+			<$> inRepo Git.Ref.headSha
 		exitcode <- liftIO $ proxy tmp
 		mergeDirectCleanup tmp oldref
 		return exitcode
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 103f93e32..130693909 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -174,15 +174,15 @@ commitMsg = do
 	return $ "git-annex in " ++ fromMaybe "unknown" (M.lookup u m)
 
 commitStaged :: Git.Branch.CommitMode -> String -> Annex Bool
-commitStaged commitmode commitmessage = go =<< inRepo Git.Branch.currentUnsafe
-  where
-	go Nothing = return False
-	go (Just branch) = do
-		runAnnexHook preCommitAnnexHook
-		parent <- inRepo $ Git.Ref.sha branch
-		void $ inRepo $ Git.Branch.commit commitmode False commitmessage branch
-			(maybeToList parent)
-		return True
+commitStaged commitmode commitmessage = do
+	runAnnexHook preCommitAnnexHook
+	mb <- inRepo Git.Branch.currentUnsafe
+	let (getparent, branch) = case mb of
+		Just b -> (Git.Ref.sha b, b)
+		Nothing -> (Git.Ref.headSha, Git.Ref.headRef)
+	parents <- maybeToList <$> inRepo getparent
+	void $ inRepo $ Git.Branch.commit commitmode False commitmessage branch parents
+	return True
 
 mergeLocal :: Maybe Git.Ref -> CommandStart
 mergeLocal Nothing = stop
diff --git a/Git/Branch.hs b/Git/Branch.hs
index 523c641d7..a2225dc73 100644
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -43,9 +43,6 @@ currentUnsafe r = parse . firstLine
 		| null l = Nothing
 		| otherwise = Just $ Git.Ref l
 
-currentSha :: Repo -> IO (Maybe Git.Sha)
-currentSha r = maybe (pure Nothing) (`Git.Ref.sha` r) =<< current r
-
 {- Checks if the second branch has any commits not present on the first
  - branch. -}
 changed :: Branch -> Branch -> Repo -> IO Bool
diff --git a/Git/Ref.hs b/Git/Ref.hs
index 5ad7577ff..6bc47d5ed 100644
--- a/Git/Ref.hs
+++ b/Git/Ref.hs
@@ -88,6 +88,9 @@ sha branch repo = process <$> showref repo
 	process [] = Nothing
 	process s = Just $ Ref $ firstLine s
 
+headSha :: Repo -> IO (Maybe Sha)
+headSha = sha headRef
+
 {- List of (shas, branches) matching a given ref or refs. -}
 matching :: [Ref] -> Repo -> IO [(Sha, Branch)]
 matching refs repo =  matching' (map fromRef refs) repo
diff --git a/debian/changelog b/debian/changelog
index 921c0ff4a..315bd8055 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -27,6 +27,8 @@ git-annex (5.2015022) UNRELEASED; urgency=medium
     (or '!') character.
   * Also potentially fixes encoding problem when embedding credentials
     that contain unicode characters.
+  * sync: Fix committing when in a direct mode repo that has no HEAD ref.
+    (For example, a newly checked out git submodule.)
 
  -- Joey Hess <id@joeyh.name>  Thu, 19 Feb 2015 14:16:03 -0400
 
-- 
cgit v1.2.3