initial check in of what stuff I tried so far, not looking very good
[darcs-mirror-latutman.git] / haskell / Types.hs
1 {-# OPTIONS -fglasgow-exts -fth -fallow-undecidable-instances #-}
2
3 module Types where 
4
5 import HAppS.Data
6 import HAppS.Server.SimpleHTTP
7 import Data.List
8
9 $( deriveAll [''Ord,''Eq,''Read,''Show,''Default] 
10    [d|
11       
12       newtype Points    = Points Int
13       newtype StudentID = StudentID String deriving (FromReqURI)
14       newtype MaxPoints = MaxPoints Int
15       newtype AssName   = AssName String deriving (FromReqURI)
16       newtype Password  = Password String
17       newtype EMail     = EMail String
18
19       data HandIn = HandIn {
20         hiStudentID :: StudentID,
21         hiAssName :: AssName,
22         hiPoints :: Points
23         }
24       newtype HandIns = HandIns [HandIn]
25
26       data Assignment = Assignment {
27         assName :: AssName,
28         maxPoints :: MaxPoints
29         }
30       newtype Assignments = Assignments [Assignment]
31
32       data Student = Student {
33         studentID :: StudentID,
34         password :: Password,
35         email :: EMail
36         }
37       newtype Students = Students [Student]
38       
39       -- Views
40       data AssignmentWithHandIns = AssignmentWithHandIns Assignment [HandIn]
41       newtype AssignmentsWithHandIns = AssignmentsWithHandIns [AssignmentWithHandIns]
42
43       newtype TableHead r = TableHead r
44       data TableCell a = TableCell (Maybe a)
45       data TableRow r a = TableRow (TableHead r) [TableCell a]
46       data Table c r a = Table [TableHead c] [TableRow r a]
47
48  |] )
49
50
51 findAssignment name  = find ((==name) . assName)
52 removeAssignment ass  = filter ((/=assName ass) . assName)
53
54 findStudent name  = find ((==name) . studentID)
55 removeStudent name  = filter ((/=name) . studentID)
56
57 selectHandIn name id hi = hiAssName hi == name && hiStudentID hi == id
58 removeHandIn hi = filter (not . selectHandIn (hiAssName hi) (hiStudentID hi))
59