#| https://github.com/cooklang/spec/blob/main/EBNF.md |# (define-record-type (make-amount quantity unit) amount? (quantity amount-quantity) (unit amount-unit)) (define-record-type (make-component name amount) component? (name component-name) (amount component-amount)) (define-record-type (make-ingredient name amount) ingredient? (name ingredient-name) (amount ingredient-amount)) (define (component->ingredient comp) (make-ingredient (component-name comp) (component-amount comp))) (define-record-type (make-cookware name amount) cookware? (name cookware-name) (amount cookware-amount)) (define (component->cookware comp) (make-cookware (component-name comp) (component-amount comp))) (define-record-type (make-timer name amount) timer? (name timer-name) (amount timer-amount)) (define (component->timer comp) (make-timer (component-name comp) (component-amount comp))) (define-record-type (make-metadata-line key value) metadata-line? (key metadata-line-key) (value metadata-line-value)) (define-record-type (make-step elements) step? (elements step-elements)) (define-record-type (make-comment text) comment? (text comment-text)) (define (metadata-line-list->hash-table meta-lines) (let ((metadata (make-hash-table))) (for-each (lambda (line) (hash-table-set! metadata (metadata-line-key line) (metadata-line-value line))) meta-lines) metadata)) (define newline-chars (char-set #\x000A #\x000D #\x0085 #\x2028 #\x2029)) (define punctuation-chars (char-set #\. #\{ #\})) ;; TODO: do it right (define word-chars (char-set-difference char-set:full punctuation-chars char-set:whitespace)) (define any-text-chars (char-set-difference char-set:full newline-chars)) (define text-chars (char-set-difference any-text-chars (char-set #\@ #\# #\~))) (define unit-chars (char-set-difference text-chars (char-set #\}))) (define component-chars (char-set-difference text-chars (char-set #\{ #\}))) (define component-word-chars (char-set-difference component-chars char-set:whitespace)) (define quantity-chars (char-set-difference text-chars (char-set #\} #\%))) (define metadata-chars (char-set-difference text-chars (char-set #\:))) (define-grammar cook (nl ((: ,newline-chars))) (empty-line ((: bol ,nl))) (whitespace ((=> x (+ ,char-set:whitespace)) (list->string x))) (any-text-item ((: (=> c (+ ,any-text-chars))) (list->string c))) (text-item ((: (=> c (+ ,text-chars))) (list->string c))) (comment ((: "--" (=> c (+ ,any-text-chars)) ,nl) (make-comment (list->string c))) ((: "[-" (=> c (* any)) "-]") (make-comment (list->string c)))) (word ((=> w (+ ,word-chars)) (list->string w))) (unit ((=> u (+ ,unit-chars)) (list->string u))) (quantity ((=> q (+ ,quantity-chars)) (string->number (list->string q)))) (meta-key ((=> k (+ ,metadata-chars)) (list->string k))) (amount ((: (=> q ,quantity) "%" (=> u ,unit)) (make-amount q u)) ((=> q ,quantity) (make-amount q #f))) (no-word-component ((: "{" (? (=> a ,amount)) "}") (make-component #f a))) (component-word ((=> w (+ ,component-word-chars)) (list->string w))) (component ((: (=> cw ,component-word) (? (: (=> cc (* ,component-chars)) "{" (? (=> a ,amount)) "}"))) (make-component (string-append cw (if cc (list->string cc) "")) a))) (timer ((: "~" (=> c (or ,component ,no-word-component))) (component->timer c))) (cookware ((: "#" (=> c ,component)) (component->cookware c))) (ingredient ((: "@" (=> c ,component)) (component->ingredient c))) (step ((: (=> s (+ (or ,ingredient ,cookware ,timer ,text-item))) (or ,empty-line (: (* ,empty-line) eos))) (make-step s))) (metadata ((: bol ">>" (* ,whitespace) (=> k ,meta-key) (* ,whitespace) ":" (* ,whitespace) (=> v ,any-text-item) (* ,whitespace) eol) (make-metadata-line k v))) (recipe ((* (or (: (=> m (+ ,metadata)) ,nl) (=> c (+ ,comment)) (: (=> s (+ ,step)) (or eos (* ,empty-line))))) (list 'recipe (metadata-line-list->hash-table (or m '())) s)))) (define (parse-cook str) (parse-fully recipe str))