{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} -- | Git operations for the agent. -- -- : out omni-agent-git -- : dep temporary module Omni.Agent.Git ( checkout, syncWithLive, commit, createBranch, getCurrentBranch, branchExists, isMerged, main, test, ) where import Alpha import qualified Data.Text as Text import qualified Omni.Log as Log import Omni.Test ((@=?)) import qualified Omni.Test as Test import qualified System.Directory as Directory import qualified System.Exit as Exit import qualified System.IO.Temp as Temp import qualified System.Process as Process main :: IO () main = Test.run test test :: Test.Tree test = Test.group "Omni.Agent.Git" [ Test.unit "checkout works" <| do Temp.withSystemTempDirectory "omni-agent-git-test" <| \tmpDir -> do let repo = tmpDir <> "/repo" Directory.createDirectory repo -- init repo git repo ["init"] git repo ["branch", "-m", "master"] git repo ["config", "user.email", "you@example.com"] git repo ["config", "user.name", "Your Name"] -- commit A writeFile (repo <> "/a.txt") "A" git repo ["add", "a.txt"] git repo ["commit", "-m", "A"] shaA <- getSha repo "HEAD" -- create branch dev git repo ["checkout", "-b", "dev"] -- commit B writeFile (repo <> "/b.txt") "B" git repo ["add", "b.txt"] git repo ["commit", "-m", "B"] shaB <- getSha repo "HEAD" -- switch back to master git repo ["checkout", "master"] -- Test 1: checkout dev checkout repo "dev" current <- getSha repo "HEAD" shaB @=? current -- Test 2: checkout master checkout repo "master" current' <- getSha repo "HEAD" shaA @=? current' -- Test 3: dirty state writeFile (repo <> "/a.txt") "DIRTY" checkout repo "dev" current'' <- getSha repo "HEAD" shaB @=? current'' -- Verify dirty file is gone/overwritten (b.txt should exist, a.txt should be A from master? No, a.txt is in A and B) -- Wait, in dev, a.txt is "A". content <- readFile (repo <> "/a.txt") "A" @=? content -- Test 4: untracked file writeFile (repo <> "/untracked.txt") "DELETE ME" checkout repo "master" exists <- Directory.doesFileExist (repo <> "/untracked.txt") False @=? exists ] getSha :: FilePath -> String -> IO String getSha dir ref = do let cmd = (Process.proc "git" ["rev-parse", ref]) {Process.cwd = Just dir} (code, out, _) <- Process.readCreateProcessWithExitCode cmd "" case code of Exit.ExitSuccess -> pure <| strip out _ -> panic "getSha failed" -- | Checkout a specific ref (SHA, branch, tag) in the given repository path. -- This function ensures the repository is in the correct state by: -- 1. Fetching all updates -- 2. Checking out the ref (forcing overwrites of local changes) -- 3. Resetting hard to the ref (to ensure clean state) -- 4. Cleaning untracked files -- 5. Updating submodules checkout :: FilePath -> Text -> IO () checkout repoPath ref = do let r = Text.unpack ref Log.info ["git", "checkout", ref, "in", Text.pack repoPath] -- Fetch all refs to ensure we have the target git repoPath ["fetch", "--all", "--tags"] -- Checkout the ref, discarding local changes git repoPath ["checkout", "--force", r] -- Reset hard to ensure we are exactly at the target state git repoPath ["reset", "--hard", r] -- Remove untracked files and directories git repoPath ["clean", "-fdx"] -- Update submodules git repoPath ["submodule", "update", "--init", "--recursive"] Log.good ["git", "checkout", "complete"] Log.br -- | Run a git command in the given directory. git :: FilePath -> [String] -> IO () git dir args = do let cmd = (Process.proc "git" args) {Process.cwd = Just dir} (exitCode, out, err) <- Process.readCreateProcessWithExitCode cmd "" case exitCode of Exit.ExitSuccess -> pure () Exit.ExitFailure code -> do Log.fail ["git command failed", Text.pack (show args), "code: " <> show code] Log.info [Text.pack out] Log.info [Text.pack err] Log.br panic <| "git command failed: git " <> show args syncWithLive :: FilePath -> IO () syncWithLive repo = do Log.info ["git", "syncing with live"] -- git repo ["fetch", "origin", "live"] -- Optional -- Try sync (branchless sync), if fail, panic -- This replaces manual rebase and handles stack movement let cmd = (Process.proc "git" ["sync"]) {Process.cwd = Just repo} (code, out, err) <- Process.readCreateProcessWithExitCode cmd "" case code of Exit.ExitSuccess -> pure () Exit.ExitFailure _ -> do Log.warn ["git sync failed", Text.pack err] Log.info [Text.pack out] panic "Sync with live failed (git sync)" commit :: FilePath -> Text -> IO () commit repo msg = do Log.info ["git", "commit", msg] git repo ["add", "."] -- Check for changes before committing to avoid error let checkCmd = (Process.proc "git" ["diff", "--cached", "--quiet"]) {Process.cwd = Just repo} (code, _, _) <- Process.readCreateProcessWithExitCode checkCmd "" case code of Exit.ExitSuccess -> Log.warn ["git", "nothing to commit", "skipping"] Exit.ExitFailure 1 -> git repo ["commit", "-m", Text.unpack msg] Exit.ExitFailure c -> panic <| "git diff failed with code " <> show c createBranch :: FilePath -> Text -> IO () createBranch repo branch = do Log.info ["git", "create branch", branch] git repo ["checkout", "-b", Text.unpack branch] getCurrentBranch :: FilePath -> IO Text getCurrentBranch repo = do let cmd = (Process.proc "git" ["branch", "--show-current"]) {Process.cwd = Just repo} (code, out, _) <- Process.readCreateProcessWithExitCode cmd "" case code of Exit.ExitSuccess -> pure <| Text.strip (Text.pack out) _ -> panic "git branch failed" branchExists :: FilePath -> Text -> IO Bool branchExists repo branch = do let cmd = (Process.proc "git" ["show-ref", "--verify", "refs/heads/" <> Text.unpack branch]) {Process.cwd = Just repo} (code, _, _) <- Process.readCreateProcessWithExitCode cmd "" pure (code == Exit.ExitSuccess) isMerged :: FilePath -> Text -> Text -> IO Bool isMerged repo branch target = do -- Check if 'branch' is merged into 'target' -- git merge-base --is-ancestor let cmd = (Process.proc "git" ["merge-base", "--is-ancestor", Text.unpack branch, Text.unpack target]) {Process.cwd = Just repo} (code, _, _) <- Process.readCreateProcessWithExitCode cmd "" pure (code == Exit.ExitSuccess)