Lecturer toles added

models/courses

@@ -33,6 +33,7 @@ CourseFavourite           -- which user accessed which course when, only display
 Lecturer                       -- course ownership
     user         UserId
     course       CourseId
+    type         LecturerType  default='"lecturer"'
     UniqueLecturer user course -- note: multiple lecturers per course are allowed, but no duplicated rows in this table
 CourseParticipant                      -- course enrolement
     course       CourseId

src/Handler/Course.hs

@@ -481,7 +481,7 @@ courseEditHandler mbCourseForm = do
             (Just cid) -> do
               runDB $ do
                 insert_ $ CourseEdit aid now cid
-                insert_ $ Lecturer aid cid
+                insert_ $ Lecturer aid cid CourseLecturer
               addMessageI Info $ MsgCourseNewOk tid ssh csh
               redirect $ TermCourseListR tid
             Nothing ->

src/Model/Types.hs

@@ -772,6 +772,20 @@ instance FromJSON AuthTagActive where
 derivePersistFieldJSON ''AuthTagActive
 
 
+
+data LecturerType = CourseLecturer | CourseAssistant
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+
+instance Universe LecturerType
+instance Finite LecturerType
+
+nullaryPathPiece ''LecturerType $ camelToPathPiece' 1
+deriveJSON  defaultOptions
+  { constructorTagModifier = camelToPathPiece' 1
+  } ''LecturerType
+derivePersistFieldJSON ''LecturerType
+
+
 -- Type synonyms
 
 type Email           = Text

test/Database.hs

@@ -390,8 +390,8 @@ fillDb = do
   insert_ $ CourseEdit jost now ffp
   void . insert $ DegreeCourse ffp sdBsc sdInf
   void . insert $ DegreeCourse ffp sdMst sdInf
-  void . insert $ Lecturer jost   ffp
-  void . insert $ Lecturer gkleen ffp
+  void . insert $ Lecturer jost   ffp CourseLecturer
+  void . insert $ Lecturer gkleen ffp CourseAssistant
   adhoc <- insert $ Sheet ffp "AdHoc-Gruppen" Nothing NotGraded (Arbitrary 3) Nothing Nothing now now Nothing Nothing (Upload True) UserSubmissions False
   insert_ $ SheetEdit gkleen now adhoc
   feste <- insert $ Sheet ffp "Feste Gruppen" Nothing NotGraded RegisteredGroups Nothing Nothing now now Nothing Nothing (Upload True) UserSubmissions False
@@ -421,7 +421,7 @@ fillDb = do
     }
   insert_ $ CourseEdit fhamann now eip
   void . insert' $ DegreeCourse eip sdBsc sdInf
-  void . insert' $ Lecturer fhamann eip
+  void . insert' $ Lecturer fhamann eip CourseLecturer
   -- interaction design
   ixd <- insert' Course
     { courseName = "Interaction Design (User Experience Design I & II)"
@@ -439,7 +439,7 @@ fillDb = do
     }
   insert_ $ CourseEdit fhamann now ixd
   void . insert' $ DegreeCourse ixd sdBsc sdInf
-  void . insert' $ Lecturer fhamann ixd
+  void . insert' $ Lecturer fhamann ixd CourseAssistant
   -- concept development
   ux3 <- insert' Course
     { courseName = "Concept Development (User Experience Design III)"
@@ -457,7 +457,7 @@ fillDb = do
     }
   insert_ $ CourseEdit fhamann now ux3
   void . insert' $ DegreeCourse ux3 sdBsc sdInf
-  void . insert' $ Lecturer fhamann ux3
+  void . insert' $ Lecturer fhamann ux3 CourseAssistant
   -- promo
   pmo <- insert' Course
     { courseName = "Programmierung und Modellierung"
@@ -475,7 +475,7 @@ fillDb = do
     }
   insert_ $ CourseEdit jost now pmo
   void . insert $ DegreeCourse pmo sdBsc sdInf
-  void . insert $ Lecturer jost pmo
+  void . insert $ Lecturer jost pmo CourseAssistant
   void . insertMany $ map (\(u,sf) -> CourseParticipant pmo u now sf)
     [(fhamann   , Nothing)
     ,(maxMuster , Just sfMMp)
@@ -534,5 +534,5 @@ fillDb = do
   insert_ $ CourseEdit gkleen now dbs
   void . insert' $ DegreeCourse dbs sdBsc sdInf
   void . insert' $ DegreeCourse dbs sdBsc sdMath
-  void . insert' $ Lecturer gkleen dbs
-  void . insert' $ Lecturer jost   dbs
+  void . insert' $ Lecturer gkleen dbs CourseLecturer
+  void . insert' $ Lecturer jost   dbs CourseAssistant