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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- : out agent
-- : dep temporary
module Omni.Agent where
import Alpha
import qualified Data.Text as Text
import qualified Data.Text.IO as TIO
import qualified Omni.Agent.Core as Core
import qualified Omni.Agent.Git as Git
import qualified Omni.Agent.Log as Log
import qualified Omni.Agent.Worker as Worker
import qualified Omni.Cli as Cli
import qualified Omni.Task.Core as TaskCore
import qualified Omni.Test as Test
import qualified System.Console.Docopt as Docopt
import qualified System.Directory as Directory
import qualified System.Environment as Env
import qualified System.Exit as Exit
import System.FilePath ((</>))
import qualified System.IO as IO
import qualified System.IO.Temp as Temp
main :: IO ()
main = Cli.main plan
plan :: Cli.Plan ()
plan =
Cli.Plan
{ Cli.help = help,
Cli.move = move,
Cli.test = test,
Cli.tidy = \_ -> pure ()
}
help :: Cli.Docopt
help =
[Cli.docopt|
agent
Usage:
agent start <name> [--path=<path>]
agent harvest [--path=<path>]
agent merge-driver <ours> <theirs>
agent setup <name>
agent test
agent --help
Options:
--path=<path> Path to the worker directory [default: .]
--help Show this help
|]
move :: Cli.Arguments -> IO ()
move args
| args `Cli.has` Cli.command "start" = do
name <-
Cli.getArg args (Cli.argument "name") |> \case
Just n -> pure (Text.pack n)
Nothing -> panic "Name required"
let path = Cli.getArgWithDefault args "." (Cli.longOption "path")
let worker =
Core.Worker
{ Core.workerName = name,
Core.workerPid = Nothing,
Core.workerStatus = Core.Idle,
Core.workerPath = path
}
Worker.start worker
| args `Cli.has` Cli.command "harvest" = harvest args
| args `Cli.has` Cli.command "merge-driver" = mergeDriver args
| args `Cli.has` Cli.command "setup" = setup args
| otherwise = putStrLn (Cli.usage help)
getArgOrExit :: Cli.Arguments -> Docopt.Option -> IO String
getArgOrExit args opt =
case Cli.getArg args opt of
Just val -> pure val
Nothing -> do
putText <| "Error: Missing required argument " <> Text.pack (show opt)
Exit.exitFailure
harvest :: Cli.Arguments -> IO ()
harvest args = do
let path = Cli.getArgWithDefault args "." (Cli.longOption "path")
putText "Harvesting task updates from workers..."
branches <- Git.listBranches path "omni-worker-*"
if null branches
then putText "No worker branches found."
else do
updated <- foldlM (processBranch path) False branches
when updated <| do
-- Consolidate
Directory.setCurrentDirectory path
TaskCore.exportTasks
-- Commit if changed
Git.commit path "task: harvest updates from workers"
putText "Success: Task database updated and committed."
processBranch :: FilePath -> Bool -> Text -> IO Bool
processBranch repo updated branch = do
putText <| "Checking " <> branch <> "..."
maybeContent <- Git.showFile repo branch ".tasks/tasks.jsonl"
case maybeContent of
Nothing -> do
putText <| " Warning: Could not read .tasks/tasks.jsonl from " <> branch
pure updated
Just content -> do
-- Write to temp file
Temp.withSystemTempFile "worker-tasks.jsonl" <| \tempPath h -> do
TIO.hPutStr h content
IO.hClose h
-- Import
-- We need to ensure we are in the repo directory for TaskCore to find .tasks/tasks.jsonl
Directory.setCurrentDirectory repo
TaskCore.importTasks tempPath
putText <| " Imported tasks from " <> branch
pure True
mergeDriver :: Cli.Arguments -> IO ()
mergeDriver args = do
ours <- getArgOrExit args (Cli.argument "ours")
theirs <- getArgOrExit args (Cli.argument "theirs")
-- Set TASK_DB_PATH to ours (the file git provided as the current version)
Env.setEnv "TASK_DB_PATH" ours
TaskCore.importTasks theirs
Exit.exitSuccess
setup :: Cli.Arguments -> IO ()
setup args = do
nameStr <- getArgOrExit args (Cli.argument "name")
let name = Text.pack nameStr
root <- Git.getRepoRoot "."
let worktreePath = root <> "/../" <> nameStr
putText <| "Creating worktree '" <> Text.pack worktreePath <> "' on branch '" <> name <> "' (from live)..."
-- git worktree add -b <name> <path> live
Git.runGit root ["worktree", "add", "-b", nameStr, worktreePath, "live"]
-- Copy .envrc.local if exists
let envrc = root </> ".envrc.local"
exists <- Directory.doesFileExist envrc
when exists <| do
putText "Copying .envrc.local..."
Directory.copyFile envrc (worktreePath </> ".envrc.local")
-- Config git
Git.runGit worktreePath ["config", "user.name", "Omni Worker"]
Git.runGit worktreePath ["config", "user.email", "bot@omni.agent"]
putText <| "Worker setup complete at " <> Text.pack worktreePath
test :: Test.Tree
test = Test.group "Omni.Agent" [unitTests, logTests]
logTests :: Test.Tree
logTests =
Test.group
"Log tests"
[ Test.unit "Log.emptyStatus" <| do
let s = Log.emptyStatus "worker-1"
Log.statusWorker s Test.@?= "worker-1"
Log.statusFiles s Test.@?= 0
]
unitTests :: Test.Tree
unitTests =
Test.group
"Unit tests"
[ Test.unit "can parse start command" <| do
let result = Docopt.parseArgs help ["start", "worker-1"]
case result of
Left err -> Test.assertFailure <| "Failed to parse 'start': " <> show err
Right args -> args `Cli.has` Cli.command "start" Test.@?= True,
Test.unit "can parse harvest command" <| do
let result = Docopt.parseArgs help ["harvest"]
case result of
Left err -> Test.assertFailure <| "Failed to parse 'harvest': " <> show err
Right args -> args `Cli.has` Cli.command "harvest" Test.@?= True,
Test.unit "can parse setup command" <| do
let result = Docopt.parseArgs help ["setup", "worker-2"]
case result of
Left err -> Test.assertFailure <| "Failed to parse 'setup': " <> show err
Right args -> args `Cli.has` Cli.command "setup" Test.@?= True
]
|
