diff options
Diffstat (limited to 'assignment-6')
| -rw-r--r-- | assignment-6/multiplechoice.icl | 122 | ||||
| -rw-r--r-- | assignment-6/multiplechoice.prj | 59 |
2 files changed, 181 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..] diff --git a/assignment-6/multiplechoice.prj b/assignment-6/multiplechoice.prj new file mode 100644 index 0000000..f856ceb --- /dev/null +++ b/assignment-6/multiplechoice.prj @@ -0,0 +1,59 @@ +Version: 1.4 +Global + ProjectRoot: . + Target: iTasks + Exec: {Project}/multiplechoice + CodeGen + CheckStacks: False + CheckIndexes: True + Application + HeapSize: 167772160 + StackSize: 1048576 + ExtraMemory: 81920 + IntialHeapSize: 204800 + HeapSizeMultiplier: 4096 + ShowExecutionTime: False + ShowGC: False + ShowStackSize: False + MarkingCollector: False + DisableRTSFlags: False + StandardRuntimeEnv: True + Profile + Memory: False + MemoryMinimumHeapSize: 0 + Time: False + Stack: False + Dynamics: True + DescExL: False + Output + Output: ShowConstructors + Font: Monaco + FontSize: 9 + WriteStdErr: False + Link + LinkMethod: Static + GenerateRelocations: False + GenerateSymbolTable: False + GenerateLinkMap: False + LinkResources: False + ResourceSource: + GenerateDLL: False + ExportedNames: + Paths + Path: {Project} + Precompile: + Postlink: +MainModule + Name: multiplechoice + Dir: {Project} + Compiler + NeverMemoryProfile: False + NeverTimeProfile: False + StrictnessAnalysis: True + ListTypes: StrictExportTypes + ListAttributes: True + Warnings: True + Verbose: True + ReadableABC: False + ReuseUniqueNodes: True + Fusion: False |