(* Compile with:
ocamlc -o ll str.cma ll.ml 
 
 //To-Do
 Assure proper order of answer, questions, points, etc
 
    MAT - 04272009 - Added "take defaults" functionality
    MAT - 04242009 - Added validation for radio buttons to assure that only one is checked in the source input.
    MAT - 04212009 - Added score calculation, fixed recording of answers for shortAnswer and checkbox, added report of # of answers correct, added max possible score (req 7)
    MAT - 03302009 - Added input validation for answers, e.g. radio has only 1
    MAT - 03092009 - User input validation and converted for loops to rec functions
    MAT - 03062009 - Added documentation
    MAT - 02252009 - Initial implementation

I. Objectives
II. Class Synopsis and Relations	
___________________________________________________________
I. Project Objectives									
- - -
Deliverable										Progress
1. True/False, Multiple Choice, Short Answer				We also have checkbox answers
2a. Read quiz from file								Check
2b. Present quiz to user								Check
2c. Show number right/wrong							Check, 4/21
2d. Show question they got wrong,their answer,correct
      answer
4a. Support question type							Check, Via specific syntax
4b. Support question literal, specification				Check, Via specific syntax
4c. Support question point value						Check, Via specific syntax
4d. Support possible answers allowed					Check, Only one correct answer allowed to be specified
4e. Support correct answer spec						Check
5a. Have way for quiz taker to identify themself
5b. Have way for quiz maker to specify instructions		Implemented with the intro
7. Calculate and display point value with instructions		Check
8. Provide of means of specifying default value			Partially implemented with the syntax of the questions


	
___________________________________________________________
II. Class Synopsis and Relations
- - -
quiz				- the encapsulator of questions and a potential intro, allows modularization of other classes
questionBlock 		- contains question text and reference to possible answers
answer 			- provides an interface for various types of answers to implement
radioAnswer		- implementation of answer that assumes only one in the questionBlock answers list will be chosen
checkboxAnswer	- implementation of answer that allows multiple answers to be selected
shortAnswer		- implementation of answer that expects string input
trueFalseAnswer	- implementation of radioAnswer, NOT YET IMPLEMENTED!
___________________________________________________________

*)

exception NotWellFormed of string;; 

(* Fetch all lines from a file *)
let rec input_lines file =
   match try [input_line file] with End_of_file -> [] with
      [] -> []
      | line -> line @ input_lines file
 
	
class questionBlock = 
object (self)
 val mutable question = ""								(* The string literal representative of the question *)
 val mutable answers = ([]:'answer list)				(* populated with answer objects when input file is analyzed *)
 val mutable lineDiff = 0								
 val mutable answerType = ""
 val mutable pointValue = -1							(* The worth of the question in terms of points if answered correctly *)
 val mutable answerSelected = (None : answer option)
 val mutable correctAnswerStr = ""
 
 method getLineDiff = lineDiff
 method setLineDiff i = lineDiff <- i
 method addAnswer (a:answer) = answers <- answers @ [a]
 method addAnswers (a:answer list) = 
	for i=0 to (List.length a)-1 do self#addAnswer (List.nth a i) done
 method checkAnswerTypeConsistency typeIn = 
	if answerType = "" then (self#setAnswerType typeIn)
	else if answerType != typeIn then raise (NotWellFormed "Answer types for question do not match")
 method checkPointValueUnspecified = (* Checks to assure that the point value for the question hasn't already been specified *)
	if pointValue <> -1 then raise (NotWellFormed "delete this exception");	(* If so, raise an exception *)

 method setAnswerType t = answerType <- t
 method getAnswerType = answerType
	
 method getPointValue = pointValue
 method setPointValue (v:string) = 
	try(pointValue <- (int_of_string v); true) 
	with Failure x -> (false)
	
 method setAnswerSelected i = answerSelected <- (Some (List.nth answers (i-1)))
 method setAnswerSelectedWithAnswerObj (aa:answer) = (*Used for short answer, use above for indexed answer *)
	answerSelected <- (Some aa); 	
 method getAnswerSelected = answerSelected
 
 (* Check to assure answer type integrity in src file, e.g. that there is only one radio checked, pass 1 0 to call this rec method *)
 method questionAnswersAreWellFormed answerNumber status = 
  if (List.length self#getAnswers) < answerNumber then (status) (* finally, return status *)
  else (
	  (* In analyzing the radios, if one is checked, act appropriately based on the current status of the answer already having one radio answer checked *)
	 if (List.nth self#getAnswers (answerNumber-1))#getChecked then (
	  match status with 
	   |0 -> (self#questionAnswersAreWellFormed (answerNumber+1) 1)
	   |_ -> (self#questionAnswersAreWellFormed (answerNumber+1) 2)
	 )
	 else ((self#questionAnswersAreWellFormed (answerNumber+1) status))
  );
  

 
 method wellFormedPointValue pv = (* XXX Points *) 
  if 	((String.length pv) < 8 ||		(* Not of the appropriate format, # (space) Points *)
		(String.sub pv (String.length pv - 6) 6) <> "Points" ||
		(not (self#setPointValue (String.sub pv 0 ((String.length pv)-7))))
		)
	then (
		(* --------- PointValue DEBUGGING ----------- *)
		Printf.printf "%B:%d %B %B" 
			((String.length pv) < 8) (String.length pv)
			((String.sub pv (String.length pv - 6) 6) <> "Points")
			(self#setPointValue (String.sub pv 0 ((String.length pv)-7)));
			
		raise (NotWellFormed ("Point value not well-formed: "^pv))
	);

	(* This is the start of the implementation to make sure that the # of points is not specified before the answer
	match answerSelected with 
	| Some x -> (print_endline x#getText) 
	| _->print_endline "No answer";
*)
	
	true
  
 
 method getAnswers = answers
 method setQuestion q = question <- q
 method getQuestion = question
 
 method setCorrectAnswer a = correctAnswerStr <- a
 method getCorrectAnswer = correctAnswerStr
 method getDefaultAnswerNumber i = (* always initially call with parameter as 0 *)
	if (List.nth self#getAnswers i)#getChecked then i
	else (self#getDefaultAnswerNumber (i+1))

end
and virtual answer =
object (self)
 val mutable answerNumber = "XXX" (* Relative to parent question, is a string for radio and short *)
 method virtual setChecked : unit
 method virtual getChecked : bool
 method virtual setText : string -> unit
 method virtual getText : string
 method virtual wellFormed : string -> bool	(* Check if answer specified in quiz source is valid, e.g. multiple radio answers is invalid *)
 method checkIfChecked (l:string) = ()		(* Needed for radio vadliation *)
 method setAnswerNumber n = answerNumber <- n
 method getAnswerNumber = answerNumber
 method correctAnswerIsWellFormedForAnswerType (answerType:string) (correctAnswerString:string) = 
	(* Assure that the answers specified in the input file are of appropriate type, for example, that two answers are not specified for an answer type of radio *)
	if answerType = "radio" then (
		if String.contains correctAnswerString ' ' then raise (NotWellFormed "Radio answers can only have one answered specified")
	)
	else if answerType = "checkbox" then  (
		let x = Str.split (Str.regexp " ") correctAnswerString  in ( (*Splits space delimited list into list-o-string *)
			let rec checkIfAnswersAreIntsLoop i = (
				if i<(List.length x) then 
					try ( if (int_of_string (List.nth x i)) > (-1) then checkIfAnswersAreIntsLoop (i+1)) 		(*Can I do this check without any side effects? *)
					with Failure x -> raise (NotWellFormed "Invalid answer for checkbox.")
			) in checkIfAnswersAreIntsLoop 0
		)
	)
	else if answerType = "short" then ()
	else (raise (NotWellFormed "An error occured in attempting to determine the answer type"));
	
	(*Printf.printf "Correct answer well-formed for %s question: %s\n" answerType correctAnswerString;*)
	
	true
 

end;;

class radioAnswer =
object (self)
inherit answer
val mutable checked = false
val mutable text = ""

method setChecked = checked <- true
method getChecked = checked
method setText t = text <- t
method getText = 
	if (String.sub text 1 1) = "|" then (String.sub text 3 ((String.length text)-3))	(* not default choice *)
	else (String.sub text 2 ((String.length text)-2))									(* Default choice *)
method wellFormed line = 
	if String.sub line 0 2 = "o " then true
	else if String.sub line 0 3 = "o| " then (self#setChecked; true)		(*Set this answer to checked. This can later be used to assure that only one radioAnswer is checked for the question*)
	else false
method checkIfChecked line = if String.sub line 0 3 = "o| " then self#setChecked
end;;

class trueFalseAnswer = (* Not implemented, but per spec *)
object (self)
inherit radioAnswer

end;;

class checkboxAnswer =
object (self)
inherit answer
val mutable checked = false
val mutable text = ""
method setChecked = checked <- true
method getChecked = checked
method setText t = text <- t
method getText = text
method wellFormed line = 
	if String.sub line 0 2 = "] " || String.sub line 0 3 = "x] " then true
	else false
end;;

class shortAnswer = 
object (self)
inherit answer
val mutable text = ""
val mutable checked = false
method setChecked = checked <- true
method getChecked = true
method setText (t:string) = text <- t
method getText = text
method wellFormed line = 
	if String.sub line 0 2 = "> " then true
	else false
end;;

class quiz = 
object (self)
 val mutable introText = ("":string)
 val mutable questions = ([]:questionBlock list)
 val mutable score = 0		
 val mutable quizTaker = ("":string)															(* The final score tabulated after taking the quiz *)
 val mutable maxPossibleScore = 0
 val mutable numberCorrect = 0															(* Per reqs, report number correct *)
 method setIntroText text = introText <- text
 method setQuizTaker name = quizTaker <- name
 method addQuestion q = questions <- List.append questions [q]
 method addToMaxPossibleScore p = maxPossibleScore <- (maxPossibleScore + p)
 method getMaxPossibleScore = maxPossibleScore
 
 method present = 	(* Partially implemented, likely similar to verbose *)

	Printf.printf "%s\nMaximum possible score: %d \n\n" introText self#getMaxPossibleScore;
        print_string "Please enter your name: ";
        self#setQuizTaker (read_line ());
		print_endline "";

	let rec questionLoop i = 
	 if i <= (List.length questions)-1 then (
		Printf.printf "\r\nQuestion %d (%s): %s\n" (i+1) (List.nth questions i)#getAnswerType (List.nth questions i)#getQuestion;
        
		let rec answerLoop a =
			if a <= (List.length ((List.nth questions i)#getAnswers))-1 then (
				if (List.nth questions i)#getAnswerType = "short" then Printf.printf "%s\n" (List.nth ((List.nth questions i)#getAnswers) a)#getText
				else (
					Printf.printf "%d) %s" (a+1) (List.nth ((List.nth questions i)#getAnswers) a)#getText;
					if (List.nth ((List.nth questions i)#getAnswers) a)#getChecked then print_string " (default)";
					print_endline ""
				);
				answerLoop (a+1)
			)
		in answerLoop 0;
		
		
		(* 
			Take input and validate 
		*)
		let rec choiceLoop x = (* This doesn't need a parameter but I can't figure out how to call rec functs w/o one *)
			Printf.printf "Your answer: ";
			try
				let str = read_line () in    
				(* Only take between 1 and # of answers for respective question for valid input, else throw Exception asking again *)
				if (List.nth questions i)#getAnswerType = "short" || (List.nth questions i)#getAnswerType = "checkbox" then (
					Printf.printf "%s\n" " ";
					let sa = new shortAnswer in (
						sa#setText str
					);
					(List.nth questions i)#setAnswerSelectedWithAnswerObj sa;
					questionLoop (i+1)
				)
				else if ((List.nth questions i)#getAnswerType = "radio" ) && (str = "\r\n" || str = "\r" || str = "\n" || str = "") then (* if radio, take default if only enter is hit *)
					(
					Printf.printf "(Default of %d taken)\r\n" (((List.nth questions i)#getDefaultAnswerNumber 0)+1);
					(List.nth questions i)#setAnswerSelected (((List.nth questions i)#getDefaultAnswerNumber 0)+1);
					questionLoop (i+1)
				)
				else if (int_of_string str) <= (List.length ((List.nth questions i)#getAnswers)) && (int_of_string str) > 0
				then (
					(List.nth questions i)#setAnswerSelected (int_of_string str);
					questionLoop (i+1) )
				else (raise (Failure "int_of_string"))		(* int_of_string was successful, but # not in domain *)
			with Failure (s) -> (							(* int_of_string failed because of bad input, ask again *)
				Printf.printf "(X) Invalid Choice for a %s question.\n" (List.nth questions i)#getAnswerType;
				choiceLoop 0
				)
		in choiceLoop 0;
	)
	in questionLoop 0;

	
method getScore = score
method getQuizTaker = quizTaker
method setScore (s:int) = score <- s
method addToScore (s:int) = self#setScore (s+self#getScore)
method incrementNumberOfQuestionsCorrect = numberCorrect <- numberCorrect + 1
method getNumberOfQuestionsCorrect = numberCorrect	
	
method calculateScore =
	print_endline "-----------------\nTHE RESULTS\n-----------------";
	for i=0 to ((List.length questions)-1) do
		let ca = (List.nth questions i)#getCorrectAnswer in

		match (List.nth questions i)#getAnswerSelected with
		| Some aa -> (
			(* Radios use #s for answers, others use strings. Because of this, below pattern matching is necessary, though it's likely not efficient due to code duplication *)
			match (List.nth questions i)#getAnswerType with
			| "radio" -> (
				if ca = aa#getAnswerNumber then (self#incrementNumberOfQuestionsCorrect; self#addToScore (List.nth questions i)#getPointValue);
				Printf.printf "Question %d\n  Correct:%s\n  Answered:%s\n" (i+1) (List.nth questions i)#getCorrectAnswer aa#getAnswerNumber)	
			| _ -> (
				if ca = aa#getText then (self#incrementNumberOfQuestionsCorrect; self#addToScore (List.nth questions i)#getPointValue);
				Printf.printf "Question %d\n  Correct:%s\n  Answered:%s\n" (i+1) (List.nth questions i)#getCorrectAnswer aa#getText)
			)
		| None -> failwith "Something went awry! No answer given by user for question!"
		
	done;
	Printf.printf "\nCongratulations, %s, you've completed the quiz!" self#getQuizTaker;
	Printf.printf "\r\nYou got %d out of %d questions correct for a score of %d.\r\n" self#getNumberOfQuestionsCorrect (List.length questions) self#getScore
	
end;;




(* Take the source filename as the first parameter in the program execution. If unspecified, fail. *)
try (String.length Sys.argv.(1)) 
with Invalid_argument x -> (failwith "Please specify a filename as the first parameter.");;

let stringList = (input_lines (open_in Sys.argv.(1)));;

let q = new quiz;;														(* Create quiz constructs to be "filled in" with data below *)
q#setIntroText (List.nth stringList 0);;								(* Assumes (per lang definition) that intro is first line of file before \r *)

let rec nextCRLF line = 												(* Finds where the next CRLF is based on starting line *)
	try (
		if String.length (List.nth stringList line) = 0 then line
		else nextCRLF (line+1)
	) with Failure x -> (
		if (List.length stringList)=line then (line)
		else (raise (NotWellFormed "foo"))
	);;
	 

let newQuestion startingLine = 
	let nextCRLF = (nextCRLF startingLine) in 
	 let newQ = (new questionBlock) in
	    newQ#setQuestion (List.nth stringList startingLine);
		newQ#setLineDiff (nextCRLF-startingLine-1);										(*determine how many lines are to this question block including the question itself plus the answer line. EOF or \r is the "end" *)
		
		(* Loop through answers as driven by the text input*)
		let rec analyzeLine i =	
			if i <= nextCRLF-1 then (
			
			(* There's lots of redundancy here, but it's all dependent on a locally scoped a with a different type based on the answer. Can we break this apart? *)
			if (new radioAnswer)#wellFormed (List.nth stringList i) then (	
				newQ#checkAnswerTypeConsistency "radio";
				let a = (new radioAnswer) in
					a#setText (List.nth stringList i);
					a#setAnswerNumber (string_of_int ((List.length (newQ#getAnswers))+1));
					a#checkIfChecked (List.nth stringList i);
					newQ#addAnswer a 										)
			else if (new checkboxAnswer)#wellFormed (List.nth stringList i) then (
				newQ#checkAnswerTypeConsistency "checkbox";
				let a = (new checkboxAnswer) in
					a#setText (List.nth stringList i);
					a#setAnswerNumber (string_of_int ((List.length (newQ#getAnswers))+1));
					newQ#addAnswer a 						)
			else if (new shortAnswer)#wellFormed (List.nth stringList i) then (
				newQ#checkAnswerTypeConsistency "short";
				let a = (new shortAnswer) in
					(* Prevents shortAnswers from having more than one answer and being considered well-formed 
					if (List.length newQ#getAnswers) > 1 then (raise NotWellFormed);*)
					a#setText (List.nth stringList i);
					(*a#setAnswerNumber "2";*)
					newQ#addAnswer a                          )
			else if (String.sub (List.nth stringList i) 0 4 = "Ans ") then (	
				if ((new radioAnswer):>answer)#correctAnswerIsWellFormedForAnswerType newQ#getAnswerType (String.sub (List.nth stringList i) 4 ((String.length (List.nth stringList i))-4)) then 
					newQ#setCorrectAnswer (String.sub (List.nth stringList i) 4 ((String.length (List.nth stringList i))-4))
			)
			else if (newQ)#wellFormedPointValue (List.nth stringList i) then (
				q#addToMaxPossibleScore newQ#getPointValue;
				Printf.printf "Point value = %d.\n" newQ#getPointValue	(* Will throw an exception if it has already been specified *)
			)
			else (raise (NotWellFormed "Answers not well-formed"));
			if (i+1) < (nextCRLF) then analyzeLine (i+1)
			)
		
		in analyzeLine (startingLine+1);
		if newQ#getAnswerType = "radio" then (
			match (newQ#questionAnswersAreWellFormed 1 0) with (* Check integrity of radio answers *)
				|0 -> raise (NotWellFormed "A radio answer does not have a default specified")
				|2 -> raise (NotWellFormed "A radio answer has too many defaults specified. Please check your source file.")
				| _ -> ()
		);
		newQ
;;

let rec parse lineNum inQuestion inIntro=
let inQ = ref inQuestion in
let currentLine = ref lineNum in 
let inInt = ref inIntro in
if !currentLine < (List.length stringList) then begin													(* Check for EOF *)
	if !inQ = false && !inInt = false then (															(* Not intro and between questions *)	
		if (List.nth stringList (!currentLine)) = "" then 	(	
			parse ((!currentLine)+1) false false 				)										(*Excessive CRLF, call again until not CRLF *)
		 else (
				let newQ = (newQuestion !currentLine) in	
				q#addQuestion newQ;
				currentLine := !currentLine + newQ#getLineDiff;
				)
	);	

	

	(* Intro *)
	(* Mac-formatted input documents, i.e. only CR, die here *)
	if (!currentLine+1) >= (List.length stringList) then () (* EOF *)
	else if String.length (List.nth stringList (!currentLine+1)) = 0 then (parse ((!currentLine)+2) false false)(* Carriage returns!?! We don't need no stinkin' carriage returns! *)
	else (raise (NotWellFormed "Intro not well-formed"));
	
end;; (* End EOF check *)


(*let rec parse lineNum inQuestion inIntro *)
parse 0 false true;;
q#present;;
q#calculateScore;;


Little languages meta data, can be put in littleLangaugesData.txt

-------------------- Welcome to my quiz! --------------------

What color is an apple?
o red
o blue
o| green
o yellow
Ans 1
4 Points

What is the square root of 4
] 2
] 1.44
] 0
x] -2
Ans 1 4
5 Points

What is your Programming Languages professor's last name?
> (short answer expected)
Ans Rudolph
7 Points