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 <> ")")
|
("Commit failed in " <> rcPath repo <> " (exit " <> show commitCode <> ")")
|
||||||
-- Pull
|
-- Pull
|
||||||
logRepo logger repo ("pulling " <> rcRemote repo <> "/" <> rcBranch repo)
|
logRepo logger repo ("pulling " <> rcRemote repo <> "/" <> rcBranch repo)
|
||||||
(pullCode, pullOut, pullErr) <- gitPull repo
|
(pullCode, pullOut, pullErr) <- gitPull logger repo
|
||||||
case pullCode of
|
case pullCode of
|
||||||
ExitSuccess -> do
|
ExitSuccess -> do
|
||||||
let trimmed = T.strip pullOut
|
let trimmed = T.strip pullOut
|
||||||
@@ -303,7 +303,7 @@ syncRepo opts logger repo = do
|
|||||||
else do
|
else do
|
||||||
logRepo logger repo "sync complete, no conflicts"
|
logRepo logger repo "sync complete, no conflicts"
|
||||||
-- Push local commits to remote
|
-- Push local commits to remote
|
||||||
(pushCode, pushOut, pushErr) <- gitPush repo
|
(pushCode, pushOut, pushErr) <- gitPush logger repo
|
||||||
case pushCode of
|
case pushCode of
|
||||||
ExitSuccess ->
|
ExitSuccess ->
|
||||||
logRepo logger repo "push succeeded"
|
logRepo logger repo "push succeeded"
|
||||||
@@ -321,26 +321,36 @@ syncRepo opts logger repo = do
|
|||||||
-- | Stage all changes and commit with an auto-generated message.
|
-- | Stage all changes and commit with an auto-generated message.
|
||||||
gitCommitAll :: Logger -> FilePath -> IO (ExitCode, Text, Text)
|
gitCommitAll :: Logger -> FilePath -> IO (ExitCode, Text, Text)
|
||||||
gitCommitAll logger repoPath = do
|
gitCommitAll logger repoPath = do
|
||||||
(_, _, stageErr) <- runGitIn repoPath ["add", "-A"]
|
(_, _, stageErr) <- loggedGit logger repoPath ["add", "-A"]
|
||||||
unless (T.null stageErr) $
|
unless (T.null stageErr) $
|
||||||
logInfo logger ("git add stderr: " <> stageErr)
|
logInfo logger ("git add stderr: " <> stageErr)
|
||||||
hostname <- init <$> readProcess "hostname" [] ""
|
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.
|
-- | Pull from the configured remote and branch.
|
||||||
gitPull :: RepoConfig -> IO (ExitCode, Text, Text)
|
gitPull :: Logger -> RepoConfig -> IO (ExitCode, Text, Text)
|
||||||
gitPull repo =
|
gitPull logger repo =
|
||||||
runGitIn
|
loggedGit logger (rcPath repo)
|
||||||
(rcPath repo)
|
|
||||||
["pull", "--rebase", T.unpack (rcRemote repo), T.unpack (rcBranch repo)]
|
["pull", "--rebase", T.unpack (rcRemote repo), T.unpack (rcBranch repo)]
|
||||||
|
|
||||||
-- | Push to the configured remote and branch.
|
-- | Push to the configured remote and branch.
|
||||||
gitPush :: RepoConfig -> IO (ExitCode, Text, Text)
|
gitPush :: Logger -> RepoConfig -> IO (ExitCode, Text, Text)
|
||||||
gitPush repo =
|
gitPush logger repo =
|
||||||
runGitIn
|
loggedGit logger (rcPath repo)
|
||||||
(rcPath repo)
|
|
||||||
["push", T.unpack (rcRemote repo), T.unpack (rcBranch 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.
|
-- | Check if the repository currently has merge conflicts.
|
||||||
hasConflicts :: FilePath -> IO Bool
|
hasConflicts :: FilePath -> IO Bool
|
||||||
hasConflicts repoPath = do
|
hasConflicts repoPath = do
|
||||||
|
|||||||
+4
-2
@@ -13,6 +13,7 @@ spec :: Spec
|
|||||||
spec = do
|
spec = do
|
||||||
describe "gitPull" $ do
|
describe "gitPull" $ do
|
||||||
it "pulls changes from remote 'origin'" $ do
|
it "pulls changes from remote 'origin'" $ do
|
||||||
|
logger <- testLogger
|
||||||
withTempGitRepoWithRemote $ \local -> do
|
withTempGitRepoWithRemote $ \local -> do
|
||||||
-- Make a second commit on local and push to remote
|
-- Make a second commit on local and push to remote
|
||||||
writeFile (local </> "upstream.txt") "pushed to remote"
|
writeFile (local </> "upstream.txt") "pushed to remote"
|
||||||
@@ -27,13 +28,14 @@ spec = do
|
|||||||
countBefore `shouldBe` 1
|
countBefore `shouldBe` 1
|
||||||
|
|
||||||
let cfg = defaultRepoConfig{rcPath = local}
|
let cfg = defaultRepoConfig{rcPath = local}
|
||||||
(code, _, _) <- gitPull cfg
|
(code, _, _) <- gitPull logger cfg
|
||||||
code `shouldBe` ExitSuccess
|
code `shouldBe` ExitSuccess
|
||||||
|
|
||||||
countAfter <- commitCount local
|
countAfter <- commitCount local
|
||||||
countAfter `shouldBe` 2
|
countAfter `shouldBe` 2
|
||||||
|
|
||||||
it "rebases local commits on top of pulled changes" $ do
|
it "rebases local commits on top of pulled changes" $ do
|
||||||
|
logger <- testLogger
|
||||||
withSystemTempDirectory "converge-test-rebase" $ \tmp -> do
|
withSystemTempDirectory "converge-test-rebase" $ \tmp -> do
|
||||||
let remoteDir = tmp </> "remote.git"
|
let remoteDir = tmp </> "remote.git"
|
||||||
let localDir = tmp </> "local"
|
let localDir = tmp </> "local"
|
||||||
@@ -73,7 +75,7 @@ spec = do
|
|||||||
-- Pull with --rebase: local commits are rebased on top
|
-- Pull with --rebase: local commits are rebased on top
|
||||||
-- of the fetched remote commit, yielding a linear history.
|
-- of the fetched remote commit, yielding a linear history.
|
||||||
let cfg = defaultRepoConfig{rcPath = localDir}
|
let cfg = defaultRepoConfig{rcPath = localDir}
|
||||||
(code, _, _) <- gitPull cfg
|
(code, _, _) <- gitPull logger cfg
|
||||||
code `shouldBe` ExitSuccess
|
code `shouldBe` ExitSuccess
|
||||||
-- Rebase produces linear history: 3 commits, no merge commit
|
-- Rebase produces linear history: 3 commits, no merge commit
|
||||||
c <- commitCount localDir
|
c <- commitCount localDir
|
||||||
|
|||||||
Reference in New Issue
Block a user