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

feat(allocations): display participant counts to admins

Browse Source
This commit is contained in:
Gregor Kleen 2020-10-20 15:01:44 +02:00
parent b4df980699
commit b79bac777c
3 changed files with 27 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Handler/Allocation/Show.hs
View File

@ -61,6 +61,8 @@ postAShowR tid ssh ash = do
resultCourseVisible = _5 . _Value resultCourseVisible = _5 . _Value
resultAllocationCourse :: _ => Lens' a AllocationCourse resultAllocationCourse :: _ => Lens' a AllocationCourse
resultAllocationCourse = _6 . _entityVal resultAllocationCourse = _6 . _entityVal
resultParticipantCount :: _ => Lens' a Int
resultParticipantCount = _7 . _Value
(Entity aId Allocation{..}, School{..}, isAnyLecturer, isAdmin, courses, registration, wouldNotifyNewCourse) <- runDB $ do (Entity aId Allocation{..}, School{..}, isAnyLecturer, isAdmin, courses, registration, wouldNotifyNewCourse) <- runDB $ do
alloc@(Entity aId Allocation{allocationSchool}) <- getBy404 $ TermSchoolAllocationShort tid ssh ash alloc@(Entity aId Allocation{allocationSchool}) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
@ -81,12 +83,16 @@ postAShowR tid ssh ash = do
E.orderBy [E.asc $ course E.^. CourseName] E.orderBy [E.asc $ course E.^. CourseName]
let hasTemplate = E.exists . E.from $ \courseAppInstructionFile -> let hasTemplate = E.exists . E.from $ \courseAppInstructionFile ->
E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId
participantCount = E.subSelectCount . E.from $ \courseParticipant ->
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
return ( course return ( course
, courseApplication , courseApplication
, hasTemplate , hasTemplate
, E.not_ . E.isNothing $ registration E.?. CourseParticipantId , E.not_ . E.isNothing $ registration E.?. CourseParticipantId
, courseIsVisible now course . Just $ E.val aId , courseIsVisible now course . Just $ E.val aId
, allocationCourse , allocationCourse
, participantCount
) )
registration <- fmap join . for muid $ getBy . UniqueAllocationUser aId registration <- fmap join . for muid $ getBy . UniqueAllocationUser aId
@ -99,6 +105,7 @@ postAShowR tid ssh ash = do
return (alloc, school, isAnyLecturer, isAdmin, nubOn (view $ resultCourse . _entityKey) courses, registration, wouldNotifyNewCourse) return (alloc, school, isAnyLecturer, isAdmin, nubOn (view $ resultCourse . _entityKey) courses, registration, wouldNotifyNewCourse)
let nextSubstitutesDeadline = minimumOf (folded . resultAllocationCourse . _allocationCourseAcceptSubstitutes . _Just . filtered (>= now)) courses let nextSubstitutesDeadline = minimumOf (folded . resultAllocationCourse . _allocationCourseAcceptSubstitutes . _Just . filtered (>= now)) courses
freeCapacity = fmap getSum . getAp . flip foldMap courses $ \cEntry -> Ap . fmap (Sum . max 0) $ (subtract $ cEntry ^. resultParticipantCount) <$> preview (resultCourse . _entityVal . _courseCapacity . _Just) cEntry
MsgRenderer mr <- getMsgRenderer MsgRenderer mr <- getMsgRenderer
let title = MsgAllocationTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationName let title = MsgAllocationTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationName
@ -158,6 +165,7 @@ postAShowR tid ssh ash = do
isRegistered = cEntry ^. resultIsRegistered isRegistered = cEntry ^. resultIsRegistered
courseVisible = cEntry ^. resultCourseVisible courseVisible = cEntry ^. resultCourseVisible
AllocationCourse{..} = cEntry ^. resultAllocationCourse AllocationCourse{..} = cEntry ^. resultAllocationCourse
partCount = cEntry ^. resultParticipantCount
cID <- encrypt cid :: WidgetFor UniWorX CryptoUUIDCourse cID <- encrypt cid :: WidgetFor UniWorX CryptoUUIDCourse
mayApply <- hasWriteAccessTo . AllocationR tid ssh ash $ AApplyR cID mayApply <- hasWriteAccessTo . AllocationR tid ssh ash $ AApplyR cID
mayEdit <- hasWriteAccessTo $ CourseR tid ssh courseShorthand CEditR mayEdit <- hasWriteAccessTo $ CourseR tid ssh courseShorthand CEditR

10
templates/allocation/show.hamlet
View File

@ -62,6 +62,16 @@ $newline never
^{formatTimeW SelFormatDateTime deadline} ^{formatTimeW SelFormatDateTime deadline}
$nothing $nothing
_{MsgAllocationNextSubstitutesDeadlineNever} _{MsgAllocationNextSubstitutesDeadlineNever}
<dt .deflist__dt>
_{MsgAllocationFreeCapacity} #
^{iconInvisible}
<dd .deflist__dd>
$maybe freeCap <- freeCapacity
#{freeCap}
$if freeCap <= 0
\ ^{iconOK}
$nothing
∞
$maybe fromT <- allocationRegisterByCourse $maybe fromT <- allocationRegisterByCourse
<dt .deflist__dt> <dt .deflist__dt>
_{MsgAllocationRegisterByCourseFrom} _{MsgAllocationRegisterByCourseFrom}

9
templates/allocation/show/course.hamlet
View File

@ -24,6 +24,15 @@ $if isAdmin
_{MsgCourseAllocationCourseAcceptsSubstitutesNever} _{MsgCourseAllocationCourseAcceptsSubstitutesNever}
$if allocationCourseAcceptSubstitutes >= Just now $if allocationCourseAcceptSubstitutes >= Just now
\ ^{iconOK} \ ^{iconOK}
<p>
_{MsgCourseAllocationCourseParticipants}:
$maybe capacity <- courseCapacity
\ _{MsgCourseMembersCountLimited partCount capacity}
$if partCount < capacity
\ ^{iconProblem}
$nothing
\ _{MsgCourseMembersCount partCount}
\ ^{iconProblem}
$if hasApplicationTemplate || is _Just courseApplicationsInstructions $if hasApplicationTemplate || is _Just courseApplicationsInstructions
<div .allocation-course__instructions-label .allocation__label> <div .allocation-course__instructions-label .allocation__label>
_{MsgCourseApplicationInstructionsApplication} _{MsgCourseApplicationInstructionsApplication}