#!/bin/sh
#| -*- scheme -*-
exec csi -s $0 "$@"
|#

(use posix utils (srfi 1 13))

(define (pad num)
  (if (< num 10)
      (conc 0 num)
      (number->string num)))

(define current-raw-date&time (seconds->local-time (current-seconds)))

(define (current-date sep)
  (let ((y (number->string (+ 1900 (vector-ref current-raw-date&time 5))))
        (m (pad (add1 (vector-ref current-raw-date&time 4))))
        (d (pad (vector-ref current-raw-date&time 3))))
    (string-intersperse (list y m d) sep)))

(define current-date&time
  (let ((date (current-date "-"))
        (H (pad (vector-ref current-raw-date&time 2)))
        (M (pad (vector-ref current-raw-date&time 1)))
        (S (pad (vector-ref current-raw-date&time 0))))
    (sprintf "~aT~a:~a:~aZ" date H M S)))

(define s+ string-append)

(define (title eggname status)
  (conc "\n<title>" (status->msg status) " " eggname " egg -- Salmonella report</title>\n"))

(define (custom-title title)
  (conc "\n<title>" title "</title>\n"))

(define (status->msg status)
  (if (zero? status) "[OK]" "[ERROR]"))

(define (status-msg eggname status)
  (conc eggname ": " (status->msg status)))

(define (feed-id namespace)
  (conc "<id>tests.call-cc.org:salmonella:" namespace ":"
        (current-seconds) (current-milliseconds) "</id>\n"))

(define (entry eggname status today-dir)
  (let ((msg (status-msg eggname status)))
    (conc "<entry>" (title eggname status)
"  <link href=\"http://tests.call-cc.org/" today-dir "/salmonella-report/" eggname ".html\"/>
   <published>" current-date&time "</published>
   <updated>" current-date&time "</updated>"
   (feed-id eggname)
   "<summary>" msg "</summary>
    <content xml:base=\"http://tests.call-cc.org/feeds\" xml:space=\"preserve\">"
     msg " (" current-date&time ")"
    "</content></entry>")))

(define (feed eggname status today-dir #!optional entries custom-title-text)
  (conc
"<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>
<feed xmlns=\"http://www.w3.org/2005/Atom\">"
(if entries
    (custom-title custom-title-text)
    (title eggname status))
"<link href=\"http://test.call-cc.org/feeds/" (if entries "/custom/" "") eggname ".xml\" rel=\"self\" />
 <updated>" current-date&time "</updated>
 <author><name>Salmonella</name></author>"
(feed-id (s+ "automated-build" (if entries (conc ":" eggname) "")))
(or entries (entry eggname status today-dir))
"</feed>"))

(define (delete-path . paths)
  ;; mostly stolen from chicken-setup.scm
  (define *windows*
    (and (eq? (software-type) 'windows)
         (build-platform) ) )

  (define *windows-shell* (memq *windows* '(msvc mingw32)))
  (let ((cmd (if *windows-shell* "del /Q /S" "rm -fr")))
    (for-each (lambda (path) (system* "~a ~a" cmd path)) paths)))

(define (custom-feeds logfile atom-dir today-dir)
  (define (create-tmp-dir #!optional retry)
    (let ((attempt (conc "salmonella-tmp" (or retry ""))))
      (if (file-exists? attempt)
          (create-tmp-dir (if retry (add1 retry) 0))
          (begin
            (create-directory attempt)
            attempt))))
  (let ((tmp-dir (create-tmp-dir))
        (output-dir (make-pathname atom-dir "custom"))
        (log-data (cdr (with-input-from-file logfile read-file))))
    (unless (file-exists? output-dir)
      (create-directory output-dir))
    (handle-exceptions
     exn
     (error "Could not fetch salmonella-custom-feeds from the svn repo.")
     (system* (s+ "svn checkout --username anonymous --password '' https://code.call-cc.org/svn/chicken-eggs/salmonella-custom-feeds " tmp-dir)))
    (for-each (lambda (custom-feed)
                (let* ((feed-data (with-input-from-file custom-feed read-file))
                       (title (alist-ref 'title feed-data))
                       (eggs (filter
                              (lambda (egg)
                                (and-let* ((egg-data (alist-ref (->string egg) log-data equal?))
                                           (status (cadr egg-data)))
                                  (not (zero? status))))
                              (or (alist-ref 'eggs feed-data) '())))
                       (filename (pathname-strip-directory custom-feed)))
                  (with-output-to-file (make-pathname output-dir
                                                      (pathname-strip-extension filename) "xml")
                    (lambda ()
                      (print
                       (feed (pathname-strip-extension filename)
                             0
                             today-dir
                             (with-output-to-string
                               (lambda ()
                                 (for-each
                                  (lambda (egg)
                                    (print (handle-exceptions
                                            e ""
                                            (entry egg (cadr (alist-ref (->string egg) log-data equal?)) today-dir))))
                                  eggs)))
                             (if title (car title) "")))))))
              (filter (lambda (path)
                        (not (string-prefix? "." (pathname-strip-directory path))))
                      (glob (make-pathname tmp-dir "*"))))
    (delete-path tmp-dir)))

(define (main salmonella-log atom-dir today-dir)
  (when (file-exists? salmonella-log)
    (for-each (lambda (egg)
                (let* ((eggname (string-trim-both (car egg)))
                       (status (caddr egg)))
                  (with-output-to-file (make-pathname atom-dir eggname ".xml")
                    (lambda ()
                      (print (feed eggname status today-dir))))))
              (cdr (with-input-from-file salmonella-log read-file)))))

(let* ((args (command-line-arguments))
       (len (length args)))
  (if (< len 3)
      (begin
        (print "Usage: log2atom.scm <salmonella logfile> <atom-dir> <today-dir> [ parse-custom-feeds ]")
        (exit 1))
      (begin
        (let ((logfile (car args))
              (atom-dir (cadr args))
              (today-dir (caddr args)))
          (main logfile atom-dir today-dir)
          (when (= 4 len)
            (custom-feeds logfile atom-dir today-dir))))))