fix(allocations): fix allocation-course-accept-substitutes
This commit is contained in:
Gregor Kleen
parent
46fda62709
commit
b4df980699
@ -262,7 +262,9 @@ CourseApplicationsAllocatedDirectory: zentral
|
||||
CourseApplicationsNotAllocatedDirectory: direkt
|
||||
|
||||
CourseNoAllocationsAvailable: Es sind aktuell keine Zentralanmeldungen verfügbar
|
||||
AllocationStaffRegisterToExpired: Es dürfen keine Änderungen an der Eintragung des Kurses zur Zentralanmeldung mehr vorgenommen werden. Ihre Änderungen wurden ignoriert.
|
||||
AllocationStaffRegisterToExpiredAllocation: Die Frist zur Eintrageng von Kursen in die Zentralanmeldung ist verstrichen. Die Teilnahme darf nicht mehr verändert werden.
|
||||
AllocationStaffRegisterToExpiredMinCapacity: Die Frist zur Eintrageng von Kursen in die Zentralanmeldung ist verstrichen. Die minimale Kapazität darf nicht mehr verändert werden.
|
||||
|
||||
|
||||
|
||||
CourseFormSectionRegistration: Anmeldung zum Kurs
|
||||
|
||||
@ -262,7 +262,8 @@ CourseApplicationsAllocatedDirectory: central
|
||||
CourseApplicationsNotAllocatedDirectory: direct
|
||||
|
||||
CourseNoAllocationsAvailable: There are no ongoing central allocations
|
||||
AllocationStaffRegisterToExpired: You cannot change course properties concerning the central allocation after the course registration period. Your changes may have been discarded.
|
||||
AllocationStaffRegisterToExpiredAllocation: The course registration period for the central allocation is over. Participation may not be changed.
|
||||
AllocationStaffRegisterToExpiredMinCapacity: The course registration period for the central allocation is over. Minimum capacity may not be changed.
|
||||
|
||||
CourseFormSectionRegistration: Registration
|
||||
CourseFormSectionAdministration: Administration
|
||||
|
||||
@ -61,6 +61,9 @@ data AllocationCourseForm = AllocationCourseForm
|
||||
, acfDeregisterNoShow :: Bool
|
||||
}
|
||||
|
||||
makeLenses_ ''CourseForm
|
||||
makeLenses_ ''AllocationCourseForm
|
||||
|
||||
courseToForm :: Entity Course -> [Lecturer] -> Map UserEmail (InvitationDBData Lecturer) -> Maybe (Entity AllocationCourse) -> CourseForm
|
||||
courseToForm cEnt@(Entity cid Course{..}) lecs lecInvites alloc = CourseForm
|
||||
{ cfCourseId = Just cid
|
||||
@ -326,20 +329,28 @@ validateCourse = do
|
||||
now <- liftIO getCurrentTime
|
||||
uid <- liftHandler requireAuthId
|
||||
userAdmin <- hasWriteAccessTo $ SchoolR cfSchool SchoolEditR
|
||||
allocationTerm <- for (acfAllocation <$> cfAllocation) $ lift . fmap allocationTerm . getJust
|
||||
newAllocationTerm <- for (acfAllocation <$> cfAllocation) $ lift . fmap allocationTerm . getJust
|
||||
|
||||
oldAllocatedCapacity <- fmap join . for cfCourseId $ \cid -> lift $ do
|
||||
prevAllocationCourse <- getBy $ UniqueAllocationCourse cid
|
||||
prevAllocation <- fmap join . traverse get $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
|
||||
prevAllocationCourse <- join <$> traverse (lift . getBy . UniqueAllocationCourse) cfCourseId
|
||||
prevAllocation <- fmap join . traverse (lift . getEntity) $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
|
||||
|
||||
fmap join . for prevAllocation $ \Allocation{allocationStaffAllocationTo, allocationRegisterByCourse} -> if
|
||||
| userAdmin
|
||||
-> return Nothing
|
||||
| NTop allocationStaffAllocationTo <= NTop (Just now)
|
||||
, NTop allocationRegisterByCourse > NTop (Just now)
|
||||
-> Just . courseCapacity <$> getJust cid
|
||||
| otherwise
|
||||
-> return Nothing
|
||||
oldAllocatedCapacity <- if
|
||||
| Just (Entity _ Allocation{..}) <- prevAllocation
|
||||
, Just (Entity _ AllocationCourse{..}) <- prevAllocationCourse
|
||||
, NTop allocationStaffAllocationTo <= NTop (Just now)
|
||||
, NTop allocationRegisterByCourse > NTop (Just now)
|
||||
-> lift $ Just . courseCapacity <$> getJust allocationCourseCourse
|
||||
| otherwise
|
||||
-> return Nothing
|
||||
let oldAllocation = do
|
||||
Entity allocId Allocation{..} <- prevAllocation
|
||||
guard $ NTop (Just now) > NTop allocationStaffRegisterTo
|
||||
pure $ Just allocId
|
||||
oldAllocatedMinCapacity = do
|
||||
Entity _ Allocation{..} <- prevAllocation
|
||||
Entity _ AllocationCourse{..} <- prevAllocationCourse
|
||||
guard $ NTop (Just now) > NTop allocationStaffRegisterTo
|
||||
pure $ Just allocationCourseMinCapacity
|
||||
|
||||
guardValidation MsgCourseVisibilityEndMustBeAfterStart
|
||||
$ NTop cfVisFrom <= NTop cfVisTo
|
||||
@ -347,15 +358,19 @@ validateCourse = do
|
||||
$ NTop cfRegFrom <= NTop cfRegTo
|
||||
guardValidation MsgCourseDeregistrationEndMustBeAfterStart
|
||||
$ Just False /= ((<=) <$> cfRegFrom <*> cfDeRegUntil)
|
||||
unless userAdmin $
|
||||
guardValidation MsgCourseUserMustBeLecturer
|
||||
$ anyOf (traverse . _Right . _1) (== uid) cfLecturers
|
||||
guardValidation MsgCourseAllocationRequiresCapacity
|
||||
$ is _Nothing cfAllocation || is _Just cfCapacity
|
||||
guardValidation MsgCourseAllocationTermMustMatch
|
||||
$ maybe True (== cfTerm) allocationTerm
|
||||
guardValidation MsgCourseAllocationCapacityMayNotBeChanged
|
||||
$ maybe True (== cfCapacity) oldAllocatedCapacity
|
||||
$ maybe True (== cfTerm) newAllocationTerm
|
||||
unless userAdmin $ do
|
||||
guardValidation MsgCourseUserMustBeLecturer
|
||||
$ anyOf (traverse . _Right . _1) (== uid) cfLecturers
|
||||
guardValidation MsgCourseAllocationCapacityMayNotBeChanged
|
||||
$ maybe True (== cfCapacity) oldAllocatedCapacity
|
||||
guardValidation MsgAllocationStaffRegisterToExpiredAllocation
|
||||
$ maybe True (== fmap acfAllocation cfAllocation) oldAllocation
|
||||
guardValidation MsgAllocationStaffRegisterToExpiredMinCapacity
|
||||
$ maybe True (== fmap acfMinCapacity cfAllocation) oldAllocatedMinCapacity
|
||||
|
||||
warnValidation MsgCourseShorthandTooLong
|
||||
$ length (CI.original cfShort) <= 10
|
||||
@ -567,48 +582,23 @@ courseEditHandler miButtonAction mbCourseForm = do
|
||||
}
|
||||
|
||||
upsertAllocationCourse :: CourseId -> Maybe AllocationCourseForm -> YesodJobDB UniWorX ()
|
||||
upsertAllocationCourse cid cfAllocation = do
|
||||
now <- liftIO getCurrentTime
|
||||
Course{} <- getJust cid
|
||||
prevAllocationCourse <- getBy $ UniqueAllocationCourse cid
|
||||
prevAllocation <- fmap join . traverse getEntity $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
|
||||
userAdmin <- fromMaybe False <$> for prevAllocation (\(Entity _ Allocation{..}) -> hasWriteAccessTo $ SchoolR allocationSchool SchoolEditR)
|
||||
upsertAllocationCourse cid = \case
|
||||
Just AllocationCourseForm{..} -> do
|
||||
prevAllocationCourse <- getBy $ UniqueAllocationCourse cid
|
||||
|
||||
doEdit <- if
|
||||
| userAdmin
|
||||
-> return True
|
||||
| Just (Entity _ Allocation{allocationStaffRegisterTo}) <- prevAllocation
|
||||
, NTop allocationStaffRegisterTo <= NTop (Just now)
|
||||
-> let anyChanges
|
||||
| Just AllocationCourseForm{..} <- cfAllocation
|
||||
, Just (Entity _ AllocationCourse{..}) <- prevAllocationCourse
|
||||
= or [ acfAllocation /= allocationCourseAllocation
|
||||
, acfMinCapacity /= allocationCourseMinCapacity
|
||||
]
|
||||
| otherwise
|
||||
= True
|
||||
in False <$ when anyChanges (addMessageI Error MsgAllocationStaffRegisterToExpired)
|
||||
| otherwise
|
||||
-> return True
|
||||
void $ upsert AllocationCourse
|
||||
{ allocationCourseAllocation = acfAllocation
|
||||
, allocationCourseCourse = cid
|
||||
, allocationCourseMinCapacity = acfMinCapacity
|
||||
, allocationCourseAcceptSubstitutes = acfAcceptSubstitutes
|
||||
}
|
||||
[ AllocationCourseAllocation =. acfAllocation
|
||||
, AllocationCourseCourse =. cid
|
||||
, AllocationCourseMinCapacity =. acfMinCapacity
|
||||
, AllocationCourseAcceptSubstitutes =. acfAcceptSubstitutes
|
||||
]
|
||||
|
||||
when doEdit $
|
||||
case cfAllocation of
|
||||
Just AllocationCourseForm{..} -> do
|
||||
void $ upsert AllocationCourse
|
||||
{ allocationCourseAllocation = acfAllocation
|
||||
, allocationCourseCourse = cid
|
||||
, allocationCourseMinCapacity = acfMinCapacity
|
||||
, allocationCourseAcceptSubstitutes = acfAcceptSubstitutes
|
||||
}
|
||||
[ AllocationCourseAllocation =. acfAllocation
|
||||
, AllocationCourseCourse =. cid
|
||||
, AllocationCourseMinCapacity =. acfMinCapacity
|
||||
, AllocationCourseAcceptSubstitutes =. acfAcceptSubstitutes
|
||||
]
|
||||
|
||||
when (Just acfAllocation /= fmap entityKey prevAllocation) $
|
||||
queueDBJob . JobQueueNotification $ NotificationAllocationNewCourse acfAllocation cid
|
||||
Nothing
|
||||
| Just (Entity prevId _) <- prevAllocationCourse
|
||||
-> delete prevId
|
||||
_other -> return ()
|
||||
when (Just acfAllocation /= fmap (allocationCourseAllocation . entityVal) prevAllocationCourse) $
|
||||
queueDBJob . JobQueueNotification $ NotificationAllocationNewCourse acfAllocation cid
|
||||
Nothing ->
|
||||
deleteWhere [ AllocationCourseCourse ==. cid ]
|
||||
|
||||
@ -29,15 +29,16 @@ makePrisms ''ChangelogItemKind
|
||||
|
||||
classifyChangelogItem :: ChangelogItem -> ChangelogItemKind
|
||||
classifyChangelogItem = \case
|
||||
ChangelogHaskellCampusLogin -> ChangelogItemBugfix
|
||||
ChangelogTooltipsWithoutJavascript -> ChangelogItemBugfix
|
||||
ChangelogButtonsWorkWithoutJavascript -> ChangelogItemBugfix
|
||||
ChangelogTableFormsWorkAfterAjax -> ChangelogItemBugfix
|
||||
ChangelogPassingByPointsWorks -> ChangelogItemBugfix
|
||||
ChangelogErrorMessagesForTableItemVanish -> ChangelogItemBugfix
|
||||
ChangelogExamAchievementParticipantDuplication -> ChangelogItemBugfix
|
||||
ChangelogFormsTimesReset -> ChangelogItemBugfix
|
||||
_other -> ChangelogItemFeature
|
||||
ChangelogHaskellCampusLogin -> ChangelogItemBugfix
|
||||
ChangelogTooltipsWithoutJavascript -> ChangelogItemBugfix
|
||||
ChangelogButtonsWorkWithoutJavascript -> ChangelogItemBugfix
|
||||
ChangelogTableFormsWorkAfterAjax -> ChangelogItemBugfix
|
||||
ChangelogPassingByPointsWorks -> ChangelogItemBugfix
|
||||
ChangelogErrorMessagesForTableItemVanish -> ChangelogItemBugfix
|
||||
ChangelogExamAchievementParticipantDuplication -> ChangelogItemBugfix
|
||||
ChangelogFormsTimesReset -> ChangelogItemBugfix
|
||||
ChangelogAllocationCourseAcceptSubstitutesFixed -> ChangelogItemBugfix
|
||||
_other -> ChangelogItemFeature
|
||||
|
||||
changelogItemDays :: Map ChangelogItem Day
|
||||
changelogItemDays = Map.fromListWithKey (\k d1 d2 -> bool (error $ "Duplicate changelog days for " <> show k) d1 $ d1 /= d2)
|
||||
|
||||
@ -0,0 +1,2 @@
|
||||
$newline never
|
||||
Das Eintragen von Fristen bis zu denen Nachrücker aus Zentralanmeldungen akzeptiert werden ist nun möglich
|
||||
@ -0,0 +1,2 @@
|
||||
$newline never
|
||||
It is now possible to specify deadlines up to which substitute registrations from central allocations are accepted
|
||||
Loading…
Reference in New Issue
Block a user