1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
module skeleton5
import iTasks
import Data.Functor
/*
* Pieter Koopman, pieter@cs.ru.nl
* Advanced Programming. Skeleton for assignment 5
* - use this a project with environment iTasks
* - executable must be in Examples/iTasks or a subdirectory
* You can also use the -sdk commandline flag to set the path
* check Project Options -> Profiling -> Dynamics to prevent recompilation
*/
:: Student =
{ name :: String
, snum :: Int
, bama :: BaMa
, year :: Int
}
:: BaMa = Bachelor | Master
derive class iTask Student, BaMa
//Start w = startEngine (task8 (hd students)) w
Start w = startEngine (chooseTask >>= id) w
chooseTask :: Task (Task ())
chooseTask = snd <$> enterChoice (Title "What do you want to see?")
[ChooseFromDropdown fst]
[ ("Enter a new student", () <$ task1)
, ("Enter a list of students", () <$ task2)
, ("Update the first student", () <$ task3 (hd students))
, ("Pick a favourite student", () <$ task4)
, ("Pick a student (name only)", () <$ task5)
, ("Pick a student (gToString)", () <$ task6)
, ("Pick partners", () <$ task7)
, ("Change the first student's name", () <$ task8 (hd students))
]
task1 :: Task Student
task1 = enterInformation (Title "Enter a student") []
task2 :: Task [Student]
task2 = enterInformation (Title "Enter some students") []
task3 :: (Student -> Task Student)
task3 = updateInformation (Title "Update the student") []
task4 :: Task Student
task4 = enterChoice (Title "Pick a student") [] students
task5 :: Task Student
task5 = enterChoice (Title "Pick a student") [ChooseFromDropdown \s -> s.Student.name] students
task6 :: Task Student
task6 = enterChoice (Title "Pick a student") [ChooseFromDropdown gToString{|*|}] students
task7 :: Task [Student]
task7 = enterMultipleChoice (Title "Pick some partners") [ChooseFromCheckGroup show] students
where show s = s.Student.name + " (" + gToString{|*|} s.bama + ")"
// I suppose there is a nicer way for this, perhaps using withEditMode?
// But then how to select the fields for which the View mode applies?
task8 :: Student -> Task Student
task8 s = updateInformation
(Title "Update the student")
[UpdateAs (\s -> s.Student.name) (\s n -> {Student | s & name=n})]
s -|| viewInformation (Title "Current value") [] s
students :: [Student]
students =
[ { name = "Alice"
, snum = 1000
, bama = Master
, year = 1
}
, { name = "Bob"
, snum = 1003
, bama = Master
, year = 1
}
, { name = "Carol"
, snum = 1024
, bama = Master
, year = 2
}
, { name = "Dave"
, snum = 2048
, bama = Master
, year = 1
}
, { name = "Eve"
, snum = 4096
, bama = Master
, year = 1
}
, { name = "Frank"
, snum = 1023
, bama = Master
, year = 1
}
]
generic gToString a :: a -> String
gToString{|Int|} x = toString x
gToString{|String|} x = x
gToString{|UNIT|} UNIT = ""
gToString{|PAIR|} fx fy (PAIR x y) = fx x + " " + fy y
gToString{|EITHER|} fx fy (LEFT x) = fx x
gToString{|EITHER|} fx fy (RIGHT y) = fy y
gToString{|CONS of d|} fx (CONS x)
| d.gcd_arity == 0 = d.gcd_name
| otherwise = d.gcd_name + " " + fx x
gToString{|OBJECT|} fx (OBJECT x) = fx x
gToString{|FIELD of f|} fx (FIELD x) = f.gfd_name + ": " + fx x + next
where
next
| f.gfd_index == f.gfd_cons.grd_arity - 1 = ""
| otherwise = "; "
gToString{|RECORD|} fx (RECORD x) = fx x
derive gToString Student, BaMa
instance + String where + s t = s +++ t
|
