;;; BeerXML->xhtml

(use-modules (sxml simple)
	     (sxml xpath)
	     (sxml transform)
	     (sxml ssax)
	     (ice-9 format)
	     (srfi srfi-1))


(define test-doc (xml->sxml (open-input-file "/home/clinton/ginger.xml")))

(define bx-current-context (make-fluid))

(define* (bx-path-ref path #:optional (context (fluid-ref bx-current-context)))
  ((sxpath path) context))

(define* (bx-value-ref path #:optional (context (fluid-ref bx-current-context)))
  ;; fetch first text child of path
  (car ((sxpath '(*text*)) (bx-path-ref path context))))

(define* (bx-float-ref path #:optional (context (fluid-ref bx-current-context)))
  (string->number (bx-value-ref path context)))

(define* (bx-boolean-ref path #:optional (context (fluid-ref bx-current-context)))
  (let ((val (bx-value-ref path context)))
    (cond ((string= val "TRUE") #t)
	  ((string= val "FALSE") #f))))

(define bx-string-ref bx-value-ref)

(define (bx-format-percentage pct)
  (format #f "~,1f%" pct))

(define (bx-format-boolean-yes/no bool)
  (if bool "Yes" "No"))

;; fixme: actually needs to scan fermentables to determine late vs
;; normal additions (ugh)

(define (preboil-gravity boil-size batch-size og)
  (/ (* 1000 og batch-size) boil-size))

(define tinseth-ibu ()
  (let ((utilization (lambda (...)
		       (* (* 1.65 (expt 0.000125 (- wort-gravity 1)))
			  (/ (- 1 (exp (* -0.04 addition-time)))
			     4.15))))
	(alpha-acids (LAMBDA (...)
			(/ (* aa amount 1000) final-gravity))))
    (reduce + 0 (map (lambda () (* (utilization ...)
			      (alpha-acids ...)))
		     ...))))


(define (beerxml->html document)
  (with-fluids ((bx-current-context ((sxpath '(RECIPES RECIPE)) document)))
    `(html (head (title ,(bx-string-ref '(NAME))))
	   (body
	    (h1 ,(bx-string-ref '(NAME)))
	    (div (@ (id "recipe-info"))
		 (ul
		  ,@(letrec ((display-info (lambda (label info)
					     `(li (p (strong ,label ":")
						     " "
						     ,info))))
			     (l->gal (lambda (l) (* l 0.2642)))
			     (format-num (lambda (val conv suffix)
					   (format #f "~,2f ~a"
						   (conv val) suffix)))
			     (format-gravity (lambda (val)
					       (format #f "~,3f" val))))
		      
		      (list
		       (display-info "Brewer" (bx-string-ref '(BREWER)))
		       (display-info "Date" (bx-string-ref '(DATE)))
		       (display-info "Batch Size"
				     (format-num (bx-float-ref '(BATCH_SIZE))
						 l->gal
						 "gal"))
		       (display-info "Boil Time" (bx-value-ref '(BOIL_TIME)))
		       (display-info "Boil Size"
				     (format-num (bx-float-ref '(BOIL_SIZE))
						 l->gal
						 "gal"))
		       (display-info "Efficiency"
				     (bx-format-percentage (bx-float-ref '(EFFICIENCY))))
		       (display-info "OG" (format-gravity (bx-float-ref '(OG))))
		       (display-info "Boil SG" (format-gravity
						(preboil-gravity (bx-float-ref '(BOIL_SIZE))
								 (bx-float-ref '(BATCH_SIZE))
								 (bx-float-ref '(OG)))))
		       (display-info "FG" (format-gravity (bx-float-ref '(FG)))))
		      #;(display-info "ABV" )
		      #;(display-info "Color")
		      #;(display-info "Bitterness"))))
	    (div (@ (id "fermentables"))
		 (h1 "Fermentables")
		 (table
		  (thead (tr ,@(map (lambda (n) `(th ,n))
				    '("Name" "Type" "Amount"
				      "Mashed" "Late" "Yield" "Color"))))
		  (tbody
		   ,@(map (lambda (ferm)
			    (with-fluids ((bx-current-context ferm))
			      `(tr (td ,(bx-string-ref '(NAME)))
				   (td ,(bx-string-ref '(TYPE)))
				   (td ,(bx-value-ref '(AMOUNT)))
				   (td ,(bx-format-boolean-yes/no
					 (bx-boolean-ref '(IS_MASHED))))
				   (td ,(bx-format-boolean-yes/no
					 (bx-boolean-ref '(ADD_AFTER_BOIL))))
				   (td ,(bx-format-percentage
					 (bx-float-ref '(YIELD))))
				   (td ,(bx-value-ref '(COLOR))))))
			  (bx-path-ref '(FERMENTABLES FERMENTABLE))
			  ))))))))