blob: 53ac5ec1dd85de535b83111d8423e884b3f8474b (
plain)
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
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- : out agent
-- : dep sqlite-simple
-- : dep temporary
module Omni.Agent where
import Alpha
import qualified Data.Text as Text
import qualified Omni.Agent.Core as Core
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 (takeFileName)
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 [<task-id>]
agent merge-driver <ours> <theirs>
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
-- Always run in current directory
let path = "."
-- Infer name from current directory
absPath <- Directory.getCurrentDirectory
let name = Text.pack (takeFileName absPath)
let worker =
Core.Worker
{ Core.workerName = name,
Core.workerPid = Nothing,
Core.workerStatus = Core.Idle,
Core.workerPath = path
}
let taskId = fmap Text.pack (Cli.getArg args (Cli.argument "task-id"))
Worker.start worker taskId
| args `Cli.has` Cli.command "merge-driver" = mergeDriver 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
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
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"]
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 start command with task id" <| do
let result = Docopt.parseArgs help ["start", "t-123"]
case result of
Left err -> Test.assertFailure <| "Failed to parse 'start t-123': " <> show err
Right args -> do
args `Cli.has` Cli.command "start" Test.@?= True
Cli.getArg args (Cli.argument "task-id") Test.@?= Just "t-123"
]
|
