cookbook-dsl/parse.scm

120 lines
3.4 KiB
Scheme
Raw Normal View History

2017-04-08 18:33:00 +00:00
(define recipe-name
(lambda (recipe)
(cadr (assoc 'name recipe))))
2017-04-05 00:20:53 +00:00
2017-04-08 18:33:00 +00:00
(define recipe-ingredients
2017-04-05 00:20:53 +00:00
(lambda (recipe)
2017-04-08 18:33:00 +00:00
(cadr (assoc 'ingredients recipe))))
2017-04-05 00:20:53 +00:00
2017-04-08 18:33:00 +00:00
(define recipe-steps
2017-04-05 00:20:53 +00:00
(lambda (recipe)
2017-04-08 18:33:00 +00:00
(cadr (assoc 'steps recipe))))
2017-04-05 00:20:53 +00:00
2017-04-08 18:33:00 +00:00
(define recipe-servings
2017-04-05 00:20:53 +00:00
(lambda (recipe)
2017-04-08 18:33:00 +00:00
(if (recipe-specifies-servings? recipe)
(cadr (assoc 'servings recipe))
1)
))
2017-04-05 00:20:53 +00:00
(define ingredient-name
(lambda (ingredient)
(if (= (length ingredient) 2)
(car (cdr ingredient))
(car (cddr ingredient)))))
(define ingredient-amount
(lambda (ingredient)
(car ingredient)))
2017-04-05 13:02:38 +00:00
(define ingredient-unit
(lambda (ingredient)
(if (= (length ingredient) 2)
""
(car (cdr ingredient)))))
2017-04-05 00:20:53 +00:00
2017-04-08 18:33:00 +00:00
;; Predicates
(define contains-ingredient?
(lambda (search-ingredient recipe)
(contains-ingredients? (list search-ingredient) recipe)))
2017-04-08 18:33:00 +00:00
(define contains-ingredients?
(lambda (search-ingredients recipe)
2017-04-08 18:33:00 +00:00
(let ((ingredients (recipe-ingredients recipe)))
(cond [(null? search-ingredients) #t]
[(ingredient-by-name (car search-ingredients)
ingredients)
(contains-ingredients? (cdr search-ingredients)
recipe)]
2017-04-08 18:33:00 +00:00
[else #f])
)))
(define recipe-specifies-servings?
(lambda (recipe)
(assoc 'servings recipe)))
;; Searching and indexing
2017-04-05 00:20:53 +00:00
(define ingredient-ref
(lambda (ingredients n)
(if (= n 0)
(car ingredients)
(ingredient-ref (cdr ingredients) (- n 1)))))
(define ingredient-by-name
(lambda (search-name ingredient-list)
(let ((ingredient (car ingredient-list)))
2017-04-05 00:20:53 +00:00
(cond [(equal? (ingredient-name ingredient)
search-name)
ingredient]
[(null? (cdr ingredient-list)) #f]
[else (ingredient-by-name search-name
(cdr ingredient-list))]))))
2017-04-05 00:20:53 +00:00
(define recipes-by-ingredients
(lambda (search-ingredients recipes)
(filter (lambda (x) (contains-ingredients? search-ingredients x))
recipes)))
2017-04-05 22:22:37 +00:00
(define recipe-by-name
2017-04-08 18:33:00 +00:00
(lambda (name recipes)
2017-04-05 22:22:37 +00:00
(if (null? recipes)
#f
(let ((recipe (car recipes)))
2017-04-08 18:33:00 +00:00
(if (equal? (recipe-name recipe)
2017-04-05 22:22:37 +00:00
name)
recipe
2017-04-08 18:33:00 +00:00
(recipe-by-name name (cdr recipes)))))))
;; Manipulation
(define scale-recipe-by-servings
(lambda (wanted-servings recipe)
2017-04-08 18:33:00 +00:00
(let ([name (recipe-name recipe)]
[ingredients (recipe-ingredients recipe)]
[steps (recipe-steps recipe)]
[servings (recipe-servings recipe)])
(let ([new-name name]
[new-ingredients (map (lambda (ingr)
(cons (* (/ (car ingr)
2017-04-08 18:33:00 +00:00
servings)
wanted-servings)
(cdr ingr)))
ingredients)]
[new-steps steps]
[new-servings wanted-servings])
(make-recipe new-name new-servings new-ingredients new-steps)
))))
(define scale-recipe-by-factor
(lambda (scale-factor recipe)
(let ([new-servings (* (recipe-servings recipe) scale-factor)])
(scale-recipe-by-servings new-servings recipe))))
2017-04-08 18:33:00 +00:00
;; Constructors
(define make-recipe
(lambda (name servings ingredients steps)
`((name ,name) (servings ,servings) (ingredients ,ingredients) (steps ,steps))))