(*** Exemple d'implementation du pattern Visitor *)

(*the equipment virtual class: fixes method types, and provides a superclass to coerce to *)

class virtual ['equipmentvisitor]equipment = 
  object 
    method virtual name : unit -> string
    method virtual price : unit -> int
    method virtual accept : 'equipmentvisitor -> unit 
  end

class ['equipmentvisitor]floppy () =
  object (self)
    inherit ['equipmentvisitor]equipment 
    method name () = "floppy"
    method price () = 5
    method price1 () = 10
    method accept v = v#visitFloppy self
  end

class ['equipmentvisitor]chassis () = 
  object (self) 
    inherit ['equipmentvisitor]equipment 
    method name () = "chassis" 
    method price () = 10 
    method price2 () = 15
    method price1 () = 12
    method accept v = v#visitChassis self 
  end 

class ['equipmentvisitor]computer () = 
  object (self:'a) 
    inherit ['equipmentvisitor]equipment
    val mutable subcomponents = ([] : 'equipmentvisitor equipment list) 
    method name () = "computer" 
    method price () = 100
    method add component = subcomponents <- component::subcomponents
    method components = subcomponents
    method accept v = v#visitComputer self
  end 


(*visitor classes*) 

class virtual equipmentvisitor = 
  object
    method virtual visitFloppy : equipmentvisitor floppy -> unit 
    method virtual visitChassis : equipmentvisitor chassis -> unit
    method virtual visitComputer : equipmentvisitor computer -> unit
    method virtual getresult : unit
  end

class pricevisitor () =
  object (self)
    inherit equipmentvisitor 
    val mutable totalprice = 0 
    method visitFloppy f = let newtotal = totalprice + f#price1 () in Printf.printf " -> %d\n" newtotal; totalprice <- newtotal
    method visitChassis c = let newtotal = totalprice + c#price2 () in Printf.printf " -> %d\n" newtotal; totalprice <- newtotal
    method visitComputer c = List.iter (fun c -> c#accept (self:>equipmentvisitor)) c#components
    method getresult = print_int totalprice
  end


class othervisitor () = 
  object
    inherit equipmentvisitor
    val mutable totalprice = 0 
    method visitFloppy f  = Printf.printf "%s\n" (f#name ()) 
    method visitChassis c = Printf.printf "%s\n" (c#name ())
    method visitComputer c = Printf.printf "%s\n" (c#name ())
    method getresult = ()
  end

(* use of the classes *) 

let a = new floppy ();;
let b = new chassis ();; 
let c = new computer ();;
let d = new computer ();;

c#add (b :> 'a equipment);;
c#add (a :> 'a equipment);;

(* d#add c;; (* this would fail, because in OCaml subtyping only works through explicit coercions *) *)

d#add (c :> 'a equipment);;
d#add (c :> 'a equipment);;

let ov = new othervisitor ();; 
let pv = new pricevisitor ();;

let _ = a#accept ov;;
let _ = b#accept ov;;
let _ = c#accept ov;;
let _ = d#accept ov;;

ov#getresult;;

let _ = a#accept pv;;
let _ = b#accept pv;;
let _ = c#accept pv;;
let _ = d#accept pv;;

pv#getresult;;