add --merge

debian/changelog

@@ -15,6 +15,8 @@ propellor (1.1.0) UNRELEASED; urgency=medium
   * hasSomePassword and hasPassword now default to using the name of the
     host as the Context for the password. To specify a different context,
     use hasSomePassword' and hasPassword' (API change)
+  * Add --merge, to combine multiple --spin commits into a single, more useful
+    commit.
 
  -- Joey Hess <joeyh@debian.org>  Sat, 22 Nov 2014 00:12:35 -0400
 

doc/usage.mdwn

@@ -65,6 +65,22 @@ action as needed to satisfy the configured properties of the local host.
 
   Opens $EDITOR on the privdata value.
 
+* --merge
+
+  Combine multiple --spin commits into a single, more useful commit.
+
+  When using propellor, you may find yourself repeatedly running
+  `propellor --spin` until you get things working the way you like.
+  This results in a lot of git commits being made, with incremental
+  changes.
+  
+  To clean that up to a single commit, use `propellor --merge`. A normal
+  interactive git commit will then be made, consisting of all changes
+  that have been previously committed by --spin, since the last time a
+  normal git commit was made.
+
+  (This will result in a trapezoid pattern in gitk.)
+
 * hostname
 
   When run with a hostname and no other options, propellor will

src/Propellor/CmdLine.hs

@@ -29,6 +29,7 @@ usage h = hPutStrLn h $ unlines
 	, "  propellor --dump field context"
 	, "  propellor --edit field context"
 	, "  propellor --list-fields"
+	, "  propellor --merge"
 	]
 
 usageError :: [String] -> IO a
@@ -49,6 +50,7 @@ processCmdLine = go =<< getArgs
 	go ("--dump":f:c:[]) = withprivfield f c Dump
 	go ("--edit":f:c:[]) = withprivfield f c Edit
 	go ("--list-fields":[]) = return ListFields
+	go ("--merge":[]) = return Merge
 	go ("--help":_) = do	
 		usage stdout
 		exitFailure
@@ -98,6 +100,7 @@ defaultMain hostlist = do
 	go _ (GitPush fin fout) = gitPushHelper fin fout
 	go _ (Update Nothing) = forceConsole >> fetchFirst (onlyprocess (update Nothing))
 	go _ (Update (Just h)) = forceConsole >> fetchFirst (update (Just h))
+	go _ Merge = mergeSpin
 	go True cmdline@(Spin _ _) = buildFirst cmdline $ go False cmdline
 	go True cmdline = updateFirst cmdline $ go False cmdline
 	go False (Spin hs r) = do

src/Propellor/Git.hs

@@ -10,8 +10,13 @@ getCurrentBranch :: IO String
 getCurrentBranch = takeWhile (/= '\n') 
 	<$> readProcess "git" ["symbolic-ref", "--short", "HEAD"]
 
+getCurrentBranchRef :: IO String
+getCurrentBranchRef = takeWhile (/= '\n') 
+	<$> readProcess "git" ["symbolic-ref", "HEAD"]
+
 getCurrentGitSha1 :: String -> IO String
-getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref]
+getCurrentGitSha1 branchref = takeWhile (/= '\n')
+	<$> readProcess "git" ["show-ref", "--hash", branchref]
 
 setRepoUrl :: String -> IO ()
 setRepoUrl "" = return ()

src/Propellor/Gpg.hs

@@ -83,14 +83,18 @@ addKey keyid = exitBool =<< allM (uncurry actionMessage)
 		, Param "propellor addkey"
 		]
 
+-- Adds --gpg-sign if there's a keyring.
+gpgSignParams :: [CommandParam] -> IO [CommandParam]
+gpgSignParams ps = ifM (doesFileExist keyring)
+	( return (ps ++ [Param "--gpg-sign"])
+	, return ps
+	)
+
 -- Automatically sign the commit if there'a a keyring.
 gitCommit :: [CommandParam] -> IO Bool
 gitCommit ps = do
-	k <- doesFileExist keyring
-	boolSystem "git" $ catMaybes $
-		[ Just (Param "commit")
-		, if k then Just (Param "--gpg-sign") else Nothing
-		] ++ map Just ps
+	ps' <- gpgSignParams ps
+	boolSystem "git" (Param "commit" : ps')
 
 gpgDecrypt :: FilePath -> IO String
 gpgDecrypt f = ifM (doesFileExist f)

src/Propellor/Spin.hs

@@ -2,7 +2,8 @@ module Propellor.Spin (
 	commitSpin,
 	spin,
 	update,
-	gitPushHelper
+	gitPushHelper,
+	mergeSpin,
 ) where
 
 import Data.List
@@ -27,7 +28,7 @@ import Utility.SafeCommand
 commitSpin :: IO ()
 commitSpin = do
 	void $ actionMessage "Git commit" $
-		gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
+		gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param spinCommitMessage]
 	-- Push to central origin repo first, if possible.
 	-- The remote propellor will pull from there, which avoids
 	-- us needing to send stuff directly to the remote host.
@@ -269,3 +270,30 @@ gitPushHelper hin hout = void $ fromstdin `concurrently` tostdout
 				B.hPut toh b
 				hFlush toh
 				connect fromh toh
+
+mergeSpin :: IO ()
+mergeSpin = do
+	branch <- getCurrentBranch
+	branchref <- getCurrentBranchRef
+	old_head <- getCurrentGitSha1 branch
+	old_commit <- findLastNonSpinCommit
+	rungit "reset" [Param old_commit]
+	rungit "commit" [Param "-a"]
+	rungit "merge" =<< gpgSignParams [Param "-s", Param "ours", Param old_head]
+	current_commit <- getCurrentGitSha1 branch
+	rungit "update-ref" [Param branchref, Param current_commit]
+	rungit "checkout" [Param branch]
+  where
+	rungit cmd ps = unlessM (boolSystem "git" (Param cmd:ps)) $
+		error ("git " ++ cmd ++ " failed")
+
+findLastNonSpinCommit :: IO String
+findLastNonSpinCommit = do
+	commits <- map (separate (== ' ')) . lines
+		<$> readProcess "git" ["log", "--oneline", "--no-abbrev-commit"]
+	case dropWhile (\(_, msg) -> msg == spinCommitMessage) commits of
+		((sha, _):_) -> return sha
+		_ -> error $ "Did not find any previous commit that was not a " ++ show spinCommitMessage
+
+spinCommitMessage :: String
+spinCommitMessage = "propellor spin"

src/Propellor/Types.hs

@@ -149,6 +149,7 @@ data CmdLine
 	| Edit PrivDataField Context
 	| ListFields
 	| AddKey String
+	| Merge
 	| Serialized CmdLine
 	| Continue CmdLine
 	| Update (Maybe HostName)