From 3d63b355eb15daf858b554afe41932b117b00dd7 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Tue, 6 Aug 2019 17:19:00 +0200
Subject: [PATCH] fix(exams): allow occurrences after exam end

---
 src/Handler/Exam/Form.hs | 12 ++++++------
 src/Utils/Form.hs        | 17 +++++++++++++----
 2 files changed, 19 insertions(+), 10 deletions(-)

diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs
index 905adc4fe..5948bf744 100644
--- a/src/Handler/Exam/Form.hs
+++ b/src/Handler/Exam/Form.hs
@@ -11,18 +11,18 @@ import Import
 import Utils.Lens hiding (parts)
 
 import Handler.Exam.CorrectorInvite
-  
+
 import Handler.Utils
 import Handler.Utils.Invitations
-  
+
 import Data.Map ((!))
 import qualified Data.Set as Set
-  
+
 import qualified Database.Esqueleto as E
-  
+
 import qualified Control.Monad.State.Class as State
 import Text.Blaze.Html.Renderer.String (renderHtml)
-  
+
 
 data ExamForm = ExamForm
   { efName :: ExamName
@@ -346,7 +346,7 @@ validateExam = do
   forM_ efOccurrences $ \ExamOccurrenceForm{..} -> do
     guardValidation (MsgExamOccurrenceEndMustBeAfterStart eofName) $ NTop eofEnd >= NTop (Just eofStart)
     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
     eofRange' <- formatTimeRange SelFormatDateTime (eofStart a) (eofEnd a)
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index b98c9fd2c..b789bccba 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -4,7 +4,7 @@
 
 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 Settings
 
@@ -632,7 +632,7 @@ selectField' :: ( Eq a
 selectField' optMsg mkOpts = Field{..}
   where
     fieldEnctype = UrlEncoded
-    
+
     fieldParse []    _ = return $ Right Nothing
     fieldParse (s:_) _
       | s == ""     = return $ Right Nothing
@@ -646,7 +646,7 @@ selectField' optMsg mkOpts = Field{..}
         rendered = case val of
           Left  _ -> ""
           Right a -> maybe "" optionExternalValue . listToMaybe $ filter ((== a) . optionInternalValue) olOptions
-        
+
         isSel Nothing    = not $ rendered `elem` map optionExternalValue olOptions
         isSel (Just opt) = rendered == optionExternalValue opt
       [whamlet|
@@ -936,7 +936,7 @@ guardValidation :: ( MonadHandler m
                 => msg -- ^ Message describing violation
                 -> Bool -- ^ @False@ iff constraint is violated
                 -> FormValidator r m ()
-guardValidation msg isValid = when (not isValid) $ tellValidationError msg
+guardValidation msg isValid = unless isValid $ tellValidationError msg
 
 guardValidationM :: ( MonadHandler m
                     , RenderMessage (HandlerSite m) msg
@@ -944,6 +944,15 @@ guardValidationM :: ( MonadHandler m
                  => msg -> m Bool -> FormValidator r m ()
 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 --
 -----------------------