(require (lib "list.ss"))

; ==================== MAIN ====================
(define (main) (input-for-each print-address read-address))

;addr ::= (make-addr (listof Str) x (union (listof Digit) #f) x (union (listof Digit) #f)
;                                    x (listof Digit) x (listof Digit))
(define-struct addr (lines streetnum pobox zip extension))

; ==================== INPUT ====================
; read-address : -> (union Addr #<eof>)
; reads an address in from standard input, returning EOF if there is none
(define (read-address)
  (let ((line (read-line)))
    (cond
      [(eof-object? line) eof]
      [(blank-line? line) (read-address)]
      [else (strs->addr (cons line
                                 (input-foldr
                                  (lambda (t r) (if (blank-line? t) '() (cons t (r))))
                                  '()
                                  read-line)))])))

; ==================== OUTPUT ====================
; print-addr : Addr -> void
; SIDE EFFECT: prints the given Addr in bulk-mail format
(define (print-address addr)
  (printl (addr->barcode addr))
  (for-each printl (addr->bulk-mail-address addr))
  (newline))

; ==================== ADDRESS CONSTRUCTION ====================
; strs->addr : listof Str -> Addr
; converts three address lines to an Addr
(define (strs->addr lines)
  (let* ((rev (reverse lines))
         (second-to-last (cadr rev))
         (last (car rev)))
    (make-addr
     lines
     (get "^[0-9]*([0-9][0-9])" second-to-last)
     (get "[0-9]*([0-9][0-9])$" second-to-last)
     (get "([0-9][0-9][0-9][0-9][0-9])(-[0-9][0-9][0-9][0-9])?$" last)
     (get "-([0-9][0-9][0-9][0-9])$" last))))


; ==================== ADDRESS MANIPULATION ====================
; addr->barcode : Addr -> Str
; produces the most specific postal barcode for the given address
(define (addr->barcode addr)
  (let ((zip (addr->post-number addr)))
    (string-append "|" (encode zip) (encode (checksum zip)) "|")))

; addr->post-number : Addr -> (listof Digit)
; Computes the delivery point for the given address
(define (addr->post-number addr)
  (if (pair? (addr-extension addr))
      (append (addr-zip addr)
              (addr-extension addr)
              (or (addr-streetnum addr) (addr-pobox addr) '()))
      (addr-zip addr)))

; addr->bulk-mail-address : Addr -> void
; Computes the lines of a bulk-mail-style address
(define (addr->bulk-mail-address addr)
  (map str->postal-str (addr-lines addr)))

; str->postal-str : String -> String
; converts the string to bulk-mail string conventions
(define (str->postal-str str) (list->string (filtermap char->postal-char (string->list str))))
(define (char->postal-char c)
  (cond
    [(char-alphabetic? c) (char-upcase c)]
    [(or (char-numeric? c) (char-whitespace? c) (eq? c #\-)) c]
    [else #f]))

; encode : (listof Digit) -> Str
; converts the given number to a code
(define (encode nums)
  (apply string-append (map (lambda (x) (list-ref CODE-TABLE x)) nums)))

; CODE-TABLE : listof Str
(define CODE-TABLE '("||...""...||""..|.|""..||."".|..|"".|.|."".||..""|...|""|..|.""|.|.."))

; checksum : (listof Digit) -> (listof Digit)
; computes the POSTNET correction number for a given ZIP code
(define (checksum nums) (list (modulo (- 10 (modulo (apply + nums) 10)) 10)))

; ==================== UTILITY CODE ====================
; (this code should be placed in a general purpose library for reuse)

; input-foldr : (X x (-> X) -> Y) x X x (-> X) -> Y
; follows the fold recursive pattern over a list of items that come from the given
; input thunk rather than a list
(define (input-foldr f base input)
  (let ((c (input)))
    (cond
      [(eof-object? c) base]
      [else (f c (lambda () (input-foldr f base input)))])))

; input-for-each : (X -> void) x (-> X) -> void
; reads subsequent values out of the given thunk, which is presumed to be an
; input function, and applies f in sequence to each of them. Stops on end-of-file.
(define (input-for-each f getter)
  (input-foldr (lambda (t r) (begin (f t) (r))) (void) getter))

; filtermap : (X -> (union Y #f) x (listof X) -> (listof Y)
; produces the list of all X's mapped to Y's using f, with elements of X that map to #f
; removed
(define (filtermap f l)
  (foldr (lambda (t r) (let ((x (f t))) (if x (cons x r) r))) '() l))

; printl : Value -> void
; SIDE EFFECT: displays the value in human-readable format, and then a newline
(define (printl v) (display v) (newline))

; get : regexp x Str -> (union (listof Digit) #f)
; gets a specified list of numbers (represented as a regexp) from a string
(define (get regexp str)
  (let ((match (regexp-match regexp str)))
    (if match (digits (cadr match)) #f)))

; digits : Str[Digit-chars] -> (listof Digit)
; Converts a string representing a number to a list of one-digit numbers
(define (digits numstr) (map (lambda (x) (string->number (string x))) (string->list numstr)))

; blank-line? : str -> bool
; determines if the given line is blank or not
(define (blank-line? str) (andmap char-whitespace? (string->list str)))

; ==================== BOOTSTRAP ====================
(main)