path: root/Omni/Agent/Git.hs

{-# 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