(defpackage #:test-sender
  (:use #:common-lisp #:json)
  (:export #:test-get #:test-solution #:test-send)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; (TESTER-SEND:TEST-GET :test-name)
;;;    to get test code from server
;;; (TESTER-SEND:TEST-SOLUTION test-name (ids) . code)
;;;    to define a solution for test-name by the coders id'ed
;;; (TESTER-SEND:TEST-SEND)
;;;    to send current test results to server
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package #:test-sender)

(defvar *test-solution* nil)

;;; (TEST-GET test-name)
;;; Downloads and installs a lisp-unit test definition from the test server

(defun test-get (name)
  (mapcar 'eval (get-test-code name)))

(defun get-test-code (name)
  (let ((*read-eval* nil))
    (read-from-string
     (cadr (assoc "code"
                  (json:decode-json-from-string
                   (net.aserve.client:do-http-request "http://jalopy.cs.northwestern.edu:8000/test"
                                                      :method :get
                                                      :query (list (cons :test name))))
                  :test 'string-equal)))))

;;; (TEST-SOLUTION name id-list . body) [macro]
;;; Associates a list of IDs and code with an existing lisp-unit test.
;;; for use by TEST-SEND.
;;;
;;; For now, only one solution for one test can be stored at a time.

(defmacro test-solution (name ids &body body)
  (assert (symbolp name) (name) "~S not a symbol" name)
  (assert (id-list-p ids) (ids) "~S not a list of netids symbols" ids)
  (assert (consp body) (body) "~S not an expression" body)
  `(progn
     (setq *test-solution* 
           (list ',name ',ids ',body 
                 (lambda () ,@body (lisp-unit:run-tests ,name))))
     ',name))

;;; (TEST_SEND)
;;; Runs the code stored by TEST-SOLUTION, runs the test for that code,
;;; sends the results to my test server, and returns the JSON data the
;;; server sends back.

(defun test-send ()
  (assert (not (null *test-solution*)) (*test-solution*) "You need to set your TEST-SOLUTION first")
  (destructuring-bind (name ids body thunk) *test-solution*
    (let ((lst nil))
      (lisp-unit:with-test-listener 
          (lambda (passed type name form expected actual extras test-count pass-count) 
            (unless passed (push test-count lst))) 
        (funcall thunk)
        (json:decode-json-from-string (send-json-results name ids body lst))))))



(defun make-json-results (name ids body results)
  (json:encode-json-alist-to-string
   (list (cons :name name)
         (cons :ids ids)
         (cons :failures results)
         (cons :code (json-string (cons 'progn body))))))

(defun send-json-results (name ids body results)
  (net.aserve.client:do-http-request "http://jalopy.cs.northwestern.edu:8000/test-results"
    :method :put 
    :content-type "application/json" 
    :content (make-json-results name ids body results)))


(defun json-string (lst)
  (with-output-to-string (out) (write lst :stream out)))

(defun id-list-p (ids)
  (and (consp ids)
       (every (lambda (id) (and (symbolp id) (<= 6 (length (symbol-name id)) 7)))
              ids)))