diff --git a/src/Common.hs b/src/Common.hs new file mode 100644 index 000000000..9c49ec0a4 --- /dev/null +++ b/src/Common.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Common where +-- Common Utility Functions + +import Language.Haskell.TH + + +------------ +-- Tuples -- +------------ + +fst3 :: (a,b,c) -> a +fst3 (x,_,_) = x +snd3 :: (a,b,c) -> b +snd3 (_,y,_) = y +trd3 :: (a,b,c) -> c +trd3 (_,_,z) = z + +projNI :: Int -> Int -> ExpQ -- generic projection gives I-th element of N-tuple, i.e. snd3 = $(projNI 3 2) --ghci -fth +-- $(projN n m) :: (t1,..,tn) -> tm (for m<=n) +projNI n i = lamE [pat] rhs + where pat = tupP (map varP xs) + rhs = varE (xs !! (i - 1)) + xs = [ mkName $ "x" ++ show j | j <- [1..n] ] diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 6a90a527e..cb8e0c5d4 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -10,11 +10,10 @@ import Import import Handler.Utils import qualified Data.Text as T -- import Data.Maybe -import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3) +import Yesod.Form.Bootstrap3 -- import Text.Julius (RawJS (..)) - getShowTermsR :: Handler Html getShowTermsR = do terms <- runDB $ selectList [] [Desc TermStart] @@ -66,9 +65,11 @@ getEditTermMaybeR :: Maybe Term -> Handler Html getEditTermMaybeR mbTerm= do aid <- requireAuthId (formWidget, formEnctype) <- generateFormPost $ newTermForm mbTerm + let formtitle = "Semester editieren/anlegen" :: Text + let actionurl = EditTermR defaultLayout $ do - setTitle "Semester editieren/anlegen" - $(widgetFile "editTerm") + setTitle [shamlet| #{formtitle} |] + $(widgetFile "generic_form") postEditTermR :: Handler Html @@ -80,29 +81,48 @@ postEditTermR = do -- term <- runDB $ get $ TermKey termName runDB $ repsert (TermKey $ termName res) res let tid = termToText $ termName res - let msg = "Semester " `T.append` tid `T.append` " wurde editiert!" - setMessage [shamlet| #{msg}|] + 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 +

+ Bezeichner des Semesters und Datum des Starts stimmen nicht überein! + $if not order +

+ Ende des Semesters liegt vor dem Start! + |] redirect ShowTermsR - FormMissing -> defaultLayout $ do + FormMissing -> do setMessage "Keine Formulardaten erhalten." - $(widgetFile "editTerm") - FormFailure errorMsgs -> defaultLayout $ do - setMessage [shamlet| Fehler: -