Commit | Line | Data |
---|---|---|
bc15f351 CE |
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 | )))))))) |