1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- | Git operations for the agent.
--
-- : out omni-agent-git
-- : dep temporary
module Omni.Agent.Git
( checkout,
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
|
