(##import _test)
(##import pawn)
;; SUCCESS
(test-equal
 '((build
    (cmds
     "echo 'Hello'"))) 
 (get-tasks '((tasks
	      (build
	       (cmds
		"echo 'Hello'"))))))
(test-equal
 '((cmds
    "echo 'Hello'")) 
 (get-task '((build
	      (cmds
	       "echo 'Hello'"))
	     (foobar
	      (cmds
	       "yes")))
	   "build"))
(test-equal
 '("echo 'Hello'"
   "echo 'Foobar'") 
 (get-cmds '((cmds
	      "echo 'Hello'"
	      "echo 'Foobar'"))))
(test-equal
 48
 (fold-result-or-pawn-ex
  42
  (list
   (lambda (x) (+ x 2))
   (lambda (x) (+ x 4)))
  identity))
(setup-task '((dir "example")))
(test-equal "example" (path-strip-directory (path-strip-trailing-directory-separator (current-directory))))
;; ERROR
(test-error (pawn-ex->error (make-pawn-ex "foobar" '())))
(test-equal
 (make-pawn-ex
  "Missing tasks field in Pawnfile"
  '())
 (get-tasks '()))
(test-equal
 (make-pawn-ex
  "Missing tasks field in Pawnfile"
  '((foobar (build (cmds "foobar")))))
 (get-tasks
  '((foobar (build (cmds "foobar"))))))
(test-equal
 (make-pawn-ex
  "Empty tasks is not allowed"
  '(tasks))
 (get-tasks
  '((tasks))))
(test-equal
 (make-pawn-ex
  "Empty task build is not allowed"
  '(build))
 (get-task
  '((build)) "build"))
(test-equal
 (make-pawn-ex
  "Missing build command in tasks"
  "build")
 (get-task
  '((foobar (cmds "echo 'Foobar'")))
  "build"))
(test-equal
 (make-pawn-ex
  "Empty cmds is not allowed"
  '((cmds)))
 (get-cmds '((cmds))))
(test-equal
 (make-pawn-ex
  "Missing cmds field"
  '((foobar "foobar")))
 (get-cmds '((foobar "foobar"))))
(test-error
 (fold-result-or-pawn-ex
  (make-pawn-ex
   "oops"
   '())
  (list)
  pawn-ex->error))
(test-error
 (fold-result-or-pawn-ex
  42
  (list
   (lambda (x) (+ x 2))
   (lambda (x) (make-pawn-ex "oops" '())))
  pawn-ex->error))

(define (run-cmds cmds)
  (for-each shell-command cmds))

(##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 (get-cmds task)
  (cdr (assoc 'cmds task)))

(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))))

  (let ((d (assoc 'dir task)))
    (when d (current-directory (cadr d)))

  (let ((result (assoc 'dir task)))
    (when result (current-directory (cadr result)))

(define (get-task tasks cmd)
  (cdr (assoc (string->symbol cmd) tasks)))

(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))

(let* ((command (cadr (command-line)))
       (pawnfile (read-all (open-input-file "Pawnfile.scm")))
       (tasks (cdr (assoc 'tasks pawnfile))))
  (run-cmds (get-cmds (setup-task (get-task tasks command))))
  )

(define filename "Pawnfile.scm")
(define (open-pawnfile)
  (if (file-exists? filename)
      (read-all (open-input-file filename))
      (make-pawn-ex
       "Missing Pawnfile.scm"
       '())))

(##namespace ("pawn#"
	      make-pawn-ex
	      pawn-ex->error
	      fold-result-or-pawn-ex
	      get-command
	      get-tasks
	      get-task
	      setup-task
	      get-cmds
	      run-cmds
	      open-pawnfile))

#! /bin/sh
gsc -link . pawn# pawn app
gsc -obj pawn#.c pawn.c app.c app_.c
cc -o pawn -I/usr/local/Gambit/include -L/usr/local/Gambit/lib pawn#.o pawn.o app.o app_.o -lgambit -lm -ldl -lutil

(##import pawn)
(let ((tasks (fold-result-or-pawn-ex
	      (open-pawnfile)
	      (list get-tasks)
	      pawn-ex->error)))
  (fold-result-or-pawn-ex
   (get-command)
   (list
    (lambda (cmd) (get-task tasks cmd))
    setup-task
    get-cmds
    run-cmds)
   pawn-ex->error))

   "gsc -exe pawn.scm"))

   "gsc -link . pawn# pawn app"
   "gsc -obj simple#.c simple.c app.c app_.c"
   "cc -o pawn -I/usr/local/Gambit/include -L/usr/local/Gambit/lib pawn#.o pawn.o app.o app_.o -lgambit -lm -ldl -lutil"))

   "pijul push fancycade@ssh.pijul.com:fancycade/pawn")))

   "pijul push fancycade@ssh.pijul.com:fancycade/pawn"))
 (clean
  (cmds
   "rm -f *.c"
   "rm -f *.o"))
 (test
  (cmds
   "gsi . test.scm")))