Log all git write operations with command, args, and exit code
- Add loggedGit helper that logs 'RUN: git -C <path> <args>' before execution and 'EXIT <code>' after (with stderr on failure) - Refactor gitCommitAll, gitPull, and gitPush to use loggedGit - Add Logger parameter to gitPull and gitPush - Update test call sites and syncRepo to pass Logger
This commit is contained in:
+22
-12
@@ -278,7 +278,7 @@ syncRepo opts logger repo = do
|
||||
("Commit failed in " <> rcPath repo <> " (exit " <> show commitCode <> ")")
|
||||
-- Pull
|
||||
logRepo logger repo ("pulling " <> rcRemote repo <> "/" <> rcBranch repo)
|
||||
(pullCode, pullOut, pullErr) <- gitPull repo
|
||||
(pullCode, pullOut, pullErr) <- gitPull logger repo
|
||||
case pullCode of
|
||||
ExitSuccess -> do
|
||||
let trimmed = T.strip pullOut
|
||||
@@ -303,7 +303,7 @@ syncRepo opts logger repo = do
|
||||
else do
|
||||
logRepo logger repo "sync complete, no conflicts"
|
||||
-- Push local commits to remote
|
||||
(pushCode, pushOut, pushErr) <- gitPush repo
|
||||
(pushCode, pushOut, pushErr) <- gitPush logger repo
|
||||
case pushCode of
|
||||
ExitSuccess ->
|
||||
logRepo logger repo "push succeeded"
|
||||
@@ -321,26 +321,36 @@ syncRepo opts logger repo = do
|
||||
-- | Stage all changes and commit with an auto-generated message.
|
||||
gitCommitAll :: Logger -> FilePath -> IO (ExitCode, Text, Text)
|
||||
gitCommitAll logger repoPath = do
|
||||
(_, _, stageErr) <- runGitIn repoPath ["add", "-A"]
|
||||
(_, _, stageErr) <- loggedGit logger repoPath ["add", "-A"]
|
||||
unless (T.null stageErr) $
|
||||
logInfo logger ("git add stderr: " <> stageErr)
|
||||
hostname <- init <$> readProcess "hostname" [] ""
|
||||
runGitIn repoPath ["commit", "-m", "converge: auto-commit from " <> hostname]
|
||||
loggedGit logger repoPath ["commit", "-m", "converge: auto-commit from " <> hostname]
|
||||
|
||||
-- | Pull from the configured remote and branch.
|
||||
gitPull :: RepoConfig -> IO (ExitCode, Text, Text)
|
||||
gitPull repo =
|
||||
runGitIn
|
||||
(rcPath repo)
|
||||
gitPull :: Logger -> RepoConfig -> IO (ExitCode, Text, Text)
|
||||
gitPull logger repo =
|
||||
loggedGit logger (rcPath repo)
|
||||
["pull", "--rebase", T.unpack (rcRemote repo), T.unpack (rcBranch repo)]
|
||||
|
||||
-- | Push to the configured remote and branch.
|
||||
gitPush :: RepoConfig -> IO (ExitCode, Text, Text)
|
||||
gitPush repo =
|
||||
runGitIn
|
||||
(rcPath repo)
|
||||
gitPush :: Logger -> RepoConfig -> IO (ExitCode, Text, Text)
|
||||
gitPush logger repo =
|
||||
loggedGit logger (rcPath repo)
|
||||
["push", T.unpack (rcRemote repo), T.unpack (rcBranch repo)]
|
||||
|
||||
-- | Run a git command and log the invocation and exit code.
|
||||
loggedGit :: Logger -> FilePath -> [String] -> IO (ExitCode, Text, Text)
|
||||
loggedGit logger repoPath args = do
|
||||
logInfo logger ("RUN: git -C " <> T.pack repoPath <> " " <> T.intercalate " " (map T.pack args))
|
||||
result@(code, _, err) <- runGitIn repoPath args
|
||||
let msg = "EXIT " <> T.pack (show code)
|
||||
details = if code /= ExitSuccess && not (T.null err)
|
||||
then ": " <> T.strip err
|
||||
else ""
|
||||
logInfo logger (msg <> details)
|
||||
pure result
|
||||
|
||||
-- | Check if the repository currently has merge conflicts.
|
||||
hasConflicts :: FilePath -> IO Bool
|
||||
hasConflicts repoPath = do
|
||||
|
||||
+4
-2
@@ -13,6 +13,7 @@ spec :: Spec
|
||||
spec = do
|
||||
describe "gitPull" $ do
|
||||
it "pulls changes from remote 'origin'" $ do
|
||||
logger <- testLogger
|
||||
withTempGitRepoWithRemote $ \local -> do
|
||||
-- Make a second commit on local and push to remote
|
||||
writeFile (local </> "upstream.txt") "pushed to remote"
|
||||
@@ -27,13 +28,14 @@ spec = do
|
||||
countBefore `shouldBe` 1
|
||||
|
||||
let cfg = defaultRepoConfig{rcPath = local}
|
||||
(code, _, _) <- gitPull cfg
|
||||
(code, _, _) <- gitPull logger cfg
|
||||
code `shouldBe` ExitSuccess
|
||||
|
||||
countAfter <- commitCount local
|
||||
countAfter `shouldBe` 2
|
||||
|
||||
it "rebases local commits on top of pulled changes" $ do
|
||||
logger <- testLogger
|
||||
withSystemTempDirectory "converge-test-rebase" $ \tmp -> do
|
||||
let remoteDir = tmp </> "remote.git"
|
||||
let localDir = tmp </> "local"
|
||||
@@ -73,7 +75,7 @@ spec = do
|
||||
-- Pull with --rebase: local commits are rebased on top
|
||||
-- of the fetched remote commit, yielding a linear history.
|
||||
let cfg = defaultRepoConfig{rcPath = localDir}
|
||||
(code, _, _) <- gitPull cfg
|
||||
(code, _, _) <- gitPull logger cfg
|
||||
code `shouldBe` ExitSuccess
|
||||
-- Rebase produces linear history: 3 commits, no merge commit
|
||||
c <- commitCount localDir
|
||||
|
||||
Reference in New Issue
Block a user