150 lines
5.7 KiB
Haskell
150 lines
5.7 KiB
Haskell
{-# 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
|
|
<a href=@{TermEditExistR tid}>
|
|
#{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|
|
|
<a href=@{CourseListTermR tid}>
|
|
#{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
|
|
]
|
|
let pageActions =
|
|
[ NavbarLeft $ MenuItem
|
|
{ menuItemLabel = "Neues Semester"
|
|
, menuItemRoute = TermEditR
|
|
, menuItemAccessCallback = (== Authorized) <$> isAuthorized TermEditR True
|
|
}
|
|
]
|
|
defaultLinkLayout pageActions $ 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
|
|
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} |]
|
|
-- setTitle [whamlet| _{MsgTermNewTitle} |] -- TODO, does not work
|
|
$(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|
|
|
<div class="alert alert-danger">
|
|
<h4> Fehler:
|
|
<ul>
|
|
$forall errmsg <- errorMsgs
|
|
<li> #{errmsg}
|
|
^{widget}
|
|
|]
|
|
)
|
|
_ -> (result, widget)
|
|
{-
|
|
where
|
|
set :: Text -> FieldSettings site
|
|
set = bfs
|
|
-}
|