module multiplechoice

// Homework by Laurens Kuiper (s4467299) and Camil Staps (s4498062)

from StdEnv import flip

from Data.Func import $
import Data.Functor
import Data.Tuple

import iTasks

Start w = startEngine (allTasks createUsers >>| authedMain) w
where
	createUsers :: [Task UserAccount]
	createUsers = [catchAll (createUser u) (const $ return u) \\ u <- myUsers]

	authedMain :: Task ()
	authedMain = doAuthenticated (get currentUser >>- main) >>*
		[OnAllExceptions (\_ ->
			viewInformation (Title "Login failed") [] "Your username or password is incorrect"
			>>| authedMain)]

:: Question =
	{ question :: String
	, answers  :: [String]
	, correct  :: Int
	}

:: Result
	= Correct
	| Incorrect
	| Skipped

:: Results =
	{ correct   :: Int
	, incorrect :: Int
	, skipped   :: Int
	}

derive class iTask Question, Result, Results

clear :: (Question -> Question)
clear = const {question="", answers=[], correct=0}

questions :: Shared [Question]
questions = sharedStore "questions" []

main :: User -> Task ()
main u
| isTeacher u = teacherTask
| isAdmin   u = adminTask
| otherwise   = studentTask
where
	isTeacher = hasRole TEACHER
	isAdmin   = hasRole ADMIN

	hasRole r (AuthenticatedUser _ rs _) = isMember r rs
	hasRole _ _                          = False

teacherTask :: Task ()
teacherTask = enterChoiceWithShared
		("Manage questions", "Select a question to modify:")
		[ChooseFromGrid snd]
		(mapRead withIndexes questions) >>*
	[ OnAction (Action "Append") $ hasValue $ doAndContinue o append o ((+) 1) o fst
	, OnAction (Action "Delete") $ hasValue $ doAndContinue o flip upd questions o removeAt o fst
	, OnAction (Action "Edit")   $ hasValue $ doAndContinue o edit
	, OnAction (Action "First")  $ always   $ doAndContinue $ append 0
	, OnAction (Action "Clear")  $ hasValue $ doAndContinue o flip upd questions o flip updateWithAt clear o fst
	, OnAction (Action "Quit")   $ always   $ return ()
	]
where
	doAndContinue :: (Task a) -> Task () | iTask a
	doAndContinue t =
		viewSharedInformation "Current items" [] questions ||- t
			<<@ ApplyLayout (setUIAttributes (directionAttr Horizontal))
		>>| teacherTask

	cancelable :: (Task Question) -> Task (Maybe Question)
	cancelable t = t >>*
		[ OnAction (Action "Cancel") $ always            $ return Nothing
		, OnAction (Action "Save")   $ ifValue isCorrect $ return o Just
		]
	where
		isCorrect :: Question -> Bool
		isCorrect q = q.Question.correct < length q.answers && q.Question.correct >= 0

	append i   = cancelable (enterInformation  "New item"  [])   >>= ifJust (flip upd questions o insertAt i)
	edit (i,q) = cancelable (updateInformation "Edit item" [] q) >>= ifJust (flip upd questions o updateAt i)

	ifJust :: (a -> Task b) (Maybe a) -> Task () | iTask b
	ifJust _ Nothing  = return ()
	ifJust t (Just v) = t v @ const ()

adminTask :: Task ()
adminTask = updateSharedInformation "Administrate questions" [] questions @ const ()

studentTask :: Task ()
studentTask = get questions >>= sequence "Answer questions" o map answer >>= showResults
where
	answer :: Question -> Task Result
	answer q =
		enterChoice (q.question, "Answer:") [ChooseFromList snd] (withIndexes q.answers)
		>>* [ OnAction (Action "Skip") $ always $ return Skipped
		    , OnAction (Action "Continue") $ hasValue \(a,_) -> return (if (a == q.Question.correct) Correct Incorrect)
		    ]

	showResults :: [Result] -> Task ()
	showResults rs = viewInformation (Title "Results") [] {correct=c, incorrect=i, skipped=s} @ const ()
	where
		c = length [0 \\ Correct   <- rs]
		i = length [0 \\ Incorrect <- rs]
		s = length [0 \\ Skipped   <- rs]

TEACHER :== "teacher"
ADMIN   :== "admin"
STUDENT :== "student"

myUsers :: [UserAccount]
myUsers =
	[ user "Rinus"   "1t4$ks" TEACHER
	, user "Pieter"  "naelc"  TEACHER
	, user "admin"   "admin"  ADMIN
	, user "Camil"   "root"   STUDENT
	, user "Laurens" "37+5"   STUDENT
	]
where
	user u p r = {credentials={username=Username u,password=Password p},title=Nothing,roles=[r]}

updateWithAt :: Int (a -> a) [a] -> [a]
updateWithAt i f xs = updateAt i (f (xs!!i)) xs

withIndexes :: ([a] -> [(Int,a)])
withIndexes = zip2 [0..]