1 files changed, 122 insertions, 0 deletions
diff --git a/assignment-6/multiplechoice.icl b/assignment-6/multiplechoice.icl
new file mode 100644
index 0000000..327ef21
--- /dev/null
+++ b/assignment-6/multiplechoice.icl
@@ -0,0 +1,122 @@
+module multiplechoice
+
+from StdEnv import flip
+
+from Data.Func import $
+import Data.Functor
+import Data.Tuple
+
+import iTasks
+
+Start w = startEngine (allTasks createUsers >>| doAuthenticated (get currentUser >>- main)) w
+where
+	createUsers :: [Task UserAccount]
+	createUsers = [catchAll (createUser u) (\_ -> return u) \\ u <- myUsers]
+
+:: 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 (AuthenticatedUser s _ _) = isMember s ["Rinus", "Pieter"]
+	isTeacher _                                = False
+	isAdmin u = u =: (AuthenticatedUser "admin" _ _)
+
+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 a) -> Task (Maybe a) | iTask a
+	cancelable t = t >>*
+		[ OnAction (Action "Cancel") $ always   $ return Nothing
+		, OnAction (Action "Save")   $ hasValue $ return o Just
+		]
+
+	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..]