fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(exams): optionally close on finish

Browse Source 
Fixes #652
This commit is contained in:
Gregor Kleen 2020-11-17 12:43:24 +01:00
parent b229a375a4
commit 4b525ea824
17 changed files with 168 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
messages/uniworx/de-de-formal.msg
View File

@ -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}
@ -2927,4 +2929,9 @@ InvalidCredentialsADAccountDisabled: Benutzereintrag gesperrt
InvalidCredentialsADTooManyContextIds: Benutzereintrag trägt zu viele Sicherheitskennzeichen
InvalidCredentialsADAccountExpired: Benutzereintrag abgelaufen
InvalidCredentialsADPasswordMustChange: Passwort muss geändert werden
InvalidCredentialsADAccountLockedOut: Benutzereintrag wurde durch Eindringlingserkennung gesperrt
InvalidCredentialsADAccountLockedOut: Benutzereintrag wurde durch Eindringlingserkennung gesperrt
ExamCloseModeSeparate: Separat
ExamCloseModeOnFinished: Mit Veröffentlichung
ExamCloseModeOnFinishedHidden: Mit Veröffentlichung (versteckt)
ExamCloseMode: Prüfungs-Abschluss

7
messages/uniworx/en-eu.msg
View File

@ -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

1
models/schools.model
View File

@ -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 }

16
src/Database/Esqueleto/Utils.hs
View File

@ -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

9
src/Foundation/I18n.hs
View File

@ -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

3
src/Handler/Exam/Edit.hs
View File

@ -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

7
src/Handler/Exam/Form.hs
View File

@ -103,9 +103,10 @@ deriveJSON defaultOptions
examForm :: ( MonadHandler m
, HandlerSite m ~ UniWorX
)
=> Maybe ExamForm -> (Html -> MForm m (FormResult ExamForm, Widget))
examForm template csrf = hoist liftHandler $ do
=> Entity Course -> Maybe ExamForm -> (Html -> MForm m (FormResult ExamForm, Widget))
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

3
src/Handler/Exam/New.hs
View File

@ -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

2
src/Handler/Exam/Show.hs
View File

@ -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

48
src/Handler/ExamOffice/Exam.hs
View File

@ -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
BtnCloseExam -> do
now <- liftIO getCurrentTime
examClosedStr <- for closeTime $ formatTime SelFormatDateTime
unless (is _Nothing examClosed) $
invalidArgs ["Exam is already closed"]
if | is _ExamCloseOnFinished' schoolExamCloseMode
-> return $(widgetFile "widgets/exam-close-on-finished")
| otherwise -> do
((closeRes, closeView'), closeEnc) <- runFormPost $ identifyForm BtnCloseExam buttonForm
runDB $ update eId [ ExamClosed =. Just now ]
addMessageI Success MsgExamDidClose
redirect dest
formResult closeRes $ \case
BtnCloseExam -> do
now <- liftIO getCurrentTime
let closeView' = wrapForm closeView def
{ formSubmit = FormNoSubmit
, formAction = Just dest
, formEncoding = closeEnc
}
unless (is _Nothing examClosed) $
invalidArgs ["Exam is already closed"]
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)

46
src/Handler/ExamOffice/Exams.hs
View File

@ -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'
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)
open examClosed' examFinished'
= 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
(Just exam', Just course', Nothing) ->
(Right (exam', course'),,) <$> view (_4 . _Value) <*> view (_5 . _Value)
(Nothing, Nothing, Just externalExam') ->
(Left externalExam',,) <$> view (_4 . _Value) <*> view (_5 . _Value)
case (exam, course, school, externalExam) of
(Just exam', Just course', Just school', Nothing) ->
(Right (exam', course', school'),,) <$> view (_5 . _Value) <*> view (_6 . _Value)
(Nothing, Nothing, Nothing, Just externalExam') ->
(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
, NTop examClosed > NTop (Just now)
| Just (Entity _ Exam{examClosed, examFinished}) <- mExam
, 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

5
src/Handler/School.hs
View File

@ -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

18
src/Jobs/Crontab.hs
View File

@ -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 ()
runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ examJobs
in runConduit $ transPipe lift examSelect .| C.mapM_ examJobs
let

21
src/Model/Types/Exam.hs
View File

@ -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

6
templates/widgets/exam-close-on-finished.hamlet Normal file
View File

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

11
templates/widgets/exam-close.hamlet
View File

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

6
test/Database/Fill.hs
View File

@ -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)
mi <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (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) (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 ->