summaryrefslogtreecommitdiff
path: root/Omni/Agent/Git.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Agent/Git.hs')
-rw-r--r--Omni/Agent/Git.hs232
1 files changed, 232 insertions, 0 deletions
diff --git a/Omni/Agent/Git.hs b/Omni/Agent/Git.hs
new file mode 100644
index 0000000..4c06cf6
--- /dev/null
+++ b/Omni/Agent/Git.hs
@@ -0,0 +1,232 @@
+{-# 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,
+ listBranches,
+ showFile,
+ getRepoRoot,
+ runGit,
+ 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 <branch> <target>
+ 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)
+
+listBranches :: FilePath -> Text -> IO [Text]
+listBranches repo pat = do
+ let cmd = (Process.proc "git" ["branch", "--list", Text.unpack pat, "--format=%(refname:short)"]) {Process.cwd = Just repo}
+ (code, out, _) <- Process.readCreateProcessWithExitCode cmd ""
+ case code of
+ Exit.ExitSuccess -> pure <| filter (not <. Text.null) (Text.lines (Text.pack out))
+ _ -> panic "git branch list failed"
+
+showFile :: FilePath -> Text -> FilePath -> IO (Maybe Text)
+showFile repo branch path = do
+ let cmd = (Process.proc "git" ["show", Text.unpack branch <> ":" <> path]) {Process.cwd = Just repo}
+ (code, out, _) <- Process.readCreateProcessWithExitCode cmd ""
+ case code of
+ Exit.ExitSuccess -> pure <| Just (Text.pack out)
+ _ -> pure Nothing
+
+getRepoRoot :: FilePath -> IO FilePath
+getRepoRoot dir = do
+ let cmd = (Process.proc "git" ["rev-parse", "--show-toplevel"]) {Process.cwd = Just dir}
+ (code, out, _) <- Process.readCreateProcessWithExitCode cmd ""
+ case code of
+ Exit.ExitSuccess -> pure <| strip out
+ _ -> panic "git rev-parse failed"
+
+runGit :: FilePath -> [String] -> IO ()
+runGit = git
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-15 06:22:16 +0000