| 1 | ;;; BeerXML->xhtml |
| 2 | |
| 3 | (use-modules (sxml simple) |
| 4 | (sxml xpath) |
| 5 | (sxml transform) |
| 6 | (sxml ssax) |
| 7 | (ice-9 format) |
| 8 | (srfi srfi-1)) |
| 9 | |
| 10 | |
| 11 | (define test-doc (xml->sxml (open-input-file "/home/clinton/ginger.xml"))) |
| 12 | |
| 13 | (define bx-current-context (make-fluid)) |
| 14 | |
| 15 | (define* (bx-path-ref path #:optional (context (fluid-ref bx-current-context))) |
| 16 | ((sxpath path) context)) |
| 17 | |
| 18 | (define* (bx-value-ref path #:optional (context (fluid-ref bx-current-context))) |
| 19 | ;; fetch first text child of path |
| 20 | (car ((sxpath '(*text*)) (bx-path-ref path context)))) |
| 21 | |
| 22 | (define* (bx-float-ref path #:optional (context (fluid-ref bx-current-context))) |
| 23 | (string->number (bx-value-ref path context))) |
| 24 | |
| 25 | (define* (bx-boolean-ref path #:optional (context (fluid-ref bx-current-context))) |
| 26 | (let ((val (bx-value-ref path context))) |
| 27 | (cond ((string= val "TRUE") #t) |
| 28 | ((string= val "FALSE") #f)))) |
| 29 | |
| 30 | (define bx-string-ref bx-value-ref) |
| 31 | |
| 32 | (define (bx-format-percentage pct) |
| 33 | (format #f "~,1f%" pct)) |
| 34 | |
| 35 | (define (bx-format-boolean-yes/no bool) |
| 36 | (if bool "Yes" "No")) |
| 37 | |
| 38 | ;; fixme: actually needs to scan fermentables to determine late vs |
| 39 | ;; normal additions (ugh) |
| 40 | |
| 41 | (define (preboil-gravity boil-size batch-size og) |
| 42 | (/ (* 1000 og batch-size) boil-size)) |
| 43 | |
| 44 | (define tinseth-ibu () |
| 45 | (let ((utilization (lambda (...) |
| 46 | (* (* 1.65 (expt 0.000125 (- wort-gravity 1))) |
| 47 | (/ (- 1 (exp (* -0.04 addition-time))) |
| 48 | 4.15)))) |
| 49 | (alpha-acids (LAMBDA (...) |
| 50 | (/ (* aa amount 1000) final-gravity)))) |
| 51 | (reduce + 0 (map (lambda () (* (utilization ...) |
| 52 | (alpha-acids ...))) |
| 53 | ...)))) |
| 54 | |
| 55 | |
| 56 | (define (beerxml->html document) |
| 57 | (with-fluids ((bx-current-context ((sxpath '(RECIPES RECIPE)) document))) |
| 58 | `(html (head (title ,(bx-string-ref '(NAME)))) |
| 59 | (body |
| 60 | (h1 ,(bx-string-ref '(NAME))) |
| 61 | (div (@ (id "recipe-info")) |
| 62 | (ul |
| 63 | ,@(letrec ((display-info (lambda (label info) |
| 64 | `(li (p (strong ,label ":") |
| 65 | " " |
| 66 | ,info)))) |
| 67 | (l->gal (lambda (l) (* l 0.2642))) |
| 68 | (format-num (lambda (val conv suffix) |
| 69 | (format #f "~,2f ~a" |
| 70 | (conv val) suffix))) |
| 71 | (format-gravity (lambda (val) |
| 72 | (format #f "~,3f" val)))) |
| 73 | |
| 74 | (list |
| 75 | (display-info "Brewer" (bx-string-ref '(BREWER))) |
| 76 | (display-info "Date" (bx-string-ref '(DATE))) |
| 77 | (display-info "Batch Size" |
| 78 | (format-num (bx-float-ref '(BATCH_SIZE)) |
| 79 | l->gal |
| 80 | "gal")) |
| 81 | (display-info "Boil Time" (bx-value-ref '(BOIL_TIME))) |
| 82 | (display-info "Boil Size" |
| 83 | (format-num (bx-float-ref '(BOIL_SIZE)) |
| 84 | l->gal |
| 85 | "gal")) |
| 86 | (display-info "Efficiency" |
| 87 | (bx-format-percentage (bx-float-ref '(EFFICIENCY)))) |
| 88 | (display-info "OG" (format-gravity (bx-float-ref '(OG)))) |
| 89 | (display-info "Boil SG" (format-gravity |
| 90 | (preboil-gravity (bx-float-ref '(BOIL_SIZE)) |
| 91 | (bx-float-ref '(BATCH_SIZE)) |
| 92 | (bx-float-ref '(OG))))) |
| 93 | (display-info "FG" (format-gravity (bx-float-ref '(FG))))) |
| 94 | #;(display-info "ABV" ) |
| 95 | #;(display-info "Color") |
| 96 | #;(display-info "Bitterness")))) |
| 97 | (div (@ (id "fermentables")) |
| 98 | (h1 "Fermentables") |
| 99 | (table |
| 100 | (thead (tr ,@(map (lambda (n) `(th ,n)) |
| 101 | '("Name" "Type" "Amount" |
| 102 | "Mashed" "Late" "Yield" "Color")))) |
| 103 | (tbody |
| 104 | ,@(map (lambda (ferm) |
| 105 | (with-fluids ((bx-current-context ferm)) |
| 106 | `(tr (td ,(bx-string-ref '(NAME))) |
| 107 | (td ,(bx-string-ref '(TYPE))) |
| 108 | (td ,(bx-value-ref '(AMOUNT))) |
| 109 | (td ,(bx-format-boolean-yes/no |
| 110 | (bx-boolean-ref '(IS_MASHED)))) |
| 111 | (td ,(bx-format-boolean-yes/no |
| 112 | (bx-boolean-ref '(ADD_AFTER_BOIL)))) |
| 113 | (td ,(bx-format-percentage |
| 114 | (bx-float-ref '(YIELD)))) |
| 115 | (td ,(bx-value-ref '(COLOR)))))) |
| 116 | (bx-path-ref '(FERMENTABLES FERMENTABLE)) |
| 117 | )))))))) |