advent-of-code/2020/day-07/puzzle-01.scm

(import
  (except (rnrs base) let-values map error)
  (only (guile) lambda* λ command-line string-null?)
  (srfi srfi-1)
  (ice-9 peg)
  (fileio)
  (display-utils)
  (prefix (peg-tree-utils) peg-tree:))

;; muted gold bags contain 1 wavy red bag, 3 mirrored violet bags, 5 bright gold bags, 5 plaid white bags.

(define-peg-pattern SPACE none " ")
(define-peg-pattern RULE-END none ".")
(define-peg-pattern CONTAINMENT-SEPARATOR none ",")
(define-peg-pattern NUMBER body (* (range #\0 #\9)))
(define-peg-pattern WORD body (+ (range #\a #\z)))
(define-peg-pattern SINGULAR-OR-PLURAL-BAG none (or "bags" "bag"))
(define-peg-pattern NO-BAG none "no other bags")
(define-peg-pattern COUNT all NUMBER)
(define-peg-pattern COLOR-MOD all WORD)
(define-peg-pattern COLOR all WORD)
(define-peg-pattern CONTAINER all (and COLOR-MOD SPACE COLOR))

(define-peg-pattern CONTAINMENT-POSSIBILITY all
  (and COUNT SPACE
       COLOR-MOD SPACE
       COLOR SPACE
       SINGULAR-OR-PLURAL-BAG))

(define-peg-pattern CONTAINMENTS all
  (or (and (* (and CONTAINMENT-POSSIBILITY CONTAINMENT-SEPARATOR SPACE))
           (and CONTAINMENT-POSSIBILITY RULE-END))
      NO-BAG RULE-END))

(define-peg-pattern RULE all
  (and CONTAINER SPACE
       "bags" SPACE
       "contain" SPACE
       CONTAINMENTS))





(define main
  (λ (cmd-line-args)
    (let* ([lines (get-lines-from-file (second cmd-line-args))]
           [rules (map (λ (line) (match-pattern RULE line)) lines)])
      (peg-tree:find-in-tree* (peg:tree (fourth rules))
                              (λ (sym) (symbol=? sym 'CONTAINMENT-POSSIBILITY))))))


;; (display-list (main (command-line)))
(simple-format (current-output-port) "~a\n" (main (command-line)))