(##namespace ("pawn#"))
(##include "~~lib/gambit#.scm")
(##include "pawn#.scm")
(define-structure pawn-ex message data)
(define (pawn-ex->error pex)
(error (pawn-ex-message pex)
(pawn-ex-data pex)))
(define (fold-result-or-pawn-ex init fns errfn)
(if (pawn-ex? init)
(errfn init)
(let loop ((fns fns)
(result init))
(if (null? fns)
result
(let ((new-result ((car fns) result)))
(if (pawn-ex? new-result)
(err-fn new-result)
(loop
(cdr fns)
new-result)))))))
(define (get-command)
(if (> (length (command-line)) 1)
(cadr (command-line))
(make-pawn-ex
"Missing task argument"
(command-line))))
(define (get-tasks pawnfile)
(let ((result (assoc 'tasks pawnfile)))
(if result
(if (not (null? (cdr result)))
(cdr result)
(make-pawn-ex
"Empty tasks is not allowed"
result))
(make-pawn-ex
"Missing tasks field in Pawnfile"
pawnfile))))
(define (get-task tasks cmd)
(let ((result (assoc (string->symbol cmd) tasks)))
(if result
(if (not (null? (cdr result)))
(cdr result)
(make-pawn-ex
(string-append "Empty task " cmd " is not allowed")
result))
(make-pawn-ex
(string-append "Missing " cmd " command in tasks")
cmd))))
(define (setup-task task)
(let ((result (assoc 'dir task)))
(when result (current-directory (cadr result)))
task))
(define (get-cmds task)
(let ((result (assoc 'cmds task)))
(if result
(if (not (null? (cdr result)))
(cdr result)
(make-pawn-ex
"Empty cmds is not allowed"
task))
(make-pawn-ex
"Missing cmds field"
task))))
(define (run-cmds cmds)
(for-each shell-command cmds))
(define filename "Pawnfile.scm")
(define (open-pawnfile)
(if (file-exists? filename)
(read-all (open-input-file filename))
(make-pawn-ex
"Missing Pawnfile.scm"
'())))