chore: chase error messages

This commit is contained in:
Wolfgang Witt 2021-03-10 15:39:45 +01:00 committed by Gregor Kleen
parent 1c24b8e5e2
commit 03a0899f5f
2 changed files with 4 additions and 3 deletions

View File

@ -1505,7 +1505,8 @@ tagAccessPredicate AuthCapacity = APDB $ \_ _ _ route _ -> case route of
eid <- $cachedHereBinary (cid, examn) . MaybeT . getKeyBy $ UniqueExam cid examn
Entity occId ExamOccurrence{..} <- $cachedHereBinary (eid, occn) . MaybeT . getBy $ UniqueExamOccurrence eid occn
registered <- $cachedHereBinary occId . lift $ fromIntegral <$> count [ ExamRegistrationOccurrence ==. Just occId, ExamRegistrationExam ==. eid ]
guard $ examOccurrenceCapacity > registered
-- Nothing means unlimited size
guard $ maybe True (> registered) examOccurrenceCapacity
return Authorized
CTutorialR tid ssh csh tutn _ -> maybeT (unauthorizedI MsgTutorialNoCapacity) $ do
cid <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh

View File

@ -59,7 +59,7 @@ data ExamOccurrenceForm = ExamOccurrenceForm
, eofName :: ExamOccurrenceName
, eofRoom :: Maybe RoomReference
, eofRoomHidden :: Bool
, eofCapacity :: Word64
, eofCapacity :: Maybe Word64
, eofStart :: UTCTime
, eofEnd :: Maybe UTCTime
, eofDescription :: Maybe StoredMarkup
@ -232,7 +232,7 @@ examOccurrenceForm prev = wFormToAForm $ do
<*> apopt checkBoxField (fslI MsgExamRoomRoomHidden & setTooltip MsgExamRoomRoomHiddenTip & addName (nudge "room-hidden")) (eofRoomHidden <$> mPrev)
let eofRoomRes = view _1 <$> eofRoomRes'
eofRoomHiddenRes = view _2 <$> eofRoomRes'
(eofCapacityRes, eofCapacityView) <- mpreq (natFieldI MsgExamRoomCapacityNegative) (fslI MsgExamRoomCapacity & addName (nudge "capacity")) (eofCapacity <$> mPrev)
(eofCapacityRes, eofCapacityView) <- mopt (natFieldI MsgExamRoomCapacityNegative) (fslI MsgExamRoomCapacity & addName (nudge "capacity")) (eofCapacity <$> mPrev)
(eofStartRes, eofStartView) <- mpreq utcTimeField (fslI MsgExamRoomStart & addName (nudge "start")) (eofStart <$> mPrev)
(eofEndRes, eofEndView) <- mopt utcTimeField (fslI MsgExamRoomEnd & addName (nudge "end")) (eofEnd <$> mPrev)
(eofDescRes, eofDescView) <- mopt htmlField (fslI MsgExamRoomDescription & addName (nudge "description")) (eofDescription <$> mPrev)