From 2f2cc165510251fe35b87585b899be91967221ca Mon Sep 17 00:00:00 2001 From: James Brechtel Date: Wed, 13 May 2026 22:19:44 -0400 Subject: [PATCH] Log all git write operations with command, args, and exit code - Add loggedGit helper that logs 'RUN: git -C ' before execution and 'EXIT ' 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 --- src/Converge.hs | 34 ++++++++++++++++++++++------------ test/GitPullSpec.hs | 6 ++++-- 2 files changed, 26 insertions(+), 14 deletions(-) diff --git a/src/Converge.hs b/src/Converge.hs index a962a4f..1626984 100644 --- a/src/Converge.hs +++ b/src/Converge.hs @@ -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 diff --git a/test/GitPullSpec.hs b/test/GitPullSpec.hs index 33fe262..a227255 100644 --- a/test/GitPullSpec.hs +++ b/test/GitPullSpec.hs @@ -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