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

fix(exams): allow occurrences after exam end

Browse Source
This commit is contained in:
Steffen Jost 2019-08-06 17:19:00 +02:00
parent 2eb062beb2
commit 3d63b355eb
2 changed files with 19 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -346,7 +346,7 @@ validateExam = do
forM_ efOccurrences $ \ExamOccurrenceForm{..} -> do forM_ efOccurrences $ \ExamOccurrenceForm{..} -> do
guardValidation (MsgExamOccurrenceEndMustBeAfterStart eofName) $ NTop eofEnd >= NTop (Just eofStart) guardValidation (MsgExamOccurrenceEndMustBeAfterStart eofName) $ NTop eofEnd >= NTop (Just eofStart)
guardValidation (MsgExamOccurrenceStartMustBeAfterExamStart eofName) $ NTop (Just eofStart) >= NTop efStart guardValidation (MsgExamOccurrenceStartMustBeAfterExamStart eofName) $ NTop (Just eofStart) >= NTop efStart
guardValidation (MsgExamOccurrenceEndMustBeBeforeExamEnd eofName) $ NTop eofEnd <= NTop efEnd warnValidation (MsgExamOccurrenceEndMustBeBeforeExamEnd eofName) $ NTop eofEnd <= NTop efEnd
forM_ [ (a, b) | a <- Set.toAscList efOccurrences, b <- Set.toAscList efOccurrences, b > a ] $ \(a, b) -> do forM_ [ (a, b) | a <- Set.toAscList efOccurrences, b <- Set.toAscList efOccurrences, b > a ] $ \(a, b) -> do
eofRange' <- formatTimeRange SelFormatDateTime (eofStart a) (eofEnd a) eofRange' <- formatTimeRange SelFormatDateTime (eofStart a) (eofEnd a)

13
src/Utils/Form.hs
View File

@ -4,7 +4,7 @@
module Utils.Form where module Utils.Form where
import ClassyPrelude.Yesod hiding (addMessage, cons, Proxy(..), identifyForm) import ClassyPrelude.Yesod hiding (addMessage, addMessageI, cons, Proxy(..), identifyForm)
import Yesod.Core.Instances () import Yesod.Core.Instances ()
import Settings import Settings
@ -936,7 +936,7 @@ guardValidation :: ( MonadHandler m
=> msg -- ^ Message describing violation => msg -- ^ Message describing violation
-> Bool -- ^ @False@ iff constraint is violated -> Bool -- ^ @False@ iff constraint is violated
-> FormValidator r m () -> FormValidator r m ()
guardValidation msg isValid = when (not isValid) $ tellValidationError msg guardValidation msg isValid = unless isValid $ tellValidationError msg
guardValidationM :: ( MonadHandler m guardValidationM :: ( MonadHandler m
, RenderMessage (HandlerSite m) msg , RenderMessage (HandlerSite m) msg
@ -944,6 +944,15 @@ guardValidationM :: ( MonadHandler m
=> msg -> m Bool -> FormValidator r m () => msg -> m Bool -> FormValidator r m ()
guardValidationM = (. lift) . (=<<) . guardValidation guardValidationM = (. lift) . (=<<) . guardValidation
warnValidation :: ( MonadHandler m
, RenderMessage (HandlerSite m) msg
)
=> msg -- ^ Message describing violation
-> Bool -- ^ @False@ iff constraint is violated
-> FormValidator r m ()
warnValidation msg isValid = unless isValid $ addMessageI Warning msg
----------------------- -----------------------
-- Form Manipulation -- -- Form Manipulation --
----------------------- -----------------------