;; Abstraktionen für Repräsentationsabstraktion

(define make-type
  (lambda (name)
    name))

(define typed-value-maker
  (lambda (type)
    (lambda (value)
      (cons type value))))
  
(define typed-value-selector
  (lambda (type)
    (lambda (value)
      (if (equal? type (car value))
          (cdr value)
          (error "type mismatch")))))

(define typed-value-predicate
  (lambda (type)
    (lambda (value)
      (and (pair? value)
           (equal? type (car value))))))

;; Typen und Repräsentationen

(define prices-type (make-type 'prices))
(define make-prices (typed-value-maker prices-type))
(define prices-alist (typed-value-selector prices-type))

(define drink-price
  (lambda (drink prices)
    (drink-price-1 drink (prices-alist prices))))

(define drink-price-1
  (lambda (drink alist)
    (if (null? alist)
	(error "unfound drink")
	(if (equal? drink (car (car alist)))
	    (cdr (car alist))
	    (drink-price-1 drink (cdr alist))))))

(define inventory-type (make-type 'inventory))
(define make-inventory (typed-value-maker inventory-type))
(define inventory-alist (typed-value-selector inventory-type))

(define inventory-number-of-cans
  (lambda (drink inventory)
    (cdr
     (any (lambda (inventory-entry)
            (equal? drink (car inventory-entry)))
          (inventory-alist inventory)))))

(define display-inventory
  (lambda (inventory)
    (display "The inventory: ")
    (newline)
    (for-each (lambda (inventory-entry)
                (display "drink: ")
                (display (car inventory-entry))
                (display " stock: ")
                (display (cdr inventory-entry))
                (newline))
              (inventory-alist inventory))))

(define empty?
  (lambda (inventory)
    (every? (lambda (inventory-entry)
              (= 0 (cdr inventory-entry)))
            (inventory-alist inventory))))

(define apply-order
  (lambda (order inventory)
    (make-inventory
     (apply-order-1 order (inventory-alist inventory)))))

(define apply-order-1 
  (lambda (order alist)
    (if (null? alist)
	'()
	(let ((alist-entry (car alist)))
	  (if (equal? (car order) (car alist-entry))
	      (cons (cons (car order)
			  (- (cdr alist-entry) (cdr order)))
		    (cdr alist))
	      (cons alist-entry
		    (apply-order-1 order (cdr alist))))))))

;; Hauptprogramm

(define drink-machine
  (lambda (prices inventory)
    (display-inventory inventory)
    (if (empty? inventory)
	(announce-the-end)
	(let ((order (accept-order)))
	  (if (order-satisfiable? order inventory)
	      (begin
		(confirm-order order)
		(let* ((price (order-price order prices))
		       (payment (accept-payment price)))
		  (display-change price payment))
		(drink-machine prices
			       (apply-order order inventory)))
	      (begin
		(display-rejection order inventory)
		(drink-machine prices inventory)))))))
			     
(define announce-the-end
  (lambda ()
    (display "I need a drink, too.")
    (newline)))

(define accept-order
  (lambda ()
    (let* ((product (prompt "What drink?"))
	   (number (prompt "How many cans?")))
      (cons product number))))

(define prompt
  (lambda (prompt-string)
    (display prompt-string) (newline)
    (read)))

(define order-satisfiable?
  (lambda (order inventory)
    (let* ((requested-drink (car order))
	   (requested-number-of-cans (cdr order))
	   (number-of-cans
	    (inventory-number-of-cans requested-drink inventory)))
      (<= requested-number-of-cans number-of-cans))))

(define order-price
  (lambda (order prices)
    (let* ((drink (car order))
	   (price (drink-price drink prices))
	   (number-of-cans (cdr order)))
      (* number-of-cans price))))

(define accept-payment
  (lambda (price)
    (display "Insert ")
    (prompt price)))

(define confirm-order
  (lambda (order)
    (display "You ordered ")
    (display (cdr order))
    (display " cans of ")
    (display (car order))
    (display ".")
    (newline)))

(define display-change
  (lambda (price payment)
    (display "Here is your change: ")
    (display (- payment price))
    (newline)))

(define display-rejection
  (lambda (order inventory)
    (display "Sorry, we don't have enough ")
    (display (car order))
    (display " in stock.")
    (newline)))

(define prices
  (make-prices
   (list (cons 'coke 100)
	 (cons 'fanta 100)
	 (cons 'karamalz 120)
	 (cons 'black-bush 250))))

(define inventory
  (make-inventory
   (list (cons 'coke 300)
	 (cons 'fanta 100)
	 (cons 'karamalz 200)
	 (cons 'black-bush 100))))

(define any
  (lambda (proc? list)
    (if (null? list)
	#f
	(if (proc? (car list))
	    (car list)
	    (any proc? (cdr list))))))

(define every?
  (lambda (proc? l)
    (fold-right (lambda (first result)
		  (and result (proc? first)))
		#t
		l)))

(define fold-right
  (lambda (proc unit l)
    (if (null? l)
	unit
	(proc (car l)
	      (fold-right proc unit (cdr l))))))