Kursliste zeigen Anmeldestatus
This commit is contained in:
SJost
parent
e9b504473c
commit
118192c168
@ -2,6 +2,8 @@
|
||||
|
||||
Viele Verbesserung zur Anzeige von Korrekturen
|
||||
|
||||
Kursliste über alle Semester hinweg (Top-Level-Navigation "Kurse"), wird in Zukunft Filter/Suchfunktion erhalten
|
||||
|
||||
* Version 10.07.2018
|
||||
|
||||
Bugfixes, wählbares Format für Datum
|
||||
|
||||
@ -5,6 +5,7 @@ BtnRegister: Anmelden
|
||||
BtnDeregister: Abmelden
|
||||
BtnHijack: Sitzung übernehmen
|
||||
|
||||
Registered: Angemeldet
|
||||
RegisterFrom: Anmeldungen von
|
||||
RegisterTo: Anmeldungen bis
|
||||
DeRegUntil: Abmeldungen bis
|
||||
|
||||
@ -34,45 +34,81 @@ import qualified Database.Esqueleto as E
|
||||
import qualified Data.UUID.Cryptographic as UUID
|
||||
|
||||
|
||||
type CourseTableData = DBRow (Entity Course, Int64)
|
||||
type CourseTableData = DBRow (Entity Course, Int64, Bool)
|
||||
|
||||
colCourse :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colCourse = sortable (Just "course") (i18nCell MsgCourse)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
|
||||
anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseName}|]
|
||||
|
||||
colCShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
|
||||
anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseShorthand}|]
|
||||
|
||||
colTerm :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colTerm = sortable (Just "term") (i18nCell MsgTerm)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
|
||||
anchorCell (TermCourseListR courseTerm) [whamlet|#{display courseTerm}|]
|
||||
|
||||
colRegFrom :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colRegFrom = sortable (Just "register-from") (i18nCell MsgRegisterFrom)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
|
||||
cell $ traverse (formatTime SelFormatDateTime) courseRegisterFrom >>= maybe mempty toWidget
|
||||
|
||||
colRegTo :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colRegTo = sortable (Just "register-to") (i18nCell MsgRegisterTo)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
|
||||
cell $ traverse (formatTime SelFormatDateTime) courseRegisterTo >>= maybe mempty toWidget
|
||||
|
||||
colParticipants :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colParticipants = sortable (Just "participants") (i18nCell MsgCourseMembers)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, currentParticipants, _) } -> textCell $ case courseCapacity of
|
||||
Nothing -> MsgCourseMembersCount currentParticipants
|
||||
Just max -> MsgCourseMembersCountLimited currentParticipants max
|
||||
|
||||
colRegistered :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colRegistered = sortable (Just "registered") (i18nCell MsgRegistered)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, registered) } -> tickmarkCell registered
|
||||
|
||||
type CourseTableExpr = E.SqlExpr (Entity Course)
|
||||
|
||||
course2Participants :: CourseTableExpr -> E.SqlExpr (E.Value Int64)
|
||||
course2Participants 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))
|
||||
|
||||
course2Registered :: Maybe UserId -> CourseTableExpr -> E.SqlExpr (E.Value Bool)
|
||||
course2Registered muid course = E.exists . E.from $ \courseParticipant -> do
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
E.&&. E.just (courseParticipant E.^. CourseParticipantUser) E.==. E.val muid
|
||||
|
||||
makeCourseTable :: ( IsDBTable m x, ToSortable h, Functor h )
|
||||
=> _ -> Colonnade h CourseTableData (DBCell m x) -> PSValidator m x -> Handler (DBResult m x)
|
||||
makeCourseTable whereClause colChoices psValidator = do
|
||||
muid <- maybeAuthId
|
||||
let dbtSQLQuery :: CourseTableExpr -> E.SqlQuery _
|
||||
dbtSQLQuery course = do
|
||||
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))
|
||||
E.where_ $ whereClause (course,participants)
|
||||
return (course, participants)
|
||||
let participants = course2Participants course
|
||||
let registered = course2Registered muid course
|
||||
E.where_ $ whereClause (course, participants, registered)
|
||||
return (course, participants, registered)
|
||||
dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData
|
||||
dbtProj = traverse $ \(course, E.Value participants) -> return (course, participants)
|
||||
dbtProj = traverse $ \(course, E.Value participants, E.Value registered) -> return (course, participants, registered)
|
||||
dbTable psValidator $ DBTable
|
||||
{ dbtSQLQuery
|
||||
, dbtColonnade = colChoices
|
||||
, dbtProj
|
||||
, dbtSorting =
|
||||
[ ( "course", SortColumn $ \course -> course E.^. CourseName)
|
||||
, ( "cshort", SortColumn $ \course -> course E.^. CourseShorthand)
|
||||
, ( "term" , SortColumn $ \course -> course E.^. CourseTerm)
|
||||
[ ( "course", SortColumn $ \course -> course E.^. CourseName)
|
||||
, ( "cshort", SortColumn $ \course -> course E.^. CourseShorthand)
|
||||
, ( "term" , SortColumn $ \course -> course E.^. CourseTerm)
|
||||
, ( "register-from", SortColumn $ \course -> course E.^. CourseRegisterFrom)
|
||||
, ( "register-to", SortColumn $ \course -> course E.^. CourseRegisterTo)
|
||||
, ( "participants", SortColumn $ course2Participants
|
||||
)
|
||||
, ( "registered", SortColumn $ course2Registered muid
|
||||
)
|
||||
]
|
||||
, dbtFilter =
|
||||
[ ( "course", FilterColumn $ \(course :: CourseTableExpr) criterias -> if
|
||||
@ -93,18 +129,22 @@ makeCourseTable whereClause colChoices psValidator = do
|
||||
}
|
||||
|
||||
getCourseListR :: Handler Html
|
||||
getCourseListR = do -- TODO: KurseList aller Kurse mit Suchfunktion!
|
||||
getCourseListR = do -- TODO: Suchfunktion für Kurse und Kürzel!!!
|
||||
muid <- maybeAuthId
|
||||
let colonnade = widgetColonnade $ mconcat
|
||||
[ colCourse
|
||||
, colCShort
|
||||
, colTerm
|
||||
, maybe mempty (const colRegistered) muid
|
||||
]
|
||||
validator = def
|
||||
whereClause = const $ E.val True
|
||||
ctable <- makeCourseTable whereClause colonnade validator
|
||||
validator = def
|
||||
& defaultSorting [("course", SortAsc), ("term", SortDesc)]
|
||||
coursesTable <- makeCourseTable whereClause colonnade validator
|
||||
defaultLayout $ do
|
||||
setTitleI MsgCourseListTitle
|
||||
ctable
|
||||
[whamlet|TODO: Such-/Filterfunktion hier einbauen|] -- TODO
|
||||
$(widgetFile "courses")
|
||||
|
||||
getTermCurrentR :: Handler Html
|
||||
getTermCurrentR = do
|
||||
@ -117,53 +157,19 @@ getTermCurrentR = do
|
||||
getTermCourseListR :: TermId -> Handler Html
|
||||
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{..}, _) -> cell $ traverse (formatTime SelFormatDateTime) courseRegisterFrom >>= maybe mempty toWidget
|
||||
, sortable (Just "register-to") (textCell MsgRegisterTo) $ \(Entity _ Course{..}, _) -> cell $ traverse (formatTime SelFormatDateTime) courseRegisterTo >>= maybe mempty toWidget
|
||||
, sortable (Just "members") (textCell MsgCourseMembers) $ \(Entity _ Course{..}, E.Value num) -> textCell $ case courseCapacity of
|
||||
Nothing -> MsgCourseMembersCount num
|
||||
Just max -> MsgCourseMembersCountLimited num max
|
||||
muid <- maybeAuthId
|
||||
let colonnade = widgetColonnade $ mconcat
|
||||
[ dbRow
|
||||
, colCShort
|
||||
, colRegFrom
|
||||
, colRegTo
|
||||
, colParticipants
|
||||
, maybe mempty (const colRegistered) muid
|
||||
]
|
||||
, dbtProj = return . dbrOutput
|
||||
, dbtSorting = Map.fromList
|
||||
[ ( "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 = mempty
|
||||
, dbtStyle = def
|
||||
, dbtIdent = "courses" :: Text
|
||||
}
|
||||
|
||||
whereClause = \(course, _, _) -> course E.^. CourseTerm E.==. E.val tid
|
||||
validator = def
|
||||
& defaultSorting [("cshort", SortAsc)]
|
||||
coursesTable <- makeCourseTable whereClause colonnade validator
|
||||
defaultLayout $ do
|
||||
setTitleI . MsgTermCourseListTitle $ tid
|
||||
$(widgetFile "courses")
|
||||
|
||||
@ -34,6 +34,7 @@ module Handler.Utils.Table.Pagination
|
||||
, widgetColonnade, formColonnade, dbColonnade
|
||||
, cell, textCell, stringCell, i18nCell
|
||||
, anchorCell, anchorCell', anchorCellM
|
||||
, tickmarkCell
|
||||
, listCell
|
||||
, formCell, DBFormResult, getDBFormResult
|
||||
, dbRow, dbSelect
|
||||
@ -472,6 +473,11 @@ stringCell = textCell
|
||||
i18nCell = textCell
|
||||
textCell msg = cell [whamlet|_{msg}|]
|
||||
|
||||
tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
|
||||
tickmarkCell True = textCell (tickmark :: Text)
|
||||
tickmarkCell False = mempty
|
||||
|
||||
|
||||
anchorCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a
|
||||
anchorCell = anchorCellM . return
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user