diff --git a/messages/de.msg b/messages/de.msg
index 9bb712c15..d78acf450 100644
--- a/messages/de.msg
+++ b/messages/de.msg
@@ -179,3 +179,7 @@ FileCorrectedDeleted: Korrigiert (gelöscht)
RatingUpdated: Korrektur gespeichert
RatingDeleted: Korrektur zurückgesetzt
RatingFilesUpdated: Korrigierte Dateien überschrieben
+
+CourseMembers: Teilnehmer
+CourseMembersCount num@Int64: #{display num}
+CourseMembersCountLimited num@Int64 max@Int64: #{display num}/#{display max}
\ No newline at end of file
diff --git a/models b/models
index 68d38cb4a..90b554663 100644
--- a/models
+++ b/models
@@ -60,7 +60,7 @@ Course
shorthand Text
term TermId
school SchoolId
- capacity Int Maybe
+ capacity Int64 Maybe
-- canRegisterNow = maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo
registerFrom UTCTime Maybe
registerTo UTCTime Maybe
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index a114a0484..bebf18334 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -7,6 +7,7 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedLists #-}
module Handler.Course where
@@ -19,7 +20,9 @@ import Data.Function ((&))
-- import Yesod.Form.Bootstrap3
import Colonnade hiding (fromMaybe,bool)
-import Yesod.Colonnade
+-- import Yesod.Colonnade
+
+import qualified Database.Esqueleto as E
import qualified Data.UUID.Cryptographic as UUID
@@ -37,45 +40,55 @@ getTermCurrentR = do
getTermCourseListR :: TermId -> Handler Html
-getTermCourseListR tidini = do
- (term,courses) <- runDB $ (,)
- <$> get tidini
- <*> selectList [CourseTerm ==. tidini] [Asc CourseShorthand]
- when (isNothing term) $ do
- addMessage "warning" [shamlet| Semester #{toPathPiece tidini} nicht gefunden. |]
- redirect TermShowR
- -- TODO: several runDBs per TableRow are probably too inefficient!
- let colonnadeTerms = mconcat
- [ headed "Kürzel" $ (\ckv ->
- let c = entityVal ckv
- shd = courseShorthand c
- tid = courseTerm c
- in [whamlet| #{shd} |] )
--- , headed "Institut" $ [shamlet| #{course} |]
- , headed "Beginn Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterFrom.entityVal
- , headed "Ende Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterTo.entityVal
- , headed "Teilnehmer" $ (\ckv -> do
- let cid = entityKey ckv
- partiNum <- handlerToWidget $ runDB $ count [CourseParticipantCourse ==. cid]
- [whamlet| #{show partiNum} |]
- )
- , headed " " $ (\ckv ->
- let c = entityVal ckv
- shd = courseShorthand c
- tid = courseTerm c
- in do
- adminLink <- handlerToWidget $ isAuthorized (CourseR tid shd CEditR) False
- -- if (adminLink==Authorized) then linkButton "Ändern" BCWarning (CEditR tid shd) else ""
- [whamlet|
- $if adminLink == Authorized
-
- editieren
- |]
- )
+getTermCourseListR tid = do
+ void . runDB $ get404 tid -- Just ensure the term exists
+
+ let
+ tableData :: E.SqlExpr (Entity Course) -> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (E.Value Int64))
+ tableData course = do
+ E.where_ $ course E.^. CourseTerm E.==. E.val tid
+ let
+ participants = E.sub_select . E.from $ \courseParticipant -> do
+ E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
+ return (E.countRows :: E.SqlExpr (E.Value Int64))
+ return (course, participants)
+ psValidator = def
+ & defaultSorting [("shorthand", SortAsc)]
+
+ coursesTable <- dbTable psValidator $ DBTable
+ { dbtSQLQuery = tableData
+ , dbtColonnade = widgetColonnade $ mconcat
+ [ sortable (Just "shorthand") (textCell MsgCourse) $ anchorCell'
+ (\(Entity _ Course{..}, _) -> CourseR courseTerm courseShorthand CShowR)
+ (\(Entity _ Course{..}, _) -> toWidget courseShorthand)
+ , sortable (Just "register-from") (textCell MsgRegisterFrom) $ \(Entity _ Course{..}, _) -> textCell $ display courseRegisterFrom
+ , sortable (Just "register-to") (textCell MsgRegisterTo) $ \(Entity _ Course{..}, _) -> textCell $ display courseRegisterTo
+ , sortable (Just "members") (textCell MsgCourseMembers) $ \(Entity _ Course{..}, E.Value num) -> textCell $ case courseCapacity of
+ Nothing -> MsgCourseMembersCount num
+ Just max -> MsgCourseMembersCountLimited num max
]
- let coursesTable = encodeWidgetTable tableSortable colonnadeTerms courses
+ , dbtSorting = [ ( "shorthand"
+ , SortColumn $ \course -> course E.^. CourseShorthand
+ )
+ , ( "register-from"
+ , SortColumn $ \course -> course E.^. CourseRegisterFrom
+ )
+ , ( "register-to"
+ , SortColumn $ \course -> course E.^. CourseRegisterTo
+ )
+ , ( "members"
+ , SortColumn $ \course -> E.sub_select . E.from $ \courseParticipant -> do
+ E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
+ return (E.countRows :: E.SqlExpr (E.Value Int64))
+ )
+ ]
+ , dbtFilter = []
+ , dbtAttrs = tableDefault
+ , dbtIdent = "courses" :: Text
+ }
+
defaultLayout $ do
- setTitleI . MsgTermCourseListTitle $ tidini
+ setTitleI . MsgTermCourseListTitle $ tid
$(widgetFile "courses")
getCShowR :: TermId -> Text -> Handler Html
@@ -129,7 +142,7 @@ postCRegisterR tid csh = do
actTime <- liftIO $ getCurrentTime
regOk <- runDB $ do
reg <- count [CourseParticipantCourse ==. cid]
- if NTop (Just reg) < NTop (courseCapacity course)
+ if NTop (Just $ fromIntegral reg) < NTop (courseCapacity course)
then -- current capacity has room
insertUnique $ CourseParticipant cid aid actTime
else do -- no space left
@@ -260,7 +273,7 @@ data CourseForm = CourseForm
, cfShort :: Text
, cfTerm :: TermId
, cfSchool :: SchoolId
- , cfCapacity :: Maybe Int
+ , cfCapacity :: Maybe Int64
, cfSecret :: Maybe Text
, cfMatFree :: Bool
, cfRegFrom :: Maybe UTCTime