;;Polymorphism Example

;; Abstract superclass
;; (make-Animal string (--> string))
;; age: --> number
(define-struct Animal (name speak getAge  haveBirthday))

;;Factory to make Cat subclass
(define (makeCat name age)
  (make-Animal name
               (lambda ()
                 "meow")
               (lambda ()
                 age)
               (lambda ()
                 (set! age (add1 age))))) ;; won't work


;;Factory to make Dog subclass
(define (makeDog name age)
  (make-Animal name
               (lambda ()
                 "rowf")
               (lambda ()
                 age)
               (lambda ()
                 (set! age (add1 age)))))  ;; won't work 

;;Factory to make Parrot subclass
;; note the ability for the parrot to reference itself.
(define (makeParrot name an-age)
  (local
      [(define age an-age)
       (define this (make-Animal name
                                 (lambda ()
                                   (string-append "My name is " (Animal-name this) " and I " (number->string age)  " years old"))
                                 (lambda ()
                                   age)
                                 (lambda ()
                                   (set! age (add1 age)))))]  ;; will work!
    this))


;; Instantiate some Animals
(define myCat (makeCat "Fluffy" 3))
(define myDog (makeDog "Rover" 10))
(define myParrot (makeParrot "Polly" 8))

"Animal testing (polymorphism at work):"
((Animal-speak myCat))
((Animal-speak myDog))
((Animal-speak myParrot))
(set-Animal-name! myParrot "Thing")
((Animal-haveBirthday myParrot))
((Animal-speak myParrot))

;; Abstraction level of the above code is at the Animal level.

;; Note that we can't add Cat, Dog or Parrot-specific functions or data 
;; because the Cat, Dog and Parrot sub-classes don't really exist...yet (hee, hee!)


;; ======= Compare and Contrast vs. Visitor pattern (so far) =======================

;; Abstract superclass
;; A Fruit is a structure that is either
;; -- Apple
;; -- Lemon
;; -- Mango


;; An Apple
;; texture is a string
(define-struct Apple (texture))

;; A Lemon
;; taste is astring
(define-struct Lemon (taste))

;; A Mango
;; smell is a string
(define-struct Mango (smell))

;;instantiate some Fruit
(define myApple (make-Apple "juicy"))
(define myLemon (make-Lemon "sour"))
(define myMango (make-Mango "heady and tropical"))

;; A Fruit visitor
;; appleCase: Apple any1 --> any2
;; lemonCase: Lemon any1 --> any2
;; mangoCase: Mango any1 --> any2
(define-struct FruitVisitor (appleCase lemonCase mangoCase))

;; The execute function
(define (fruitExecute a-fruit visitor param)
  (cond
    [(Apple? a-fruit) ((FruitVisitor-appleCase visitor) a-fruit param)]
    [(Lemon? a-fruit) ((FruitVisitor-lemonCase visitor) a-fruit param)]
    [(Mango? a-fruit) ((FruitVisitor-mangoCase visitor) a-fruit param)]))


;; a fruit visitor
(define testFruitVisitor
  (make-FruitVisitor
   (lambda (a-apple age)
     (string-append "My " age " apple feels " (Apple-texture a-apple)))
   (lambda (a-lemon age)
     (string-append "My " age " lemon tastes " (Lemon-taste a-lemon)))
   (lambda (a-mango age)
     (string-append "My " age " mango smells " (Mango-smell a-mango)))))

"Fruit tests:"

(fruitExecute myApple testFruitVisitor  "day-old")
(fruitExecute myMango testFruitVisitor  "day-old")
(fruitExecute myLemon testFruitVisitor  "under-ripe")
(fruitExecute myMango testFruitVisitor  "just-picked")

;; Abstraction level of the above code is at the Fruit level -- similar to polymorphism example above.
;; Note that the Apple, Lemon, and Mango classes exist and have specific behaviors.