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
|
#!/usr/bin/env run.sh
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- | A robust CI program replacing Omni/Ci.sh
--
-- : out ci
module Omni.Ci (main) where
import Alpha
import qualified Data.Text as Text
import qualified Omni.Cli as Cli
import qualified Omni.Log as Log
import qualified Omni.Test as Test
import qualified System.Directory as Dir
import qualified System.Environment as Environment
import qualified System.Exit as Exit
import System.FilePath ((</>))
import qualified System.Process as Process
main :: IO ()
main = Cli.main <| Cli.Plan help move test pure
help :: Cli.Docopt
help =
[Cli.docopt|
omni-ci - Continuous Integration
Usage:
ci test
ci [options]
Options:
-h, --help Print this info
|]
test :: Test.Tree
test =
Test.group
"Omni.Ci"
[ Test.unit "placeholder test" <| do
True Test.@=? True
]
move :: Cli.Arguments -> IO ()
move _ = do
-- 1. Check for dirty worktree
status <- readProcess "git" ["status", "-s"] ""
unless (Text.null status) <| do
Log.fail ["ci", "dirty worktree"]
Exit.exitWith (Exit.ExitFailure 1)
-- 2. Setup environment
-- We need to ensure timeout is disabled for CI builds
-- Equivalent to: BILD_ARGS="--time 0 ${BILD_ARGS:-""}"
currentBildArgs <- Environment.lookupEnv "BILD_ARGS"
let bildArgs = "--time 0 " <> fromMaybe "" currentBildArgs
Environment.setEnv "BILD_ARGS" bildArgs
-- 3. Get user info
at <- readProcess "date" ["-R"] "" |> fmap chomp
user <- readProcess "git" ["config", "--get", "user.name"] "" |> fmap chomp
mail <- readProcess "git" ["config", "--get", "user.email"] "" |> fmap chomp
-- 4. Check existing git notes
-- commit=$(git notes --ref=ci show HEAD || true)
(exitCode, noteContent, _) <- Process.readProcessWithExitCode "git" ["notes", "--ref=ci", "show", "HEAD"] ""
let alreadyGood = case exitCode of
Exit.ExitSuccess ->
let content = Text.pack noteContent
in ("Lint-is: good" `Text.isInfixOf` content) && ("Test-is: good" `Text.isInfixOf` content)
_ -> False
when alreadyGood <| do
Log.pass ["ci", "already verified"]
Exit.exitSuccess
-- 5. Run Lint
coderoot <- getCoderoot
let runlint = coderoot </> "_/bin/lint"
lintExists <- Dir.doesFileExist runlint
unless lintExists <| do
Log.info ["ci", "building lint"]
callProcess "bild" [coderoot </> "Omni/Lint.hs"]
Log.info ["ci", "running lint"]
-- if "$runlint" "${CODEROOT:?}"/**/*
-- We need to expand **/* which shell does.
-- Since we are in Haskell, we can just pass "." or call git ls-files or similar.
-- Omni/Ci.sh used "${CODEROOT:?}"/**/* which relies on bash globbing.
-- Omni/Lint.hs recursively checks if passed directory or uses git diff if no args.
-- But Omni/Ci.sh passes **/*.
-- Let's try passing the root directory or just run it without args?
-- Omni/Lint.hs says:
-- "case Cli.getAllArgs args (Cli.argument "file") of [] -> changedFiles ..."
-- So if we pass nothing, it only checks changed files.
-- The CI script explicitly passed everything.
-- We can replicate "everything" by passing the coderoot, assuming Lint handles directories recursively?
-- Omni/Lint.hs: "traverse Directory.makeAbsolute /> map (Namespace.fromPath root) ... filter (not <. Namespace.isCab)"
-- It seems it expects files.
-- We can use `git ls-files` to get all files.
allFiles <-
readProcess "git" ["ls-files"] ""
/> lines
/> map Text.unpack
/> filter (not <. null)
-- We can't pass all files as arguments if there are too many (ARG_MAX).
-- But wait, Omni/Lint.hs takes arguments.
-- If we want to check everything, maybe we should implement a "check all" mode in Lint or pass chunks.
-- However, looking at Omni/Ci.sh: `"$runlint" "${CODEROOT:?}"/**/*`
-- This globbing is handled by the shell. It might be huge.
-- If I run `lint` with `.` it might work if Lint supports directories.
-- Omni/Lint.hs: "files |> ... filterM Directory.doesFileExist"
-- It seems it filters for files.
-- If I pass a directory, `doesFileExist` will return False.
-- So I must pass files.
-- Let's pass all files from git ls-files.
-- But we must be careful about ARG_MAX.
-- For now, let's try passing them. If it fails, we might need to batch.
lintResult <- do
-- We run lint on all files.
-- Note: calling callProcess with huge list might fail.
-- Let's see if we can avoid passing all files if Lint supports it.
-- Omni/Lint.hs doesn't seem to support directory recursion on its own if passed a dir,
-- it treats args as file paths.
-- We will try to run it.
(exitCodeLint, _, _) <- Process.readProcessWithExitCode runlint allFiles ""
pure <| case exitCodeLint of
Exit.ExitSuccess -> "good"
_ -> "fail"
-- 6. Run Tests
-- if bild "${BILD_ARGS:-""}" --test "${CODEROOT:?}"/**/*
Log.info ["ci", "running tests"]
testResult <- do
-- similarly, bild takes targets.
-- bild "${CODEROOT:?}"/**/*
-- We can pass namespaces.
-- Let's try passing all files again.
-- bild handles namespaces.
(exitCodeTest, _, _) <- Process.readProcessWithExitCode "bild" ("--test" : allFiles) ""
pure <| case exitCodeTest of
Exit.ExitSuccess -> "good"
_ -> "fail"
-- 7. Create Note
let noteMsg =
Text.unlines
[ "Lint-is: " <> lintResult,
"Test-is: " <> testResult,
"Test-by: " <> user <> " <" <> mail <> ">",
"Test-at: " <> at
]
-- 8. Append Note
callProcess "git" ["notes", "--ref=ci", "append", "-m", Text.unpack noteMsg]
-- 9. Exit
if lintResult == "good" && testResult == "good"
then Exit.exitSuccess
else do
Log.fail ["ci", "verification failed"]
Exit.exitWith (Exit.ExitFailure 1)
-- Helpers
readProcess :: FilePath -> [String] -> String -> IO Text
readProcess cmd args input = do
out <- Process.readProcess cmd args input
pure (Text.pack out)
callProcess :: FilePath -> [String] -> IO ()
callProcess cmd args = do
Process.callProcess cmd args
getCoderoot :: IO FilePath
getCoderoot = do
mEnvRoot <- Environment.lookupEnv "CODEROOT"
case mEnvRoot of
Just envRoot -> pure envRoot
Nothing -> panic "CODEROOT not set" -- Simplified for now
|
