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

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

;; GRAMMAR

(define-peg-pattern ALPHA-NUMERIC body
  (or (range #\0 #\9) (range #\a #\z) (range #\A #\Z)))

(define-peg-pattern KEY-VALUE-SEP none ":")
(define-peg-pattern PAIR-SEP body " ")

(define-peg-pattern VALUE-CHARS body
  (or (range #\0 #\9) (range #\a #\z) (range #\A #\Z) "#")
  #;(and (* (and peg-any (not-followed-by PAIR-SEP)))
       (and peg-any (followed-by PAIR-SEP))))
(define-peg-pattern VALUE all (+ VALUE-CHARS))

(define-peg-pattern BIRTH-YEAR body "byr")
(define-peg-pattern ISSUE-YEAR body "iyr")
(define-peg-pattern EXPIRATION-YEAR body "eyr")
(define-peg-pattern HEIGHT body "hgt")
(define-peg-pattern HAIR-COLOR body "hcl")
(define-peg-pattern EYE-COLOR body "ecl")
(define-peg-pattern PASSPORT-ID body "pid")
(define-peg-pattern COUNTRY-ID body "cid")

(define-peg-pattern KNOWN-KEYS body
  (or BIRTH-YEAR
      ISSUE-YEAR
      EXPIRATION-YEAR
      HEIGHT
      HAIR-COLOR
      EYE-COLOR
      PASSPORT-ID
      COUNTRY-ID))

(define-peg-pattern KEY body KNOWN-KEYS)
(define-peg-pattern KEY-VALUE-PAIR body (and KEY KEY-VALUE-SEP VALUE))

(define-peg-pattern PASSPORT body
  (and (* (and KEY-VALUE-PAIR PAIR-SEP))
       KEY-VALUE-PAIR))


(define get-value-from-peg-tree
  (λ (peg-tree label)
    (cond
     [(null? peg-tree) #f]
     [(pair? (car peg-tree))
      (or (get-value-from-peg-tree (car peg-tree) label)
          (get-value-from-peg-tree (cdr peg-tree) label))]
     [(string? (car peg-tree))
      (cond
       [(string=? (car peg-tree) label)
        (cadadr peg-tree)]
       [else
        (get-value-from-peg-tree (cdr peg-tree) label)])]
     [else
      (get-value-from-peg-tree (cdr peg-tree) label)])))


(define println
  (λ (thing)
    (simple-format (current-output-port) "~a\n" thing)))


(define lines->passport-data
  (lambda* (lines #:key (passport-separator-test string-null?) (key-separator " "))
    (let next-line ([remaining-lines lines] [single-passport-data ""])
      (cond
       [(null? remaining-lines)
        (list (string-trim-both single-passport-data))]
       [else
        (let ([cur-line (car remaining-lines)])
          (cond
           ;; The passport-separator finishes an entry in
           ;; the lines. We cons the single passport data
           ;; onto the recursion and start collecting data
           ;; for the next single passport.
           [(passport-separator-test cur-line)
            (cons (string-trim-both single-passport-data)
                  (next-line (cdr remaining-lines) ""))]
           ;; If more data for a single passport follows, we
           ;; append it onto the single passport data and
           ;; look at the next line.
           [else
            (next-line (cdr remaining-lines)
                       (string-append single-passport-data
                                      key-separator
                                      cur-line))]))]))))


(define valid-passport?
  (λ (passport)
    (let ([tree (peg:tree passport)]
          [mandatory-keys '("byr" "iyr" "eyr" "hgt" "hcl" "ecl" "pid")]
          [optional-keys '("cid")])
      (let ([key-containments
             (map (λ (key) (if tree (get-value-from-peg-tree tree key) #f))
                  mandatory-keys)])
        ;; (simple-format (current-output-port) "key containments: ~a\n" key-containments)
        ;; (simple-format (current-output-port) "result: ~a\n" (reduce (λ (elem acc)
        ;;                                                               (and acc elem))
        ;;                                                             #f
        ;;                                                             key-containments))
        (reduce (λ (elem acc) (and acc elem))
                #f
                key-containments)))))

(define main
  (λ (cmd-line-args)
    (let* ([lines (get-lines-from-file (second cmd-line-args))]
           [passport-data (lines->passport-data lines)]
           [passports (map (λ (datum) (match-pattern PASSPORT datum))
                           passport-data)])
      (length (filter valid-passport? passports)))))


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