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#lang at-exp racket/base
(require (for-syntax racket/base
syntax/parse)
racket/cmdline
racket/format
racket/hash
racket/match
racket/string
racket/system
raco/command-name
"private/env.rkt"
"private/formation.rkt"
"private/procfile.rkt")
(define current-program-name
(make-parameter (short-program+command-name)))
(define current-envfile-paths
(make-parameter (list)))
(define current-procfile-path
(make-parameter "Procfile"))
(define current-formation
(make-parameter (hash)))
(define (exit-with-errors! . messages)
(parameterize ([current-output-port (current-error-port)])
(for ([message messages])
(displayln message)))
(exit 1))
(define (read-envfile path missing-ok?)
(parameterize ([port-count-lines-enabled #t])
(with-handlers ([exn:fail:filesystem?
(lambda (e)
(cond
[missing-ok? (hash)]
[else (exit-with-errors! @~a{error: failed to open '@path'})]))]
[exn:fail?
(lambda (e)
(exit-with-errors! @~a{error: '@path' is not valid}
@~a{ @(exn-message e)}))])
(call-with-input-file path read-env))))
(define (read-envfiles)
(define-values (paths missing-ok?)
(if (null? (current-envfile-paths))
(values (list ".env") #t)
(values (current-envfile-paths) #f)))
(define vars
(for/fold ([env (hash)])
([path (in-list paths)])
(hash-union env (read-envfile path missing-ok?) #:combine (lambda (v1 v2) v2))))
(define env
(environment-variables-copy (current-environment-variables)))
(begin0 env
(for ([(name value) vars])
(environment-variables-set! env name value))))
(define (read-procfile)
(parameterize ([port-count-lines-enabled #t])
(with-handlers ([exn:fail:filesystem?
(lambda (e)
(exit-with-errors! @~a{error: failed to open '@(current-procfile-path)'}))]
[exn:fail?
(lambda (e)
(exit-with-errors! @~a{error: '@(current-procfile-path)' is not valid}
@~a{ @(exn-message e)}))])
(call-with-input-file (current-procfile-path) read-procdefs))))
(define formation-re
#rx"^([^=]+)=(0|[1-9][0-9]*)$")
(define (read-formation spec)
(match (regexp-match formation-re spec)
[#f (exit-with-errors! @~a{error: invalid formation '@spec'})]
[(list _ proc num) (values proc (string->number num))]))
(define-syntax (chief-command-line stx)
(syntax-parse stx
[(_ (~alt
(~optional (~seq #:once-each oe:expr ...+) #:defaults ([(oe 1) null]))
(~optional (~seq #:multi me:expr ...+) #:defaults ([(me 1) null]))
(~optional (~seq #:args ae:expr) #:defaults ([ae #'args]))) ...
body:expr ...+)
#'(command-line
#:program (current-program-name)
#:once-each
[("-f" "--procfile")
path
"Specify an alternate Procfile <path> to load (default: Procfile)"
(current-procfile-path path)]
oe ...
#:multi
[("-e" "--env")
path
"Specify one or more env file <path>s to load (default: .env)"
(current-envfile-paths (cons path (current-envfile-paths)))]
me ...
#:args ae
body ...)]))
(define (handle-check)
(define-values (env procdefs)
(chief-command-line
(values (read-envfiles)
(read-procfile))))
(display "valid procfile detected (")
(display (string-join (map procdef-name procdefs) ", "))
(displayln ")"))
(define (handle-help)
(exit-with-errors!
"usage: raco chief <command> <option> ... <arg> ..."
""
"available commands:"
" check validate a Procfile"
" help print this message and exit"
" run run a command using your application's environment"
" start start the application (or a specific process)"))
(define (handle-run)
(chief-command-line
#:args (command . command-args)
(parameterize ([current-environment-variables (read-envfiles)])
(exit (system/exit-code (string-join (cons command command-args) " "))))))
(define (handle-start)
(chief-command-line
#:multi
[("-m" "--formation")
spec
"Specify how many processes of one type to run. (example: 'web=2')"
(let-values ([(process num) (read-formation spec)])
(current-formation (hash-set (current-formation) process num)))]
#:args processes
(define env (read-envfiles))
(define procdefs (read-procfile))
(define known-processes
(map procdef-name procdefs))
(for ([name (in-list processes)])
(unless (member name known-processes)
(exit-with-errors! @~a{error: invalid process '@name'})))
(start-formation #:env env
#:defs procdefs
#:procs (if (null? processes)
known-processes
processes)
#:formation (current-formation))))
(define ((handle-unknown command))
(exit-with-errors! @~a{error: unrecognized command '@command'}))
(define all-commands
(hasheq 'check handle-check
'help handle-help
'run handle-run
'start handle-start))
(define-values (command handler args)
(match (current-command-line-arguments)
[(vector command args ...)
(values command (hash-ref all-commands (string->symbol command) (handle-unknown command)) args)]
[_
(values "help" handle-help null)]))
(parameterize ([current-command-line-arguments (list->vector args)]
[current-program-name (~a (current-program-name) " " command)])
(handler))