From 118192c1685bdf1deb5e74fb82eb9d61090502a3 Mon Sep 17 00:00:00 2001 From: SJost Date: Tue, 31 Jul 2018 16:42:34 +0200 Subject: [PATCH] Kursliste zeigen Anmeldestatus --- ChangeLog.md | 2 + messages/de.msg | 1 + src/Handler/Course.hs | 132 ++++++++++++++------------ src/Handler/Utils/Table/Pagination.hs | 6 ++ 4 files changed, 78 insertions(+), 63 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 2ffc74b71..240b51546 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/messages/de.msg b/messages/de.msg index 92a228190..ae6d17cb8 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -5,6 +5,7 @@ BtnRegister: Anmelden BtnDeregister: Abmelden BtnHijack: Sitzung übernehmen +Registered: Angemeldet RegisterFrom: Anmeldungen von RegisterTo: Anmeldungen bis DeRegUntil: Abmeldungen bis diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 201400194..3b95e77a1 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -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") diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index a7bda4a73..cc2b06fe6 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -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