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

Towards #267

Browse Source
This commit is contained in:
SJost 2019-01-30 14:48:16 +01:00
parent b45d1c92f9
commit 39da549461
4 changed files with 42 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
messages/uniworx/de.msg
View File

@ -7,6 +7,7 @@ BtnHijack: Sitzung übernehmen
Aborted: Abgebrochen Aborted: Abgebrochen
Registered: Angemeldet Registered: Angemeldet
RegisteredSince date@Text: Angemeldet seit #{date}
RegisterFrom: Anmeldungen von RegisterFrom: Anmeldungen von
RegisterTo: Anmeldungen bis RegisterTo: Anmeldungen bis
DeRegUntil: Abmeldungen bis DeRegUntil: Abmeldungen bis
@ -108,7 +109,7 @@ SheetSolutionFrom: Lösung ab
SheetMarking: Hinweise für Korrektoren SheetMarking: Hinweise für Korrektoren
SheetType: Wertung SheetType: Wertung
SheetInvisible: Dieses Übungsblatt ist für Teilnehmer momentan unsichtbar! SheetInvisible: Dieses Übungsblatt ist für Teilnehmer momentan unsichtbar!
SheetInvisibleUntil mFrom@Text: Dieses Übungsblatt ist für Teilnehmer momentan unsichtbar bis #{mFrom}! SheetInvisibleUntil date@Text: Dieses Übungsblatt ist für Teilnehmer momentan unsichtbar bis #{date}!
SheetName: Name SheetName: Name
SheetDescription: Hinweise für Teilnehmer SheetDescription: Hinweise für Teilnehmer
SheetGroup: Gruppenabgabe SheetGroup: Gruppenabgabe

39
src/Handler/Course.hs
View File

@ -259,25 +259,30 @@ getTermCourseListR tid = do
getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCShowR tid ssh csh = do getCShowR tid ssh csh = do
mbAid <- maybeAuthId mbAid <- maybeAuthId
(courseEnt,(schoolMB,participants,registered),lecturers) <- runDB $ do (course,schoolName,participants,registered,lecturers) <- runDB . maybeT notFound $ do
courseEnt@(Entity cid course) <- getBy404 $ TermSchoolCourseShort tid ssh csh [(E.Entity cid course, E.Value schoolName, E.Value participants, E.Value registered)]
dependent <- (,,) <- lift . E.select . E.from $
<$> get (courseSchool course) -- join -- just fetch full school name here \((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do
<*> count [CourseParticipantCourse ==. cid] -- join E.on $ E.just (course E.^. CourseId) E.==. participant E.?. CourseParticipantCourse
<*> (case mbAid of -- TODO: Someone please refactor this late-night mess here! E.&&. E.val mbAid E.==. participant E.?. CourseParticipantUser
Nothing -> return False E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
(Just aid) -> do regL <- getBy (UniqueParticipant aid cid) E.where_ $ course E.^. CourseTerm E.==. E.val tid
return $ isJust regL) E.&&. course E.^. CourseSchool E.==. E.val ssh
lecturers <- E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do E.&&. course E.^. CourseShorthand E.==. E.val csh
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId let numParticipants = E.sub_select . E.from $ \part -> do
E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId
return $ user E.^. UserDisplayName return ( E.countRows :: E.SqlExpr (E.Value Int64))
return (courseEnt,dependent,E.unValue <$> lecturers) return (course,school E.^. SchoolName, numParticipants, participant E.?. CourseParticipantRegistration)
let course = entityVal courseEnt lecturers <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
(regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
return $ user E.^. UserDisplayName
return (course,schoolName,participants,registered,map E.unValue lecturers)
mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom course mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom course
mRegTo <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo course mRegTo <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo course
mRegAt <- traverse (formatTime SelFormatDateTime) $ registered
(regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm (isJust mRegAt) $ courseRegisterSecret course
registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True
defaultLayout $ do defaultLayout $ do
setTitle [shamlet| #{toPathPiece tid} - #{csh}|] setTitle [shamlet| #{toPathPiece tid} - #{csh}|]
$(widgetFile "course") $(widgetFile "course")

34
templates/course.hamlet
View File

@ -1,10 +1,9 @@
<div .container> <div .container>
<dl .deflist> <dl .deflist>
$maybe school <- schoolMB <dt .deflist__dt>Fakultät/Institut
<dt .deflist__dt>Fakultät/Institut <dd .deflist__dd>
<dd .deflist__dd> <div>
<div> #{schoolName}
#{schoolName school}
$maybe descr <- courseDescription course $maybe descr <- courseDescription course
<dt .deflist__dt>_{MsgCourseDescription} <dt .deflist__dt>_{MsgCourseDescription}
@ -33,20 +32,23 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
#{participants} #{participants}
$maybe capacity <- courseCapacity course $maybe capacity <- courseCapacity course
\ von #{capacity} \ von #{capacity}
$maybe regFrom <- mRegFrom $maybe regFrom <- mRegFrom
<dt .deflist__dt>Anmeldezeitraum <dt .deflist__dt>Anmeldezeitraum
<dd .deflist__dd> <dd .deflist__dd>
<div> <div>
Ab #{regFrom} Ab #{regFrom}
$maybe regTo <- mRegTo $maybe regTo <- mRegTo
\ bis #{regTo} \ bis #{regTo}
$if registrationOpen $if registrationOpen || isJust mRegAt
<dt .deflist__dt> <dt .deflist__dt>
<dd .deflist__dd> <dd .deflist__dd>
<div .course__registration> <div .course__registration>
<form method=post action=@{CourseR tid ssh csh CRegisterR} enctype=#{regEnctype}> $if registrationOpen
$# regWidget is defined through templates/widgets/registerForm <form method=post action=@{CourseR tid ssh csh CRegisterR} enctype=#{regEnctype}>
^{regWidget} $# regWidget is defined through templates/widgets/registerForm
^{regWidget}
$maybe date <- mRegAt
_{MsgRegisteredSince date}
<dt .deflist__dt> <dt .deflist__dt>
Material Material
<dd .deflist__dd> <dd .deflist__dd>

1
templates/widgets/registerForm.hamlet
View File

@ -5,4 +5,3 @@ $maybe secretView <- msecretView
^{fvInput secretView} ^{fvInput secretView}
$# Always display register/deregister button $# Always display register/deregister button
^{fvInput btnView} ^{fvInput btnView}