module SetTest (Set: SET) : sig 
  val testAll: string -> string -> unit 
  val testSmall: unit -> unit
  val testBig: unit -> unit
end = struct 

      module SU = StringUtils
      module SS = StandardSet(String) (* The reference implementation against which we compare Set *)

      let rec fromFile setFromList filename = 
        let _ = SU.print ("Reading " ^ filename ^ " into list ...") in 
        let words = List.map String.lowercase (File.fileToWords filename) in
        let _ = SU.print (
                  "done\n"
                ^ "List has "
                ^ (string_of_int (List.length words))
                ^ " elements\nCreating set from list ...") in 
        let set = setFromList words in 
        let _ = SU.print ("done\n") in    
          set

      let rec testAll filename1 filename2 = 
        let set1 = fromFile Set.fromList filename1 in 
        let set2 = fromFile Set.fromList filename2 in
        let set1' = fromFile SS.fromList filename1 in 
        let set2' = fromFile SS.fromList filename2 in  
        let sets = (set1,set2,set1',set2') in 
          (testInsert sets; testDelete sets ; testUnion sets; 
           testIntersection sets; testDifference sets; testSexp sets)  

      and testInsert (s1,s2,s1',s2') = 
          test "insert" (s1,s2,s1',s2')
               (Set.insert "i" (Set.insert "alabaster" s1))
               (SS.insert "i" (SS.insert "alabaster" s1'))

      and testDelete (s1,s2,s1',s2') = 
          test "delete" (s1,s2,s1',s2')
               (Set.delete "i" (Set.delete "alabaster" s1))
               (SS.delete "i" (SS.delete "alabaster" s1'))

      and testUnion (s1,s2,s1',s2') = 
          test "union" (s1,s2,s1',s2') (Set.union s1 s2) (SS.union s1' s2')

      and testIntersection (s1,s2,s1',s2') = 
          test "intersection" (s1,s2,s1',s2') (Set.intersection s1 s2) (SS.intersection s1' s2')

      and testDifference (s1,s2,s1',s2') = 
          test "difference" (s1,s2,s1',s2') (Set.difference s1 s2) (SS.difference s1' s2')

      and testSexp (s1,s2,s1',s2') = 
         let stringToSexp s = Sexp.Str s in 
           test "toSexp/fromSexp" (s1,s2,s1',s2') 
	     (Set.fromSexp Sexp.sexpToString(Set.toSexp stringToSexp s1))
   	     (SS.fromSexp Sexp.sexpToString (SS.toSexp stringToSexp s1'))

      and test name (s1,s2,s1',s2') s3 s3' = 
        let _ = SU.print ("Testing " ^ name ^ " ...") in 
        let str = compareLists (Set.toList s3) (SS.toList s3') 
        in if str = "OK!\n" then SU.print str else 
          let _ = SU.print str in 
          let _ = SU.print ("\nYour set 1:\n" ^ (Set.toString FunUtils.id s1)) in
          let _ = SU.print ("\n\nStandard set 1:\n" ^ (SS.toString FunUtils.id s1')) in 
          let _ = SU.print ("\n\nYour set 2:\n" ^ (Set.toString FunUtils.id s2)) in
          let _ = SU.print ("\n\nStandard set 2:\n" ^ (SS.toString FunUtils.id s2')) in 
          let _ = SU.print ("\n\nYour set 3:\n" ^ (Set.toString FunUtils.id s3)) in
          let _ = SU.print ("\n\nStandard set 3:\n" ^ (SS.toString FunUtils.id s3')) in 
            ()

      and compareLists xs ys = 
	match (xs,ys) with
	  ([], []) -> "OK!\n"
	| (x::xs', y::ys') -> 
	    if x = y then compareLists xs' ys'
	    else "\n***ERROR***: First set begins with " 
                  ^ x ^ " but second set begins with " ^ y ^ "\n"
	|  ([], y::ys') -> 
            "\n***ERROR***: First set exhausted "
            ^ "when second begins with " ^ y ^ "\n"
	|  (x::xs', []) -> 
            "\n***ERROR***: Second set exhausted "
             ^ "when second begins with " ^ x ^ "\n"

      and testSmall () = testAll "../text/green-eggs-init.txt" 
                                 "../text/cat-in-hat-init.txt"

      and testBig () = testAll "../text/green-eggs.txt" 
                               "../text/cat-in-hat.txt"

    end