#{errmsg}
- |]
- $(widgetFile "editTerm")
-
-newTermForm :: Maybe Term -> Form Term
-newTermForm template =
- renderBootstrap3 BootstrapBasicForm $ Term
- <$> areq termNewField (set "Semester") (termName <$> template)
- <*> areq dayField (set "Erster Tag") (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)
- where set txt = FieldSettings
- { fsLabel = txt
- , fsTooltip = Nothing
- , fsId = Nothing
- , fsName = Nothing
- , fsAttrs =
- [ ("class", "form-control")
- ]
- }
diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs
new file mode 100644
index 000000000..c67e0503c
--- /dev/null
+++ b/src/Handler/Term.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+module Handler.Term where
+
+import Import
+import Handler.Utils
+import qualified Data.Text as T
+-- import Data.Maybe
+import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3)
+-- import Text.Julius (RawJS (..))
+
+
+
+getShowTermsR :: Handler Html
+getShowTermsR = do
+ terms <- runDB $ selectList [] [Desc TermStart]
+ defaultLayout $ do
+ setTitle "Freigeschaltete Semester"
+ -- TODO: provide common utility function for formatting Times
+ -- TODO: turn into proper table
+ [whamlet|
+
+ Liste der freigeschalteten Semester:
+ $if null terms
+
Es wurden noch kein Semester freigeschaltetet.
+ $else
+
+ $forall Entity _ term <- terms
+ -
+
+ #{termToText $ termName term}
+ from #{formatTime defaultTimeLocale "%d.%m.%Y" $ termStart term}
+ to: #{formatTime defaultTimeLocale "%d.%m.%Y" $ termEnd term}
+ $if termActive term
+ (Semester ist aktiv)
+ $with holidays <- termHolidays term
+ $if not (null holidays)
+ Feiertage im Semester: #{show holidays}
+ |]
+
+getNewTermR :: Handler Html
+getNewTermR = do
+ -- TODO: Defaults für Semester hier ermitteln und übergeben
+ getEditTermMaybeR Nothing
+
+getEditTermR :: Handler Html
+getEditTermR = do
+ -- TODO: Defaults für Semester hier ermitteln und übergeben
+ getEditTermMaybeR Nothing
+
+getEditTermExistR :: TermIdentifier -> Handler Html
+getEditTermExistR tid = do
+ term <- runDB $ get $ TermKey tid
+ getEditTermMaybeR term
+
+getEditTermMaybeR :: Maybe Term -> Handler Html
+getEditTermMaybeR mbTerm= do
+ aid <- requireAuthId
+ (formWidget, formEnctype) <- generateFormPost $ newTermForm mbTerm
+ defaultLayout $ do
+ setTitle "Semester editieren/anlegen"
+ $(widgetFile "editTerm")
+
+postEditTermR :: Handler Html
+postEditTermR = do
+ aid <- requireAuthId
+ ((result, formWidget), formEnctype) <- runFormPost $ newTermForm Nothing
+ case result of
+ FormSuccess res -> 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 $ toHtml msg -- FIXME
+ setMessage "Semester gespeichert"
+ redirect ShowTermsR
+ FormMissing -> defaultLayout $ do
+ setMessage "Keine Formulardaten erhalten."
+ $(widgetFile "editTerm")
+ FormFailure errorMsgs -> defaultLayout $ do
+ setMessage [shamlet| Fehler:
+
+ $forall errmsg <- errorMsgs
+ - #{errmsg}
+ |]
+ $(widgetFile "editTerm")
+
+newTermForm :: Maybe Term -> Form Term
+newTermForm template =
+ renderBootstrap3 BootstrapBasicForm $ Term
+ <$> areq termNewField (set "Semester") (termName <$> template)
+ <*> areq dayField (set "Erster Tag") (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)
+ where set txt = FieldSettings
+ { fsLabel = txt
+ , fsTooltip = Nothing
+ , fsId = Nothing
+ , fsName = Nothing
+ , fsAttrs =
+ [ ("class", "form-control")
+ ]
+ }
diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs
new file mode 100644
index 000000000..7767aa12b
--- /dev/null
+++ b/src/Handler/Utils.hs
@@ -0,0 +1,5 @@
+module Handler.Utils
+ ( module Handler.Utils
+ ) where
+
+import Handler.Utils.Term as Handler.Utils
diff --git a/src/Handler/Utils/Term.hs b/src/Handler/Utils/Term.hs
new file mode 100644
index 000000000..57ea6bdda
--- /dev/null
+++ b/src/Handler/Utils/Term.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+module Handler.Utils.Term where
+
+import Import
+import qualified Data.Text as T
+-- import Data.Maybe
+
+termExistsField :: Field (HandlerT UniWorX IO) TermIdentifier
+termExistsField = termField True
+
+termNewField :: Field (HandlerT UniWorX IO) TermIdentifier
+termNewField = termField False
+
+termField :: Bool -> Field (HandlerT UniWorX IO) TermIdentifier
+termField mustexist = checkMMap checkTerm termToText textField
+ where
+ errTextParse :: Text
+ errTextParse = "Semester: S oder W gefolgt von Jahreszahl"
+
+ errTextFreigabe :: TermIdentifier -> Text
+ errTextFreigabe ti = "Semester " `T.append` (termToText ti) `T.append` " wurde noch nicht freigegeben."
+
+ checkTerm :: Text -> HandlerT UniWorX IO (Either Text TermIdentifier)
+ checkTerm t = case termFromText t of
+ Left _ -> return $ Left errTextParse
+ res@(Right ti) -> do
+ term <- runDB $ get $ TermKey ti -- TODO: membershiptest instead?
+ return $ if mustexist && isNothing term
+ then Left $ errTextFreigabe ti
+ else res