From 99edd912dcfbbaac4d7a70c6fbf212e0bf8eb290 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Sun, 8 Oct 2017 17:04:43 +0200
Subject: [PATCH] Multi-Field Form Validation added.

---
 src/Handler/Term.hs       | 50 ++++++++++++++++++++++-----------------
 src/Handler/Utils/Term.hs | 26 ++++++++++++++++++++
 2 files changed, 54 insertions(+), 22 deletions(-)

diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs
index c4ec50ffd..1db1d6731 100644
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@@ -35,8 +35,13 @@ getShowTermsR = do
             <li>              
               <a href=@{EditTermExistR $ termName term}>
                 #{termToText $ termName term}               
-              von  #{formatTimeGerWD $ termStart term}
-              bis   #{formatTimeGerWD $ termEnd   term} 
+              #{formatTimeGerWD $ termStart term}
+              bis #{formatTimeGerWD $ termEnd   term}.
+              
+              <h4>
+                Vorlesungszeit:
+              #{formatTimeGerWD $ termLectureStart term}
+              bis #{formatTimeGerWD $ termLectureEnd   term}.
               $if termActive term 
                 (Semester ist aktiv)
               $with holidays <- termHolidays term
@@ -87,29 +92,15 @@ postEditTermR = do
           runDB $ repsert (TermKey $ termName res) res
           let tid = termToText $ termName res
           let msg = "Semester " `T.append` tid `T.append` " erfolgreich editiert."            
-          let okay  = termStart res `withinTerm` termName res
-          let order = termStart res <= termEnd res
-          setMessage [shamlet| #{msg} 
-                                $if not okay
-                                  <p .bg-warning>
-                                    Bezeichner des Semesters und Datum des Starts stimmen nicht überein!
-                                $if not order
-                                  <p .bg-danger>
-                                    Ende des Semesters liegt vor dem Start!
-                      |]
+          setMessage [shamlet| #{msg} |]
           redirect ShowTermsR   
         | otherwise -> redirect ShowTermsR
       (FormMissing,_) -> do
             setMessage "Keine Formulardaten erhalten."
             wdgtTermForm formWidget formEnctype
             
-      (FormFailure errorMsgs,_) -> do
-            setMessage [shamlet|
-                <p .bg-danger>Fehler:
-                  <ul>
-                    $forall errmsg <- errorMsgs
-                      <li> #{errmsg} 
-              |]
+      (FormFailure _,_) -> do
+            setMessage "Bitte Eingabe korrigieren."
             wdgtTermForm formWidget formEnctype
 
 wdgtTermForm :: (ToWidget UniWorX a) => a -> Enctype ->  Handler Html              
@@ -122,8 +113,8 @@ wdgtTermForm formWidget formEnctype = do
       $(widgetFile "generic_form")
           
 newTermForm :: Maybe Term -> Form Term
-newTermForm template = 
-    renderBootstrap3 bsHorizontalDefault $ Term
+newTermForm template html = do
+    (result, widget) <- flip (renderBootstrap3 bsHorizontalDefault) html $ Term
       <$> areq termNewField (bfs ("Semester" :: Text)) (termName  <$> template)
       <*> areq dayField  (bfs ("Erster Tag" :: Text)) (termStart <$> template)
       <*> areq dayField  (set "Letzer Tag") (termEnd   <$> template)
@@ -131,7 +122,22 @@ newTermForm template =
       <*> areq dayField  (bfs ("Beginn Vorlesungen" :: Text)) (termLectureStart <$> template)
       <*> areq dayField  (set "Ende Vorlesungen") (termLectureEnd   <$> template)
       <*> areq checkBoxField (set "Aktiv") (termActive <$> template)
---       <*  bootstrapSubmit (bsSubmit "Semester bearbeiten")      
+      -- <*  bootstrapSubmit (bsSubmit "Semester bearbeiten")      
+    return $ case result of  
+      FormSuccess termResult 
+        | errorMsgs <- validateTerm termResult
+        , not $ null errorMsgs ->
+          (FormFailure errorMsgs,
+                [whamlet|
+                  <div class="alert alert-danger">
+                    <h4> Fehler:
+                    <ul>
+                      $forall errmsg <- errorMsgs
+                        <li> #{errmsg} 
+                  ^{widget}
+                |]
+              )        
+      _ -> (result, widget)
   where set txt = FieldSettings
             { fsLabel = txt
             , fsTooltip = Nothing
diff --git a/src/Handler/Utils/Term.hs b/src/Handler/Utils/Term.hs
index d15a05489..5ce1b75d6 100644
--- a/src/Handler/Utils/Term.hs
+++ b/src/Handler/Utils/Term.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -35,3 +36,28 @@ termField mustexist = checkMMap checkTerm termToText textField
         return $ if mustexist && isNothing term 
           then Left $ errTextFreigabe ti
           else res 
+
+validateTerm :: Term -> [Text]        
+validateTerm (Term{..}) = 
+  [ msg  | (False, msg) <- 
+    [ --startOk
+      ( termStart `withinTerm` termName
+      , "Jahreszahl im Namenskürzel stimmt nicht mit Semesterbeginn überein."
+      )
+    , -- endOk 
+      ( termStart < termEnd    
+      , "Semester darf nicht enden, bevor es begann."
+      )  
+    , -- startOk
+      ( termLectureStart < termLectureEnd
+      , "Vorlesungszeit muss vor ihrem Ende anfgangen."
+      )
+    , -- lecStartOk
+      ( termStart <= termLectureStart
+      , "Semester muss vor der Vorlesungszeit beginnen."
+      )
+    , -- lecEndOk   
+      ( termEnd >= termLectureEnd
+      , "Vorlesungszeit muss vor dem Semester enden."
+      )
+  ] ]