#|
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-record-type <comment>
  (make-comment text)
  comment?
  (text comment-text))

(define-record-type <recipe>
  (make-recipe metadata body)
  recipe?
  (metadata recipe-metadata)
  (body recipe-body))

(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 (merge-step-strings lis)
  (reduce-right
    (lambda (el acc)
      (cond
        ((char? el)
         (if (and (< 0 (length acc)) (string? (car acc)))
           (cons (string-append (string el) (car acc)) (cdr acc))
           (append (list (string el)) acc)))
        (else
           (append (list el) acc))))
    '()
    lis))


(define word-chars      (char-set-difference char-set:full
                                             punctuation-chars
                                             newline-chars
                                             whitespace-chars))
(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 text-chars)
(define component-word-chars (char-set-difference component-chars
                                                  punctuation-chars
                                                  newline-chars
                                                  whitespace-chars))
(define quantity-chars  (char-set-difference text-chars (char-set #\} #\%)))
(define metadata-chars  (char-set-difference text-chars (char-set #\:)))

(define-grammar cook
    (one-nl         (,(parse-map
                         (parse-sre `(: eol (+ ,newline-chars) bol))
                         (lambda _ '(#\space)))))
    (nl             ((: ,newline-chars)))
    (whitespace     ((=> x (+ ,whitespace-chars))
                     (list->string x)))

    (any-text-item  ((: (=> c (+ ,any-text-chars)))
                     (list->string c)))

    (comment        ((: "--" (=> c (+ ,any-text-chars)) (or eos ,nl))
                     (make-comment (list->string c)))
                    ((: "[-" (=> c (* any)) "-]")
                     (make-comment (list->string c))))

    (word           ((=> w (+ ,word-chars))
                     w))
    (unit           ((=> u ,(parse-map-substring
                              (parse-repeat+ (parse-char unit-chars))
                              string-trim))
                     u))
    (quantity       ((=> q ,(parse-map-substring
                              (parse-repeat+ (parse-char quantity-chars))
                              string-trim))
                     (or (string->number q) q)))
    (meta-key       ((=> k (+ ,metadata-chars))
                     (list->string k)))

    (amount         ((=> q ,whitespace)
                     #f)
                    ((: (=> q  ,quantity) "%" (=> u ,unit))
                     (make-amount q u))
                    ((=> q ,quantity)
                     (make-amount q #f)))

    (amount-block      ((: "{" (? (=> a ,amount)) "}")
                        a))
    (no-word-component ((: (=> a ,amount-block))
                        (make-component #f a)))

    (component-word ((=> w (+ ,component-word-chars))
                     (list->string w)))
    (component      ((: (=> cw ,component-word)
                        (? (: (=> cc (* ,component-chars))
                              (=> a ,amount-block))))
                     (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)))

    (text-item      ((=> t (+ (or ,comment
                                  ,ingredient
                                  ,cookware
                                  ,timer
                                  ,any-text-chars)))
                     t))

    (step-line      ((: (? ,whitespace)
                        (=> s (+ ,text-item))
                        (? ,nl))
                       (append! (concatenate! s))))

    (step           ((=> s (: ,step-line
                              ,(parse-map
                                 (parse-repeat
                                   (parse-map ;; Add space where newline was
                                     step-line (lambda x
                                                (append '(#\space)
                                                        (concatenate x)))))
                                 (lambda x (concatenate!
                                             (concatenate! x))))))
                     (make-step (merge-step-strings (concatenate! s)))))

    (metadata       ((: bol ">>"
                        (=> k ,(parse-map meta-key string-trim))
                        (* ,whitespace) ":" (* ,whitespace)
                        (=> v ,(parse-map any-text-item string-trim))
                        (* ,whitespace) eol)
                     (make-metadata-line k v)))

    (element        ((or ,metadata ,comment ,step)))

    (recipe         ((=> els
                         (* (: ,element ,(parse-ignore
                                           (parse-seq
                                             (parse-repeat nl)
                                             (parse-optional parse-end))))))
                     (concatenate! els))))

(define (parse-cook str)
  (let ((lis (parse-fully recipe str)))
    (let-values (((meta-lines body) (partition metadata-line? lis)))
      (make-recipe (metadata-line-list->hash-table meta-lines) body))))