Start cook parsing

2 files changed, 153 insertions, 0 deletions

diff --git a/cook/parse.scm b/cook/parse.scm
new file mode 100644
index 0000000..8403221
--- /dev/null
+++ b/cook/parse.scm
@@ -0,0 +1,143 @@
+(import (srfi 1)
+        (srfi 9)
+        (srfi 69)
+        (chibi char-set ascii)
+        (chibi char-set)
+        (chibi parse)
+        (chibi regexp)
+        (chibi parse common))
+#|
+https://github.com/cooklang/spec/blob/main/EBNF.md
+|#
+(define-record-type <amount>
+  (make-amount quantity unit)
+  amount?
+  (quantity amount-quantity)
+  (unit amount-unit))
+
+(define-record-type <component>
+  (make-component name amount)
+  component?
+  (name component-name)
+  (amount component-amount))
+
+(define-record-type <ingredient>
+  (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 <cookware>
+  (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 <timer>
+  (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 <metadata-line>
+  (make-metadata-line key value)
+  metadata-line?
+  (key metadata-line-key)
+  (value metadata-line-value))
+
+(define-record-type <step>
+  (make-step elements)
+  step?
+  (elements step-elements))
+
+(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 text-chars      (char-set-difference char-set:full
+                                             (char-set #\@ #\# #\~)
+                                             newline-chars))
+(define unit-chars      (char-set-difference text-chars (char-set #\})))
+(define component-chars (char-set-difference text-chars (char-set #\{ #\})))
+(define quantity-chars  (char-set-difference text-chars (char-set #\} #\%)))
+(define metadata-chars  (char-set-difference text-chars (char-set #\:)))
+
+(define-grammar cook
+    (newline        ((+ ,newline-chars)))
+    (whitespace     ((+ ,char-set:whitespace)))
+
+    (text-item      ((: (=> c (+ ,text-chars)))
+                     (list->string c)))
+
+    (comment        ((: "--" (=> c (+ ,text-chars)) ,newline)
+                     (list->string c))
+                    ((: "[-" (=> c (* any)) "-]")
+                     (list->string c)))
+
+    (word           ((=> w (+ ,word-chars))
+                     (list->string w)))
+    (unit           ((=> u (+ ,unit-chars))
+                     (list->string u)))
+    (quantity       ((=> q (+ ,quantity-chars))
+                     (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 ((: (=> x (? ,component-chars))
+                           "{" (? (=> a ,amount)) "}")
+                        (make-component (list->string x) a)))
+    (component      ((: (=> x (+ ,word)) (? (:"{" (=> a ,amount) "}")))
+                     (make-component x a))
+                    ((: (=> x (+ ,component-chars)) "{" (? (=> a ,amount)) "}")
+                     (make-component (list->string x) 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)))
+                        ,newline)
+                     (make-step s)))
+
+    (metadata       ((: bol ">>" (* ,whitespace)
+                        (=> k ,meta-key)
+                        (* ,whitespace) ":" (* ,whitespace)
+                        (=> v ,text-item) (* ,whitespace) ,newline)
+                     (make-metadata-line k v)))
+
+    (recipe         ((* (or (=> m (+ ,metadata)) (=> s (+ ,step))))
+                     (list 'recipe (metadata-line-list->hash-table m) s))))
+
+(define (parse-cook str)
+  (parse-fully recipe str))
diff --git a/cook/parse.sld b/cook/parse.sld
new file mode 100644
index 0000000..9f4eaa3
--- /dev/null
+++ b/cook/parse.sld
@@ -0,0 +1,10 @@
+(define-library (cook parse)
+  (export parse-cook)
+  (import (srfi 1)
+          (srfi 9)
+          (srfi 69)
+          (chibi char-set ascii)
+          (chibi char-set)
+          (chibi parse)
+          (chibi regexp))
+  (include "parse.scm"))