{-# LANGUAGE NoImplicitPrelude , OverloadedStrings , OverloadedLists , RecordWildCards , TemplateHaskell , QuasiQuotes , MultiParamTypeClasses , TypeFamilies , 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 -- let termData 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 $ toJSON . map fst <$> runDB (E.select $ E.from termData) provideRep $ do let colonnadeTerms = mconcat [ sortable Nothing "Kürzel" $ \(Entity tid Term{..},_) -> cell $ 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} |] , sortable (Just "lecture-start") "Beginn Vorlesungen" $ \(Entity _ Term{..},_) -> stringCell $ formatTimeGerWD termLectureStart , sortable (Just "lecture-end") "Ende Vorlesungen" $ \(Entity _ Term{..},_) -> stringCell $ formatTimeGerWD termLectureEnd , sortable Nothing "Aktiv" $ \(Entity _ Term{..},_) -> textCell $ bool "" tickmark termActive , sortable Nothing "Kursliste" $ \(Entity tid Term{..}, E.Value numCourses) -> cell [whamlet| #{show numCourses} Kurse |] , sortable (Just "start") "Semesteranfang" $ \(Entity _ Term{..},_) -> stringCell $ formatTimeGerWD termStart , sortable (Just "end") "Semesterende" $ \(Entity _ Term{..},_) -> stringCell $ formatTimeGerWD termEnd , sortable Nothing "Feiertage im Semester" $ \(Entity _ Term{..},_) -> stringCell $ (intercalate ", ") $ map formatTimeGerWD termHolidays ] table <- dbTable def $ DBTable { dbtSQLQuery = termData , dbtColonnade = colonnadeTerms , dbtSorting = [ ( "start" , SortColumn $ \term -> term E.^. TermStart ) , ( "end" , SortColumn $ \term -> term E.^. TermEnd ) , ( "lecture-start" , SortColumn $ \term -> term E.^. TermLectureStart ) , ( "lecture-end" , SortColumn $ \term -> term E.^. TermLectureEnd ) ] , dbtAttrs = tableDefault , dbtIdent = "terms" :: Text } defaultLayout $ do setTitle "Freigeschaltete Semester" $(widgetFile "terms") 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 case result of (FormSuccess res) -> do -- term <- runDB $ get $ TermKey termName runDB $ repsert (TermKey $ termName res) res -- VOR INTERNATIONALISIERUNG: -- let tid = termToText $ termName res -- let msg = "Semester " `T.append` tid `T.append` " erfolgreich editiert." -- addMessage "success" [shamlet| #{msg} |] -- MIT INTERNATIONALISIERUNG: addMessageI "success" $ MsgTermEdited $ termName res redirect TermShowR (FormMissing ) -> return () (FormFailure _) -> addMessageI "warning" MsgInvalidInput let formTitle = "Semester editieren/anlegen" :: Text let actionUrl = TermEditR defaultLayout $ do setTitle [shamlet| #{formTitle} |] $(widgetFile "formPage") 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) <* submitButton 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 -}