be8170039327920f42c351ec24e7b5849c77f76e
[clean-tests.git] / afp / a5 / a5.icl
1 module a5
2
3 import Data.List
4 import Data.Func
5 import Text
6
7 import iTasks
8
9 derive class iTask Function, Question
10 :: Function = Student | Teacher | Admin
11 :: Question =
12 { question :: String
13 , answers :: [String]
14 , correct :: Int
15 }
16
17 questions :: Shared [Question]
18 questions = sharedStore "questions"
19 [{question="Afp cool?"
20 ,answers=["yes", "no"]
21 ,correct=0}
22 ,{question="Mart the awesomest TA?"
23 ,answers=["yes", "no"]
24 ,correct=0}
25 ]
26
27 Start w = doTasks login w
28
29 login :: Task [Question]
30 login = enterInformation "Enter your function" []
31 >>= \function->case function of
32 Teacher = teacher
33 Admin = admin
34 Student = student
35
36 student :: Task [Question]
37 student = get questions
38 >>= \qs->sequence (map makeQuestion qs) @ distillResult
39 >>= viewInformation "Result" []
40 >>* [OnAction (Action "Quit") (always login)]
41 where
42 makeQuestion :: Question -> Task Bool
43 makeQuestion q = enterChoice q.question [ChooseFromList snd] (zip2 [0..] q.answers)
44 @? \v->case v of
45 NoValue = NoValue
46 Value (idx, _) _ = Value (idx == q.correct) True
47
48 distillResult :: [Bool] -> String
49 distillResult [] = "No questions answered!"
50 distillResult b = concat
51 [ "You had "
52 , toString good
53 , " answers correct and "
54 , toString bad
55 , " answers incorrect which results in a score of: "
56 , toString $ good*100 / (good+bad)
57 , "/100"
58 ]
59 where
60 good = length [()\\True<-b]
61 bad = length [()\\False<-b]
62
63 admin :: Task [Question]
64 admin = updateSharedInformation "Questions" [] questions
65
66 teacher :: Task [Question]
67 teacher = forever
68 $ enterChoiceWithShared "Choose an item to edit" [ChooseFromList id] questions
69 >>*
70 [ OnAction (Action "Append") (withValue $ Just o append)
71 , OnAction (Action "Delete") (withValue $ Just o delete)
72 , OnAction (Action "Edit") (withValue $ Just o edit)
73 , OnAction (Action "Clear") (withValue $ Just o clear)
74 , OnAction (Action "First") (always first)
75 , OnAction (Action "Quit") (always login)
76 ]
77 where
78 append choice = orCancel (enterInformation () []) \nq->upd (insertAfter choice nq) questions
79 delete choice = upd (deleteBy (===) choice) questions
80 edit choice = orCancel (updateInformation () [] choice) $ replace choice
81 clear choice = orCancel (enterInformation () []) $ replace choice
82 first = orCancel (enterInformation () []) \nq->upd (\x->[nq:x]) questions
83
84 replace choice nq = upd (deleteBy (===) choice o insertAfter choice nq) questions
85
86 insertAfter :: a a [a] -> [a] | gEq{|*|} a
87 insertAfter after el [] = [el]
88 insertAfter after el [e:es]
89 | e === after = [e,el:es]
90 = insertAfter after el es
91
92 orCancel do done = do >>*
93 [ OnAction (Action "Cancel") (always teacher)
94 , OnAction (Action "Continue") (withValue (Just o done))
95 ]