{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} module Handler.Term where import Import import Handler.Utils import qualified Data.Text as T import Yesod.Form.Bootstrap3 import Colonnade hiding (bool) import Yesod.Colonnade import qualified Database.Esqueleto as E getTermShowR :: Handler TypedContent getTermShowR = do -- terms <- runDB $ selectList [] [Desc TermStart] ------- ÄQUIVALENT: -- term <- runDB $ E.select . E.from $ \(term) -> do -- E.orderBy [E.desc $ term E.^. TermStart ] -- return term -- termData <- runDB $ E.select . E.from $ \term -> do E.orderBy [E.desc $ term E.^. TermStart ] let courseCount :: E.SqlExpr (E.Value Int) courseCount = E.sub_select . E.from $ \course -> do E.where_ $ term E.^. TermId E.==. course E.^. CourseTermId return E.countRows return (term, courseCount) selectRep $ do provideRep $ return $ toJSON $ map fst termData provideRep $ do let colonnadeTerms = mconcat [ headed "Kürzel" $ \(Entity tid Term{..},_) -> do -- Scrap this if to slow, create term edit page instead adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tid) False [whamlet| $if adminLink == Authorized #{termToText termName} $else #{termToText termName} |] , headed "Beginn Vorlesungen" $ \(Entity _ Term{..},_) -> fromString $ formatTimeGerWD termLectureStart , headed "Ende Vorlesungen" $ \(Entity _ Term{..},_) -> fromString $ formatTimeGerWD termLectureEnd , headed "Aktiv" $ \(Entity _ Term{..},_) -> bool "" tickmark termActive , headed "Kursliste" $ \(Entity tid Term{..}, E.Value numCourses) -> [whamlet| #{show numCourses} Kurse |] , headed "Semesteranfang" $ \(Entity _ Term{..},_) -> fromString $ formatTimeGerWD termStart , headed "Semesterende" $ \(Entity _ Term{..},_) -> fromString $ formatTimeGerWD termEnd , headed "Feiertage im Semester" $ \(Entity _ Term{..},_) -> fromString $ (intercalate ", ") $ map formatTimeGerWD termHolidays ] defaultLayout $ do setTitle "Freigeschaltete Semester" encodeWidgetTable tableDefault colonnadeTerms termData getTermEditR :: Handler Html getTermEditR = do -- TODO: Defaults für Semester hier ermitteln und übergeben termEditHandler Nothing postTermEditR :: Handler Html postTermEditR = termEditHandler Nothing getTermEditExistR :: TermId -> Handler Html getTermEditExistR tid = do term <- runDB $ get tid termEditHandler term termEditHandler :: Maybe Term -> Handler Html termEditHandler term = do ((result, formWidget), formEnctype) <- runFormPost $ newTermForm term action <- lookupPostParam "formaction" case (result,action) of (FormSuccess res, fAct) | fAct == formActionDelete -> do runDB $ delete (TermKey $ termName res) let tid = termToText $ termName res let msg = "Semester " `T.append` tid `T.append` " erfolgreich gelöscht." addMessage "warning" [shamlet| #{msg} |] redirect TermShowR | fAct == formActionSave -> 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` " erfolgreich editiert." addMessage "success" [shamlet| #{msg} |] redirect TermShowR | otherwise -> redirect TermShowR (FormMissing,_) -> return () (FormFailure _,_) -> addMessage "warning" "Bitte Eingabe korrigieren." let formTitle = "Semester editieren/anlegen" :: Text let actionUrl = TermEditR let formActions = defaultFormActions defaultLayout $ do setTitle [shamlet| #{formTitle} |] $(widgetFile "generic_form") {- wdgtTermForm :: (ToWidget UniWorX a) => a -> Enctype -> Handler Html wdgtTermForm formWidget formEnctype = do let formTitle = "Semester editieren/anlegen" :: Text let actionUrl = TermEditR let formActions = defaultFormActions defaultLayout $ do setTitle [shamlet| #{formTitle} |] $(widgetFile "generic_form") -} newTermForm :: Maybe Term -> Form Term newTermForm template html = do (result, widget) <- flip (renderAForm FormStandard) html $ Term <$> areq termNewField (bfs ("Semester" :: Text)) (termName <$> template) <*> areq dayField (bfs ("Erster Tag" :: Text)) (termStart <$> template) <*> areq dayField (bfs ("Letzer Tag" :: Text)) (termEnd <$> template) <*> pure [] -- TODO: List of Day field required, must probably be done as its own form and then combined <*> areq dayField (bfs ("Beginn Vorlesungen" :: Text)) (termLectureStart <$> template) <*> areq dayField (bfs ("Ende Vorlesungen" :: Text)) (termLectureEnd <$> template) <*> areq checkBoxField (bfs ("Aktiv" :: Text)) (termActive <$> template) -- <* bootstrapSubmit (bsSubmit "Semester bearbeiten") return $ case result of FormSuccess termResult | errorMsgs <- validateTerm termResult , not $ null errorMsgs -> (FormFailure errorMsgs, [whamlet|

Fehler:
    $forall errmsg <- errorMsgs
  • #{errmsg} ^{widget} |] ) _ -> (result, widget) {- where set :: Text -> FieldSettings site set = bfs -}