(##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"
       '())))