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:
-
- $forall errmsg <- errorMsgs
- - #{errmsg}
- |]
- $(widgetFile "editTerm")
-
+ let formtitle = "Semester editieren/anlegen" :: Text
+ let actionurl = EditTermR
+ defaultLayout $ do
+ setTitle [shamlet| #{formtitle} |]
+ $(widgetFile "generic_form")
+
+ FormFailure errorMsgs -> do
+ setMessage [shamlet|
+
Fehler:
+
+ $forall errmsg <- errorMsgs
+ - #{errmsg}
+ |]
+ let formtitle = "Semester editieren/anlegen" :: Text
+ let actionurl = EditTermR
+ defaultLayout $ do
+ setTitle [shamlet| #{formtitle} |]
+ $(widgetFile "generic_form")
newTermForm :: Maybe Term -> Form Term
newTermForm template =
- renderBootstrap3 BootstrapBasicForm $ Term
- <$> areq termNewField (set "Semester") (termName <$> template)
- <*> areq dayField (set "Erster Tag") (termStart <$> template)
+ renderBootstrap3 bsHorizontalDefault $ Term
+ <$> areq termNewField (bfs ("Semester" :: Text)) (termName <$> template)
+ <*> areq dayField (bfs ("Erster Tag" :: Text)) (termStart <$> template)
<*> areq dayField (set "Letzer Tag") (termEnd <$> template)
<*> pure [] -- TODO: List of Day field required, must probably be done as its own form and then combined
<*> areq checkBoxField (set "Aktiv") (termActive <$> template)
+ <* bootstrapSubmit (bsSubmit "Semester bearbeiten")
where set txt = FieldSettings
{ fsLabel = txt
, fsTooltip = Nothing
diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs
index d8f6ce9fa..dbb5c9430 100644
--- a/src/Handler/Utils.hs
+++ b/src/Handler/Utils.hs
@@ -1,6 +1,10 @@
+{-# LANGUAGE TemplateHaskell #-}
+
module Handler.Utils
( module Handler.Utils
) where
import Handler.Utils.DateTime as Handler.Utils
import Handler.Utils.Term as Handler.Utils
+import Handler.Utils.Bootstrap3 as Handler.Utils
+
diff --git a/src/Handler/Utils/Bootstrap3.hs b/src/Handler/Utils/Bootstrap3.hs
new file mode 100644
index 000000000..cbc970061
--- /dev/null
+++ b/src/Handler/Utils/Bootstrap3.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Handler.Utils.Bootstrap3 where
+
+import Import
+import Data.String (IsString(..))
+-- import Yesod.Core
+-- import qualified Data.Text as T
+-- import Yesod.Form.Types
+-- import Yesod.Form.Functions
+import Yesod.Form.Bootstrap3
+
+bsSubmit :: String -> BootstrapSubmit Text
+bsSubmit msg =
+ BootstrapSubmit (fromString msg) " btn-default btn-primary " []
+
+bsHorizontalDefault :: BootstrapFormLayout
+bsHorizontalDefault =
+ BootstrapHorizontalForm
+ { bflLabelOffset = ColSm 1
+ , bflLabelSize = ColSm 4
+ , bflInputOffset = ColSm 1
+ , bflInputSize = ColSm 6
+ }
+
diff --git a/src/Handler/Utils/Term.hs b/src/Handler/Utils/Term.hs
index 57ea6bdda..d15a05489 100644
--- a/src/Handler/Utils/Term.hs
+++ b/src/Handler/Utils/Term.hs
@@ -8,8 +8,10 @@ module Handler.Utils.Term where
import Import
import qualified Data.Text as T
+import Model.Types
-- import Data.Maybe
+
termExistsField :: Field (HandlerT UniWorX IO) TermIdentifier
termExistsField = termField True
diff --git a/src/Import.hs b/src/Import.hs
index a10200156..e2466be59 100644
--- a/src/Import.hs
+++ b/src/Import.hs
@@ -2,5 +2,6 @@ module Import
( module Import
) where
+import Common as Import
import Foundation as Import
import Import.NoFoundation as Import
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index 9c2a8b4d5..f3751c05a 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -8,6 +8,8 @@ module Model.Types where
import ClassyPrelude
+import Common
+
import Database.Persist.TH
import Database.Persist.Class
import Database.Persist.Sql
@@ -104,3 +106,11 @@ termField :: Field (HandlerT UniWorX IO) TermIdentifier
termField = checkMMap (return . termFromText) termToText textField
-- TODO: this is too simple and inconvenient, use selector and year picker
-}
+
+
+withinTerm :: Day -> TermIdentifier -> Bool
+time `withinTerm` term = timeYear `mod` 100 == termYear `mod` 100
+ where
+ timeYear = fst3 $ toGregorian time
+ termYear = year term
+
diff --git a/templates/generic_form.hamlet b/templates/generic_form.hamlet
new file mode 100644
index 000000000..6be52e393
--- /dev/null
+++ b/templates/generic_form.hamlet
@@ -0,0 +1,14 @@
+