(import scheme)
(import (chicken base))
(import (chicken bitwise))
(import (chicken file))
(import (chicken format))
(import (chicken io))
(import (chicken pathname))
(import (chicken process-context))
(import (chicken string))
(import (srfi 1))
(import (srfi 69))
(import scsh-process)

(define (warn . args)
  (for-each (lambda (arg) (display arg (current-error-port))) args)
  (newline (current-error-port)))

(define (string->bytes string)
  (map char->integer (string->list string)))

(define (string-starts-with? prefix string)
  (let ((index (substring-index prefix string)))
    (and index (zero? index))))

(define (ducky2bin path layout)
  (string->bytes (run/string (plucky "--compact" "-l" ,layout "-i" ,path))))

(define (string-strip-prefix string prefix)
  (if (string-starts-with? prefix string)
      (substring string (string-length prefix))
      string))

(define (diff list1 list2 comparator)
  (let loop ((i 0)
             (list1 list1)
             (list2 list2))
    (cond
     ((and (null? list1) (null? list2))
      #t)
     ((or (null? list1) (null? list2))
      (warn "Lists terminating early " i))
     ((not (comparator (car list1) (car list2)))
      (warn "Element mismatch at byte " i ": " (car list1) " " (car list2)))
     (else
      (loop (add1 i) (cdr list1) (cdr list2))))))

(define (read-bytes path)
  (call-with-input-file path
    (lambda (in)
      (let ((content (read-string #f in)))
        (if (eof-object? content)
            '()
            (string->bytes content))))))

(define (print-progress success?)
  (define red 1)
  (define green 2)
  (fprintf (current-error-port) "~c[3~am" #\escape (if success? green red))
  (display (if success? #\o #\x) (current-error-port))
  (fprintf (current-error-port) "~c[0m" #\escape))

;; TODO: allow test includes/excludes
(define stats (make-hash-table))

(define (main testdir)
  (let ((layouts (run/strings (plucky "--list-layouts"))))
    (find-files testdir test: ".*\\.duck" action:
                (lambda (path _)
                  (let* ((relative-path (string-strip-prefix path testdir))
                         (layout (car (string-split relative-path "/")))
                         (basename (pathname-strip-directory path)))
                    (when (member layout layouts)
                      (let* ((bin-path (pathname-replace-extension path ".bin"))
                             (expected (read-bytes bin-path))
                             (actual (ducky2bin path layout))
                             (same? (equal? expected actual))
                             (stats-key (if same? 'pass 'fail)))
                        (print-progress same?)
                        (hash-table-update!/default stats
                                                    stats-key
                                                    (lambda (items)
                                                      (cons (list basename
                                                                  expected
                                                                  actual)
                                                            items))
                                                    '()))))))
    (newline (current-error-port))
    (let* ((pass (hash-table-ref/default stats 'pass '()))
           (fail (hash-table-ref/default stats 'fail '()))
           (total (+ (length pass) (length fail))))
      (fprintf (current-error-port) "~a/~a tests passed\n" (length pass) total)
      (for-each
       (lambda (item)
         (let ((basename (car item))
               (expected (cadr item))
               (actual (list-ref item 2)))
           (print basename)
           (diff expected actual =)))
       fail))))

(apply main (command-line-arguments))