BeerXML to xhtml

Brewtarget html output is bad. A first attempt at hacking together an
html generator for beerxml. Pretty incomplete, might serve as an
trivial base for something better.

diff --git a/beerxml.scm b/beerxml.scm
new file mode 100644 (file)
index 0000000..4fb7c38
--- /dev/null
+++ b/beerxml.scm
@@ -0,0 +1,117 @@
+;;; 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))
+                         ))))))))
\ No newline at end of file