From: Clinton Ebadi <clinton@unknownlamer.org>
Date: Mon, 24 Nov 2014 02:54:53 +0000 (-0500)
Subject: BeerXML to xhtml
X-Git-Url: https://git.hcoop.net/clinton/scratch.git/commitdiff_plain/bc15f351e9ec474aa9e4dfef68176ed308996a03?ds=sidebyside

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