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