From 6a5437ce725618d9f44fcdacaab3bea6430f6322 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Mon, 25 Mar 2019 13:13:37 +0100
Subject: [PATCH] Lecturer toles added

---
 models/courses        |  1 +
 src/Handler/Course.hs |  2 +-
 src/Model/Types.hs    | 14 ++++++++++++++
 test/Database.hs      | 16 ++++++++--------
 4 files changed, 24 insertions(+), 9 deletions(-)

diff --git a/models/courses b/models/courses
index 01b667499..4fcf67d65 100644
--- a/models/courses
+++ b/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
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 2cff27554..b309da93b 100644
--- a/src/Handler/Course.hs
+++ b/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 ->
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index 52fd5ed32..775900850 100644
--- a/src/Model/Types.hs
+++ b/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
diff --git a/test/Database.hs b/test/Database.hs
index c3b83c636..2c1992fa1 100755
--- a/test/Database.hs
+++ b/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