(** Programmation Avancée, TP1, partie I *)

module type Container = sig
  type t
  type elt
  val empty  : t
  val add    : elt -> t -> t
  val merge  : t -> t -> t
  val member : elt -> t -> bool
  val fold   : ('a -> elt -> 'a) -> 'a -> t -> 'a
end


(** Question 1 *)

module type AnyT = sig
  type t
end

module LContainer (E:AnyT) : Container with type elt = E.t = struct
  type t = E.t list
  type elt = E.t
  let empty = []
  let add x l = x :: l
  let merge = List.append
  let member = List.mem
  let fold = List.fold_left
end


(** Question 2 *)

module SLContainer (E:Set.OrderedType) : Container with type elt = E.t =
struct
  type elt = E.t
  type t = elt list
  let empty = []
  let merge l1 l2 = List.merge E.compare l1 l2
  let add x l = merge [x] l
  let rec member x = function
    | [] -> false
    | y::l -> x=y || (x>y && member x l)
  let fold = List.fold_left
end


(** Tests *)

module Int = struct
  type t = int
  let compare = compare
end

let () =
  let module Test (M:Container with type elt = int) =
    struct
      open M
      let () =
        let s = add 42 (add 16 (add 64 empty)) in
        let s = merge s s in
          assert (member 42 s) ;
          assert (member 16 s) ;
          assert (member 64 s) ;
          Printf.printf "Result: " ;
          fold (fun () elt -> Printf.printf "%d+" elt) () s ;
          Printf.printf "ø\n"
      (** Question 4 *)
      let () =
        let s = add 1 (add 2 empty) in
        let t = add 2 (add 1 empty) in
          Printf.printf "Bonus: sorted = %b\n" (s = t)
    end
  in
  let module A = Test(LContainer(Int)) in
  let module B = Test(SLContainer(Int)) in
    ()


(** Question 3 *)

module type Printable = sig
  type t
  val to_string : t -> string
end

module type PContainer = sig
  include Container
  val to_string : t -> string
end

module MakePrintable (E:Printable) (C:Container with type elt = E.t) :
  PContainer with type elt = E.t =
struct
  include C
  let to_string set =
    let s =
      C.fold
        (fun s elt ->
          if s = "" then
            E.to_string elt
          else
            E.to_string elt ^ "+" ^ s)
        ""
        set
    in
      "[" ^ s ^ "]"
end


(** Tests *)

module String = struct
  include String
  let to_string x = x
end

let () =
  let module Test2 (M:PContainer with type elt = string) =
    struct
      open M
      let () =
        let s =
          add "d" (merge (add "a" empty) (add "c" (add "b" empty)))
        in
          Printf.printf "Result: %s\n" (to_string s)
    end
  in
  let module A = Test2(MakePrintable(String)(LContainer(String))) in
  let module B = Test2(MakePrintable(String)(SLContainer(String))) in
  let module M = MakePrintable(String)(SLContainer(String)) in
  let module C = MakePrintable(M)(LContainer(M)) in
  let s = M.add "foo" (M.add "bar" M.empty) in
  let t = C.add s (C.add s C.empty) in
    Printf.printf "Result: %s\n" (C.to_string t)