From 09196971f8093a0c8b1b6f5ecb94f44090932ae2 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 15 May 2019 15:12:00 +0200
Subject: [PATCH] Rough sketch of models/exams

---
 models/exams           | 60 +++++++++++++++++++++++++++---------------
 src/Model/Migration.hs |  4 +++
 src/Model/Types.hs     | 39 ++++++++++++++++++++++++---
 3 files changed, 79 insertions(+), 24 deletions(-)

diff --git a/models/exams b/models/exams
index f9d326011..af2ac807f 100644
--- a/models/exams
+++ b/models/exams
@@ -1,22 +1,40 @@
--- EXAMS ARE TODO; THIS IS JUST AN UNUSED STUB
 Exam
-    course              CourseId
-    name                Text
-    description         Text
-    begin               UTCTime
-    end                 UTCTime
-    registrationBegin   UTCTime
-    registrationEnd     UTCTime
-    deregistrationEnd   UTCTime
-    ratingVisible       Bool     -- may participants see their own rating yet
-    statisticsVisible   Bool     -- may participants view statistics over all participants (should not be allowed for 'small' courses)
---ExamEdit
---    user                UserId
---    time                UTCTime
---    exam                ExamId
---ExamUser
---    user                UserId
---    examId              ExamId
---    -- CONTINUE HERE: Include rating in this table or separately?
---    UniqueExamUser user   examId
--- By default this file is used in Model.hs (which is imported by Foundation.hs)
\ No newline at end of file
+  course CourseId
+  name (CI Text)
+  gradingKey [Points] -- [n1,n2,n3,...] means 0 <= p < n1 -> p ~= 5, n1 <= p < n2 -> p ~ 4.7, n2 <= p < n3 -> p ~ 4.3, ...
+  bonusRule ExamBonusRule
+  occuranceRule ExamOccuranceRule
+  registerFrom UTCTime Maybe
+  registerTo UTCTime Maybe
+  deregisterUntil UTCTime Maybe
+  start UTCTime
+  end UTCTime Maybe
+  finished UTCTime Maybe -- Grades shown to students, `ExamCorrector`s locked out
+  closed Bool -- Prüfungsamt hat Einsicht (notification)
+  publicStatistics Bool
+  description Html Maybe
+  UniqueExam course name
+ExamPart
+  exam ExamId
+  name (CI Text)
+  maxPoints Points Maybe
+  weight Rational
+  UniqueExamPart exam name
+ExamOccurance
+  exam ExamId
+  room Text
+  capacity Natural
+ExamRegistration
+  exam ExamId
+  user UserId
+  occurance ExamOccuranceId Maybe
+  UniqueExamRegistration exam user
+ExamResult
+  examPart ExamPartId
+  user UserId
+  result ExamPartResult
+  UniqueExamResult examPart user
+ExamCorrector
+  examPart ExamPartId
+  user UserId
+  UniqueExamCorrector examPart user
\ No newline at end of file
diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs
index f55638835..6a5e36ebb 100644
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@@ -288,6 +288,10 @@ customMigrations = Map.fromListWith (>>)
         tableDropEmpty "tutorial"
         tableDropEmpty "tutorial_user"
     )
+  , ( AppliedMigrationKey [migrationVersion|12.0.0|] [version|13.0.0|]
+    , whenM (tableExists "exam") $ -- Exams were an unused stub before
+        tableDropEmpty "exam"
+    )
   ]
 
 
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index aa1c91037..d55783fcb 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -366,9 +366,42 @@ classifySubmissionMode (SubmissionMode False (Just _)) = SubmissionModeUser
 classifySubmissionMode (SubmissionMode True  (Just _)) = SubmissionModeBoth
 
 
-data ExamStatus = Attended | NoShow | Voided
-  deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)
-derivePersistField "ExamStatus"
+data ExamPartResult = ExamAttended { examPartResult :: Maybe Points }
+                    | ExamNoShow
+                    | ExamVoided
+  deriving (Show, Read, Eq, Ord, Generic, Typeable)
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 1
+  , fieldLabelModifier = camelToPathPiece' 2
+  , omitNothingFields = True
+  , sumEncoding = TaggedObject "status" "result"
+  } ''ExamPartResult
+derivePersistFieldJSON ''ExamPartResult
+
+data ExamBonusRule = ExamNoBonus
+                   | ExamBonusPoints
+                     { bonusExchangeRate :: Rational
+                     , bonusOnlyPassed :: Bool
+                     }
+  deriving (Show, Read, Eq, Ord, Generic, Typeable)
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 1
+  , fieldLabelModifier = camelToPathPiece' 1
+  , sumEncoding = TaggedObject "rule" "settings"
+  } ''ExamBonusRule
+derivePersistFieldJSON ''ExamBonusRule
+
+data ExamOccuranceRule = ExamRoomManual
+                       | ExamRoomSurname
+                       | ExamRoomMatriculation
+                       | ExamRoomRandom
+  deriving (Show, Read, Eq, Ord, Generic, Typeable)
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 2
+  , fieldLabelModifier = camelToPathPiece' 1
+  , sumEncoding = TaggedObject "rule" "settings"
+  } ''ExamOccuranceRule
+derivePersistFieldJSON ''ExamOccuranceRule
 
 -- | Specify a corrector's workload
 data Load -- = ByTutorial { countsToLoad :: Bool } | ByProportion { load :: Rational }