feat(exams): optionally close on finish

Fixes #652

messages/uniworx/de-de-formal.msg

@@ -1795,6 +1795,7 @@ ExamFinished: Ergebnisse sichtbar ab
 ExamFinishedOffice: Noten bekannt gegeben
 ExamFinishedParticipant: Bewertung voraussichtlich abgeschlossen
 ExamFinishedTip: Zeitpunkt zu dem Prüfungergebnisse den Teilnehmern gemeldet werden; ohne Datum werden die Prüfungsergebnisse zunächst nie gemeldet
+ExamFinishedTipCloseOnFinished: Zeitpunkt zu dem Prüfungergebnisse den Teilnehmern und den Prüfungsverwaltungen gemeldet werden; ohne Datum werden die Prüfungsergebnisse zunächst nie gemeldet
 ExamClosed: Noten gemeldet
 ExamClosedTip: Prüfungsbeauftraget, die im System Noten einsehen, werden zu diesem Zeitpunkt benachrichtigt und danach bei Änderungen informiert
 ExamGradingMode: Bewertungsmodus
@@ -2457,6 +2458,7 @@ BtnCloseExam: Prüfung abschließen
 ExamCloseTip: Wenn eine Prüfung abgeschlossen wird, werden Prüfungsbeauftragte, die im System Noten einsehen, benachrichtigt und danach bei Änderungen informiert.
 ExamCloseReminder: Bitte schließen Sie die Prüfung frühstmöglich, sobald die Prüfungsleistungen sich voraussichtlich nicht mehr ändern werden. Z.B. direkt nach der Klausureinsicht.
 ExamDidClose: Prüfung erfolgreich abgeschlossen
+ExamCloseTipOnFinished: Die Prüfung wird automatisch abgeschlossen, also Prüfungsbeauftragte, die im System Note einsehen, benachrichtigt und danach bei Änderungen informiert, sobald die Noten für die Prüfungsteilnehmer veröffentlicht werden.
 
 ExamClosedSince time@Text: Prüfung abgeschlossen seit #{time}
 
@@ -2928,3 +2930,8 @@ InvalidCredentialsADTooManyContextIds: Benutzereintrag trägt zu viele Sicherhei
 InvalidCredentialsADAccountExpired: Benutzereintrag abgelaufen
 InvalidCredentialsADPasswordMustChange: Passwort muss geändert werden
 InvalidCredentialsADAccountLockedOut: Benutzereintrag wurde durch Eindringlingserkennung gesperrt
+
+ExamCloseModeSeparate: Separat
+ExamCloseModeOnFinished: Mit Veröffentlichung
+ExamCloseModeOnFinishedHidden: Mit Veröffentlichung (versteckt)
+ExamCloseMode: Prüfungs-Abschluss

messages/uniworx/en-eu.msg

@@ -1794,6 +1794,7 @@ ExamFinished: Results visible from
 ExamFinishedOffice: Exam achievements published
 ExamFinishedParticipant: Marking expected to be finished
 ExamFinishedTip: At this participants are informed of their exam achievements. If left empty participants are never informed of their exam achievements.
+ExamFinishedTipCloseOnFinished: At this time participants and exam offices are informed of the exam achievements. If left empty participants and exam offices are never informed of the exam achievements.
 ExamClosed: Exam achievements registered
 ExamClosedTip: At this time exam offices, which pull exam achievements from Uni2work, are informed. Changes to exam achievements trigger further notifications
 ExamGradingMode: Grading mode
@@ -2457,6 +2458,7 @@ BtnCloseExam: Close exam
 ExamCloseTip: When an exam is closed all relevant exam offices, which pull exam achievements from Uni2work, are informed and kept up to date with changes.
 ExamCloseReminder: Please close the exam as soon as possible, when exam achievements are no longer expected to change e.g. after inspection of the exam has concluced.
 ExamDidClose: Successfully closed exam
+ExamCloseTipOnFinished: The exam will be closed automatically as soon as exam participants are informed of their exam achievements. That means exam offices will be able notified once and after that each time a grade changes.
 
 ExamClosedSince time: Exam closed since #{time}
 
@@ -2929,3 +2931,8 @@ InvalidCredentialsADTooManyContextIds: Account carries to many security identifi
 InvalidCredentialsADAccountExpired: Account expired
 InvalidCredentialsADPasswordMustChange: Password needs to be changed
 InvalidCredentialsADAccountLockedOut: Account disabled by intruder detection
+
+ExamCloseModeSeparate: Seperately
+ExamCloseModeOnFinished: With publication of achievements
+ExamCloseModeOnFinishedHidden: With publication of achievements (hidden)
+ExamCloseMode: Exam closure

models/schools.model

@@ -7,6 +7,7 @@ School json
     examMinimumRegisterDuration    NominalDiffTime Maybe
     examRequireModeForRegistration Bool default=false
     examDiscouragedModes ExamModeDNF
+    examCloseMode ExamCloseMode default='separate'
     UniqueSchool name
     UniqueSchoolShorthand shorthand -- required for Normalisation of CI Text
     Primary shorthand        -- newtype Key School = SchoolKey { unSchoolKey :: SchoolShorthand }

src/Database/Esqueleto/Utils.hs

@@ -20,7 +20,7 @@ module Database.Esqueleto.Utils
   , selectExists, selectNotExists
   , SqlHashable
   , sha256
-  , maybe, maybeEq, unsafeCoalesce
+  , maybe, maybe2, maybeEq, unsafeCoalesce
   , bool
   , max, min
   , abs
@@ -302,6 +302,20 @@ maybe onNothing onJust val = E.case_
   ]
   (E.else_ onNothing)
 
+maybe2 :: (PersistField a, PersistField b, PersistField c)
+       => E.SqlExpr (E.Value c)
+       -> (E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value b) -> E.SqlExpr (E.Value c))
+       -> E.SqlExpr (E.Value (Maybe a))
+       -> E.SqlExpr (E.Value (Maybe b))
+       -> E.SqlExpr (E.Value c)
+maybe2 onNothing onJust val1 val2 = E.case_
+  [ E.when_
+      (isJust val1 E.&&. isJust val2)
+    E.then_
+      (onJust (E.veryUnsafeCoerceSqlExprValue val1) (E.veryUnsafeCoerceSqlExprValue val2))
+  ]
+  (E.else_ onNothing)
+
 infix 4 `maybeEq`
 
 maybeEq :: PersistField a

src/Foundation/I18n.hs

@@ -322,6 +322,15 @@ instance RenderMessage UniWorX CourseParticipantState where
       mr :: RenderMessage UniWorX msg => msg -> Text
       mr = renderMessage foundation ls
 
+instance RenderMessage UniWorX ExamCloseMode where
+  renderMessage foundation ls = \case
+    ExamCloseSeparate         -> mr MsgExamCloseModeSeparate
+    ExamCloseOnFinished False -> mr MsgExamCloseModeOnFinished
+    ExamCloseOnFinished True  -> mr MsgExamCloseModeOnFinishedHidden
+    where
+      mr :: RenderMessage UniWorX msg => msg -> Text
+      mr = renderMessage foundation ls
+
 -- ToMessage instances for converting raw numbers to Text (no internationalization)
 
 instance ToMessage Int where

src/Handler/Exam/Edit.hs

@@ -20,10 +20,11 @@ getEEditR = postEEditR
 postEEditR tid ssh csh examn = do
   (template, (editExamAct, (editExamWidget, editExamEnctype))) <- runDBJobs $ do
     (cid, exam@(Entity eId oldExam)) <- fetchCourseIdExam tid ssh csh examn
+    course <- getEntity404 cid
 
     template <- examFormTemplate exam
 
-    ((editExamResult, editExamWidget), editExamEnctype) <- runFormPost . validateForm (validateExam cid $ Just exam) . examForm $ Just template
+    ((editExamResult, editExamWidget), editExamEnctype) <- runFormPost . validateForm (validateExam cid $ Just exam) . examForm course $ Just template
 
     editExamAct <- formResultMaybe editExamResult $ \ExamForm{..} -> do
       insertRes <- myReplaceUnique eId Exam

src/Handler/Exam/Form.hs

@@ -103,9 +103,10 @@ deriveJSON defaultOptions
 examForm :: ( MonadHandler m
             , HandlerSite m ~ UniWorX
             )
-         => Maybe ExamForm -> (Html -> MForm m (FormResult ExamForm, Widget))
+         => Entity Course -> Maybe ExamForm -> (Html -> MForm m (FormResult ExamForm, Widget))
-examForm template csrf = hoist liftHandler $ do
+examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do
   MsgRenderer mr <- getMsgRenderer
+  School{..} <- liftHandler . runDBRead $ getJust courseSchool
 
   flip (renderAForm FormStandard) csrf $ ExamForm
     <$> areq ciField (fslpI MsgExamName (mr MsgExamName) & setTooltip MsgExamNameTip) (efName <$> template)
@@ -118,7 +119,7 @@ examForm template csrf = hoist liftHandler $ do
     <*> aopt utcTimeField (fslpI MsgExamRegisterTo (mr MsgDate)) (efRegisterTo <$> template)
     <*> aopt utcTimeField (fslpI MsgExamDeregisterUntil (mr MsgDate)) (efDeregisterUntil <$> template)
     <*> aopt utcTimeField (fslpI MsgExamPublishOccurrenceAssignments (mr MsgDate) & setTooltip MsgExamPublishOccurrenceAssignmentsTip) (efPublishOccurrenceAssignments <$> template)
-    <*> aopt utcTimeField (fslpI MsgExamFinished (mr MsgDate) & setTooltip MsgExamFinishedTip) (efFinished <$> template)
+    <*> aopt utcTimeField (fslpI MsgExamFinished (mr MsgDate) & setTooltip (bool MsgExamFinishedTip MsgExamFinishedTipCloseOnFinished $ is _ExamCloseOnFinished' schoolExamCloseMode)) (efFinished <$> template)
     <*  aformSection MsgExamFormOccurrences
     <*> examOccurrenceForm (efOccurrences <$> template)
     <*  aformSection MsgExamFormAutomaticFunctions

src/Handler/Exam/New.hs

@@ -21,9 +21,10 @@ getCExamNewR = postCExamNewR
 postCExamNewR tid ssh csh = do
   (newExamAct, (newExamWidget, newExamEnctype)) <- runDBJobs $ do
     cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
+    course <- getEntity404 cid
     template <- examTemplate cid
 
-    ((newExamResult, newExamWidget), newExamEnctype) <- runFormPost . validateForm (validateExam cid Nothing) $ examForm template
+    ((newExamResult, newExamWidget), newExamEnctype) <- runFormPost . validateForm (validateExam cid Nothing) $ examForm course template
 
     newExamAct <- formResultMaybe newExamResult $ \ExamForm{..} -> do
       now <- liftIO getCurrentTime

src/Handler/Exam/Show.hs

@@ -94,7 +94,7 @@ getEShowR tid ssh csh examn = do
 
   let occurrenceNamesShown = lecturerInfoShown
       partNumbersShown = lecturerInfoShown
-      examClosedShown = lecturerInfoShown
+      examClosedShown = lecturerInfoShown && isn't _ExamCloseOnFinished' schoolExamCloseMode
       showCloseWidget = lecturerInfoShown
       showAutoOccurrenceCalculateWidget = lecturerInfoShown
       showRegisteredCount = lecturerInfoShown

src/Handler/ExamOffice/Exam.hs

@@ -39,30 +39,44 @@ instance Button UniWorX ButtonCloseExam where
 
 examCloseWidget :: SomeRoute UniWorX -> ExamId -> Handler Widget
 examCloseWidget dest eId = do
-  Exam{..} <- runDB $ get404 eId
+  (Exam{..}, School{..})  <- runDB $ do
+    exam@Exam{..} <- get404 eId
+    Course{..} <- get404 examCourse
+    school <- get404 courseSchool
+    return (exam, school)
 
-  ((closeRes, closeView), closeEnc) <- runFormPost $ identifyForm BtnCloseExam buttonForm
+  let closeTime = case (examClosed, examFinished) of
+        (mClose, Just finish)
+          | isn't _ExamCloseSeparate schoolExamCloseMode -> Just $ maybe id min mClose finish
+        (Just close, _)
+          | is _ExamCloseSeparate schoolExamCloseMode -> Just close
+        _other -> Nothing
 
-  formResult closeRes $ \case
+  examClosedStr <- for closeTime $ formatTime SelFormatDateTime
-    BtnCloseExam -> do
-      now <- liftIO getCurrentTime
 
-      unless (is _Nothing examClosed) $
+  if | is _ExamCloseOnFinished' schoolExamCloseMode
-        invalidArgs ["Exam is already closed"]
+       -> return $(widgetFile "widgets/exam-close-on-finished")
+     | otherwise -> do
+         ((closeRes, closeView'), closeEnc) <- runFormPost $ identifyForm BtnCloseExam buttonForm
 
-      runDB $ update eId [ ExamClosed =. Just now ]
+         formResult closeRes $ \case
-      addMessageI Success MsgExamDidClose
+           BtnCloseExam -> do
-      redirect dest
+             now <- liftIO getCurrentTime
 
-  let closeView' = wrapForm closeView def
+             unless (is _Nothing examClosed) $
-        { formSubmit   = FormNoSubmit
+               invalidArgs ["Exam is already closed"]
-        , formAction   = Just dest
-        , formEncoding = closeEnc
-        }
 
-  examClosed' <- for examClosed $ formatTime SelFormatDateTime
+             runDB $ update eId [ ExamClosed =. Just now ]
+             addMessageI Success MsgExamDidClose
+             redirect dest
 
-  return $(widgetFile "widgets/exam-close")
+         let closeView = wrapForm closeView' def
+               { formSubmit   = FormNoSubmit
+               , formAction   = Just dest
+               , formEncoding = closeEnc
+               }
+
+         return $(widgetFile "widgets/exam-close")
 
 
 type ExamUserTableExpr = (              E.SqlExpr (Entity ExamResult)

src/Handler/ExamOffice/Exams.hs

@@ -18,18 +18,22 @@ import qualified Colonnade
 
 type ExamsTableExpr = (               E.SqlExpr (Maybe (Entity Exam))
                         `E.InnerJoin` E.SqlExpr (Maybe (Entity Course))
+                        `E.InnerJoin` E.SqlExpr (Maybe (Entity School))
                       )
     `E.FullOuterJoin` E.SqlExpr (Maybe (Entity ExternalExam))
 
-type ExamsTableData = DBRow ( Either (Entity ExternalExam) (Entity Exam, Entity Course)
+type ExamsTableData = DBRow ( Either (Entity ExternalExam) (Entity Exam, Entity Course, Entity School)
                             , Natural, Natural
                             )
 
 queryExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity Exam)))
-queryExam = to $ $(E.sqlIJproj 2 1) . $(E.sqlFOJproj 2 1)
+queryExam = to $ $(E.sqlIJproj 3 1) . $(E.sqlFOJproj 2 1)
 
 queryCourse :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity Course)))
-queryCourse = to $ $(E.sqlIJproj 2 2) . $(E.sqlFOJproj 2 1)
+queryCourse = to $ $(E.sqlIJproj 3 2) . $(E.sqlFOJproj 2 1)
+  
+querySchool :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity School)))
+querySchool = to $ $(E.sqlIJproj 3 3) . $(E.sqlFOJproj 2 1)
 
 queryExternalExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExternalExam)))
 queryExternalExam = to $(E.sqlFOJproj 2 2)
@@ -66,6 +70,7 @@ queryIsSynced :: UTCTime -> E.SqlExpr (E.Value UserId) -> Getter ExamsTableExpr
 queryIsSynced now office = to . runReader $ do
   exam' <- view queryExam
   externalExam' <- view queryExternalExam
+  school' <- view querySchool
   let
     examSynchronised examId = E.not_ . E.exists . E.from $ \examResult -> do
       E.where_ $ examResult E.^. ExamResultExam E.==. examId
@@ -75,8 +80,11 @@ queryIsSynced now office = to . runReader $ do
       E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. externalExamId
       E.where_ $ ExternalExam.examOfficeExternalExamResultAuth office externalExamResult
       E.where_ . E.not_ $ ExternalExam.resultIsSynced office externalExamResult
-    open examClosed' = E.maybe E.true (E.>. E.val now) examClosed'
+    open examClosed' examFinished'
-  return $ E.maybe E.false examSynchronised (exam' E.?. ExamId) E.||. E.maybe E.false open (exam' E.?. ExamClosed) E.||. E.maybe E.false externalExamSynchronised (externalExam' E.?. ExternalExamId)
+      = E.bool (E.maybe E.true (E.>. E.val now) $ E.min examClosed' examFinished')
+               (E.maybe E.true (E.>. E.val now) examClosed')
+               (E.maybe E.false (E.==. E.val ExamCloseSeparate) (school' E.?. SchoolExamCloseMode))
+  return $ E.maybe E.false examSynchronised (exam' E.?. ExamId) E.||. E.maybe2 E.false open (exam' E.?. ExamClosed) (exam' E.?. ExamFinished) E.||. E.maybe E.false externalExamSynchronised (externalExam' E.?. ExternalExamId)
 
 
 resultExam :: Traversal' ExamsTableData (Entity Exam)
@@ -85,6 +93,9 @@ resultExam = _dbrOutput . _1 . _Right . _1
 resultCourse :: Traversal' ExamsTableData (Entity Course)
 resultCourse = _dbrOutput . _1 . _Right . _2
 
+resultSchool :: Traversal' ExamsTableData (Entity School)
+resultSchool = _dbrOutput . _1 . _Right . _3
+
 resultExternalExam :: Traversal' ExamsTableData (Entity ExternalExam)
 resultExternalExam = _dbrOutput . _1 . _Left
 
@@ -126,6 +137,7 @@ getEOExamsR = do
           dbtSQLQuery = runReaderT $ do
             exam <- view queryExam
             course <- view queryCourse
+            school <- view querySchool
             externalExam <- view queryExternalExam
 
             synchronised <- view querySynchronised'
@@ -133,35 +145,41 @@ getEOExamsR = do
 
             lift $ do
               E.on   E.false
+              E.on $ school E.?. SchoolId E.==. course E.?. CourseSchool
               E.on $ exam E.?. ExamCourse E.==. course E.?. CourseId
 
               E.where_ $ results E.>. E.val 0
               E.where_ $ (E.not_ (E.isNothing $ exam E.?. ExamId) E.&&. E.not_ (E.isNothing $ course E.?. CourseId) E.&&.         E.isNothing  (externalExam E.?. ExternalExamId))
                    E.||. (        E.isNothing  (exam E.?. ExamId) E.&&.         E.isNothing  (course E.?. CourseId) E.&&. E.not_ (E.isNothing $ externalExam E.?. ExternalExamId))
 
-            return (exam, course, externalExam, synchronised, results)
+            return (exam, course, school, externalExam, synchronised, results)
           dbtRowKey = views ($(multifocusG 2) queryExam queryExternalExam) (bimap (E.?. ExamId) (E.?. ExternalExamId))
 
           dbtProj :: DBRow _ -> DB ExamsTableData
           dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $ do
             exam <- view _1
             course <- view _2
-            externalExam <- view _3
+            school <- view _3
+            externalExam <- view _4
 
-            case (exam, course, externalExam) of
+            case (exam, course, school, externalExam) of
-              (Just exam', Just course', Nothing) ->
+              (Just exam', Just course', Just school', Nothing) ->
-                (Right (exam', course'),,) <$> view (_4 . _Value) <*> view (_5 . _Value)
+                (Right (exam', course', school'),,) <$> view (_5 . _Value) <*> view (_6 . _Value)
-              (Nothing, Nothing, Just externalExam') ->
+              (Nothing, Nothing, Nothing, Just externalExam') ->
-                (Left externalExam',,) <$> view (_4 . _Value) <*> view (_5 . _Value)
+                (Left externalExam',,) <$> view (_5 . _Value) <*> view (_6 . _Value)
               _other -> return $ error "Got exam & externalExam in same result"
 
 
           colSynced = Colonnade.singleton (fromSortable . Sortable (Just "synced") $ i18nCell MsgExamSynchronised) $ \x -> flip runReader x $ do
             mExam <- preview resultExam
+            mSchool <- preview resultSchool
 
             if
-              | Just (Entity _ Exam{examClosed}) <- mExam
+              | Just (Entity _ Exam{examClosed, examFinished}) <- mExam
-              , NTop examClosed > NTop (Just now)
+              , Just (Entity _ School{schoolExamCloseMode}) <- mSchool
+              , bool ((min `on` NTop) examClosed examFinished > NTop (Just now))
+                     (NTop examClosed > NTop (Just now))
+                   $ is _ExamCloseSeparate schoolExamCloseMode
                 -> return . cell $ toWidget iconNew
               | otherwise
                 -> do

src/Handler/School.hs

@@ -66,6 +66,7 @@ data SchoolForm = SchoolForm
   , sfExamMinimumRegisterDuration :: Maybe NominalDiffTime
   , sfExamRequireModeForRegistration :: Bool
   , sfExamDiscouragedModes :: ExamModeDNF
+  , sfExamCloseMode :: ExamCloseMode
   }
 
 mkSchoolForm :: Maybe SchoolId -> Maybe SchoolForm -> Form SchoolForm
@@ -77,6 +78,7 @@ mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm
   <*> aopt daysField (fslI MsgSchoolExamMinimumRegisterDuration & setTooltip MsgSchoolExamMinimumRegisterDurationTip) (sfExamMinimumRegisterDuration <$> template)
   <*> apopt checkBoxField (fslI MsgSchoolExamRequireModeForRegistration & setTooltip MsgSchoolExamRequireModeForRegistration) (sfExamRequireModeForRegistration <$> template)
   <*> areq pathPieceField (fslI MsgSchoolExamDiscouragedModes) (sfExamDiscouragedModes <$> template <|> pure (ExamModeDNF predDNFFalse))
+  <*> apopt (selectField optionsFinite) (fslI MsgExamCloseMode) (sfExamCloseMode <$> template <|> pure ExamCloseSeparate)
   where
     ldapOrgs :: HandlerFor UniWorX (OptionList (CI Text))
     ldapOrgs = fmap (mkOptionList . map (\t -> Option (CI.original t) t (CI.original t)) . Set.toAscList) . runDB $
@@ -94,6 +96,7 @@ schoolToForm ssh = do
     , sfExamMinimumRegisterDuration = schoolExamMinimumRegisterDuration
     , sfExamRequireModeForRegistration = schoolExamRequireModeForRegistration
     , sfExamDiscouragedModes = schoolExamDiscouragedModes
+    , sfExamCloseMode = schoolExamCloseMode
     }
 
 
@@ -112,6 +115,7 @@ postSchoolEditR ssh = do
         , SchoolExamMinimumRegisterDuration =. sfExamMinimumRegisterDuration
         , SchoolExamRequireModeForRegistration =. sfExamRequireModeForRegistration
         , SchoolExamDiscouragedModes =. sfExamDiscouragedModes
+        , SchoolExamCloseMode =. sfExamCloseMode
         ]
       forM_ sfOrgUnits $ \schoolLdapOrgUnit ->
         void $ upsert SchoolLdap
@@ -153,6 +157,7 @@ postSchoolNewR = do
         , schoolExamMinimumRegisterDuration = sfExamMinimumRegisterDuration
         , schoolExamRequireModeForRegistration = sfExamRequireModeForRegistration
         , schoolExamDiscouragedModes = sfExamDiscouragedModes
+        , schoolExamCloseMode = sfExamCloseMode
         }
       when didInsert $ do
         insert_ UserFunction

src/Jobs/Crontab.hs

@@ -306,7 +306,11 @@ determineCrontab = execWriterT $ do
 
 
   let
-    examJobs (Entity nExam Exam{..}) = do
+    examSelect = E.selectSource . E.from $ \(exam `E.InnerJoin` course `E.InnerJoin` school) -> do
+      E.on $ school E.^. SchoolId E.==. course E.^. CourseSchool
+      E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
+      return (exam, course, school)
+    examJobs (Entity nExam Exam{..}, _, Entity _ School{..}) = do
       newestResult <- lift . E.select . E.from $ \examResult -> do
         E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
         return . E.max_ $ examResult E.^. ExamResultLastChanged
@@ -352,7 +356,14 @@ determineCrontab = execWriterT $ do
               , cronNotAfter  = Right . CronTimestamp $ utcToLocalTimeTZ appTZ deregisterUntil
               }
 
-      case examClosed of
+      let closeTime = case (examClosed, examFinished) of
+            (mClose, Just finish)
+              | isn't _ExamCloseSeparate schoolExamCloseMode -> Just $ maybe id min mClose finish
+            (Just close, _)
+              | is _ExamCloseSeparate schoolExamCloseMode -> Just close
+            _other -> Nothing
+
+      case closeTime of
         Just close -> do
           changedResults <- lift . E.select . E.from $ \examResult -> do
             E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
@@ -381,8 +392,7 @@ determineCrontab = execWriterT $ do
               , cronNotAfter = Left appNotificationExpiration
               }
         Nothing -> return ()
-
+   in runConduit $ transPipe lift examSelect .| C.mapM_ examJobs
-  runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ examJobs
 
 
   let

src/Model/Types/Exam.hs

@@ -38,6 +38,7 @@ module Model.Types.Exam
   , ExamRequiredEquipment(..), ExamRequiredEquipmentPreset(..)
   , ExamMode(..)
   , ExamModePredicate(..), ExamModeDNF(..)
+  , ExamCloseMode(..), _ExamCloseSeparate, _ExamCloseOnFinished, _ExamCloseOnFinished', _ExamCloseOnFinishedHidden, _examCloseOnFinishedHidden
   ) where
 
 import Import.NoModel
@@ -558,3 +559,23 @@ newtype ExamModeDNF = ExamModeDNF { examModeDNF :: PredDNF ExamModePredicate }
   deriving newtype (Semigroup, Monoid, ToJSON, FromJSON, PathPiece)
 
 derivePersistFieldJSON ''ExamModeDNF
+
+
+data ExamCloseMode
+  = ExamCloseSeparate
+  | ExamCloseOnFinished { examCloseOnFinishedHidden :: Bool }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving anyclass (Binary)
+deriveFinite ''ExamCloseMode
+finitePathPiece ''ExamCloseMode ["separate", "on-finished", "on-finished-hidden"]
+derivePersistFieldPathPiece ''ExamCloseMode
+pathPieceJSON ''ExamCloseMode
+pathPieceJSONKey ''ExamCloseMode
+pathPieceHttpApiData ''ExamCloseMode
+
+makeLenses_ ''ExamCloseMode
+makePrisms ''ExamCloseMode
+
+_ExamCloseOnFinished', _ExamCloseOnFinishedHidden :: Prism' ExamCloseMode ()
+_ExamCloseOnFinished' = _ExamCloseOnFinished . only False
+_ExamCloseOnFinishedHidden = _ExamCloseOnFinished . only True

templates/widgets/exam-close-on-finished.hamlet

@@ -0,0 +1,6 @@
+$newline never
+<p .explanation>
+  _{MsgExamCloseTipOnFinished}
+$maybe closed <- examClosedStr
+  <p>
+    _{MsgExamClosedSince closed}

templates/widgets/exam-close.hamlet

@@ -1,9 +1,10 @@
 $newline never
-$maybe closed <- examClosed'
+$maybe closed <- examClosedStr
-  _{MsgExamClosedSince closed}
+  <p>
+    _{MsgExamClosedSince closed}
 $nothing
-  <p>
+  <p .explanation>
     _{MsgExamCloseTip}
-  <p>
+  <p .explanation>
     _{MsgExamCloseReminder}
-  ^{closeView'}
+  ^{closeView}

test/Database/Fill.hs

@@ -368,8 +368,8 @@ fillDb = do
                   , termLectureEnd
                   , termActive   = term >= currentTerm
                   }
-  ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse)
+  ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True)
-  mi  <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse)
+  mi  <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False)
   void . insert' $ UserFunction gkleen ifi SchoolAdmin
   void . insert' $ UserFunction gkleen mi SchoolAdmin
   void . insert' $ UserFunction fhamann ifi SchoolAdmin
@@ -382,6 +382,8 @@ fillDb = do
   void . insert' $ UserFunction jost ifi SchoolLecturer
   void . insert' $ UserFunction svaupel ifi SchoolLecturer
   void . insert' $ UserFunction gkleen ifi SchoolAllocation
+  void . insert' $ UserFunction gkleen ifi SchoolExamOffice
+  void . insert' $ UserFunction gkleen mi SchoolExamOffice
   for_ [gkleen, fhamann, jost, maxMuster, svaupel] $ \uid ->
     void . insert' $ UserSchool uid ifi False
   for_ [gkleen, tinaTester] $ \uid ->