fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Kursliste zeigen Anmeldestatus

Browse Source
This commit is contained in:
SJost 2018-07-31 16:42:34 +02:00
parent e9b504473c
commit 118192c168
4 changed files with 78 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ChangeLog.md
View File

@ -2,6 +2,8 @@
Viele Verbesserung zur Anzeige von Korrekturen 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 * Version 10.07.2018
Bugfixes, wählbares Format für Datum Bugfixes, wählbares Format für Datum

1
messages/de.msg
View File

@ -5,6 +5,7 @@ BtnRegister: Anmelden
BtnDeregister: Abmelden BtnDeregister: Abmelden
BtnHijack: Sitzung übernehmen BtnHijack: Sitzung übernehmen
Registered: Angemeldet
RegisterFrom: Anmeldungen von RegisterFrom: Anmeldungen von
RegisterTo: Anmeldungen bis RegisterTo: Anmeldungen bis
DeRegUntil: Abmeldungen bis DeRegUntil: Abmeldungen bis

132
src/Handler/Course.hs
View File

@ -34,45 +34,81 @@ import qualified Database.Esqueleto as E
import qualified Data.UUID.Cryptographic as UUID 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 :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
colCourse = sortable (Just "course") (i18nCell MsgCourse) colCourse = sortable (Just "course") (i18nCell MsgCourse)
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _) } -> $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseName}|] anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseName}|]
colCShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) colCShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort) colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort)
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _) } -> $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseShorthand}|] anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseShorthand}|]
colTerm :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) colTerm :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
colTerm = sortable (Just "term") (i18nCell MsgTerm) colTerm = sortable (Just "term") (i18nCell MsgTerm)
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _) } -> $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
anchorCell (TermCourseListR courseTerm) [whamlet|#{display courseTerm}|] 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) 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 ) makeCourseTable :: ( IsDBTable m x, ToSortable h, Functor h )
=> _ -> Colonnade h CourseTableData (DBCell m x) -> PSValidator m x -> Handler (DBResult m x) => _ -> Colonnade h CourseTableData (DBCell m x) -> PSValidator m x -> Handler (DBResult m x)
makeCourseTable whereClause colChoices psValidator = do makeCourseTable whereClause colChoices psValidator = do
muid <- maybeAuthId
let dbtSQLQuery :: CourseTableExpr -> E.SqlQuery _ let dbtSQLQuery :: CourseTableExpr -> E.SqlQuery _
dbtSQLQuery course = do dbtSQLQuery course = do
let participants = E.sub_select . E.from $ \courseParticipant -> do let participants = course2Participants course
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId let registered = course2Registered muid course
return (E.countRows :: E.SqlExpr (E.Value Int64)) E.where_ $ whereClause (course, participants, registered)
E.where_ $ whereClause (course,participants) return (course, participants, registered)
return (course, participants)
dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData 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 dbTable psValidator $ DBTable
{ dbtSQLQuery { dbtSQLQuery
, dbtColonnade = colChoices , dbtColonnade = colChoices
, dbtProj , dbtProj
, dbtSorting = , dbtSorting =
[ ( "course", SortColumn $ \course -> course E.^. CourseName) [ ( "course", SortColumn $ \course -> course E.^. CourseName)
, ( "cshort", SortColumn $ \course -> course E.^. CourseShorthand) , ( "cshort", SortColumn $ \course -> course E.^. CourseShorthand)
, ( "term" , SortColumn $ \course -> course E.^. CourseTerm) , ( "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 = , dbtFilter =
[ ( "course", FilterColumn $ \(course :: CourseTableExpr) criterias -> if [ ( "course", FilterColumn $ \(course :: CourseTableExpr) criterias -> if
@ -93,18 +129,22 @@ makeCourseTable whereClause colChoices psValidator = do
} }
getCourseListR :: Handler Html 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 let colonnade = widgetColonnade $ mconcat
[ colCourse [ colCourse
, colCShort , colCShort
, colTerm , colTerm
, maybe mempty (const colRegistered) muid
] ]
validator = def
whereClause = const $ E.val True whereClause = const $ E.val True
ctable <- makeCourseTable whereClause colonnade validator validator = def
& defaultSorting [("course", SortAsc), ("term", SortDesc)]
coursesTable <- makeCourseTable whereClause colonnade validator
defaultLayout $ do defaultLayout $ do
setTitleI MsgCourseListTitle setTitleI MsgCourseListTitle
ctable [whamlet|TODO: Such-/Filterfunktion hier einbauen|] -- TODO
$(widgetFile "courses")
getTermCurrentR :: Handler Html getTermCurrentR :: Handler Html
getTermCurrentR = do getTermCurrentR = do
@ -117,53 +157,19 @@ getTermCurrentR = do
getTermCourseListR :: TermId -> Handler Html getTermCourseListR :: TermId -> Handler Html
getTermCourseListR tid = do getTermCourseListR tid = do
void . runDB $ get404 tid -- Just ensure the term exists void . runDB $ get404 tid -- Just ensure the term exists
muid <- maybeAuthId
let let colonnade = widgetColonnade $ mconcat
tableData :: E.SqlExpr (Entity Course) -> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (E.Value Int64)) [ dbRow
tableData course = do , colCShort
E.where_ $ course E.^. CourseTerm E.==. E.val tid , colRegFrom
let , colRegTo
participants = E.sub_select . E.from $ \courseParticipant -> do , colParticipants
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId , maybe mempty (const colRegistered) muid
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
] ]
, dbtProj = return . dbrOutput whereClause = \(course, _, _) -> course E.^. CourseTerm E.==. E.val tid
, dbtSorting = Map.fromList validator = def
[ ( "shorthand" & defaultSorting [("cshort", SortAsc)]
, SortColumn $ \course -> course E.^. CourseShorthand coursesTable <- makeCourseTable whereClause colonnade validator
)
, ( "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
}
defaultLayout $ do defaultLayout $ do
setTitleI . MsgTermCourseListTitle $ tid setTitleI . MsgTermCourseListTitle $ tid
$(widgetFile "courses") $(widgetFile "courses")

6
src/Handler/Utils/Table/Pagination.hs
View File

@ -34,6 +34,7 @@ module Handler.Utils.Table.Pagination
, widgetColonnade, formColonnade, dbColonnade , widgetColonnade, formColonnade, dbColonnade
, cell, textCell, stringCell, i18nCell , cell, textCell, stringCell, i18nCell
, anchorCell, anchorCell', anchorCellM , anchorCell, anchorCell', anchorCellM
, tickmarkCell
, listCell , listCell
, formCell, DBFormResult, getDBFormResult , formCell, DBFormResult, getDBFormResult
, dbRow, dbSelect , dbRow, dbSelect
@ -472,6 +473,11 @@ stringCell = textCell
i18nCell = textCell i18nCell = textCell
textCell msg = cell [whamlet|_{msg}|] 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 :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a
anchorCell = anchorCellM . return anchorCell = anchorCellM . return