diff --git a/messages/uniworx/misc/de-de-formal.msg b/messages/uniworx/misc/de-de-formal.msg index b34955a0b..68be69df4 100644 --- a/messages/uniworx/misc/de-de-formal.msg +++ b/messages/uniworx/misc/de-de-formal.msg @@ -2849,7 +2849,7 @@ InfoLecturerTutorials: Tutorien InfoLecturerExams: Prüfungen InfoLecturerAllocations: Zentralanmeldungen -ParticipantsIntersectCourseOption tid@TermId ssh@SchoolId coursen@CourseName: #{tid} - #{ssh} - #{coursen} +ParticipantsIntersectCourseOption tid@TermId ssh@SchoolId csh@CourseShorthand coursen@CourseName: #{tid} - #{ssh} - #{csh}: #{coursen} ParticipantsIntersectCourses: Kurse AllocationUsersTitle tid@TermId ssh@SchoolId ash@AllocationShorthand: #{tid}-#{ssh}-#{ash}: Bewerber @@ -2941,7 +2941,7 @@ AllocationUsersCount: Teilnehmer AllocationCoursesCount: Kurse AllocationCourseEligible: Berücksichtigt -CourseOption tid@TermId ssh@SchoolId coursen@CourseName: #{tid} - #{ssh} - #{coursen} +CourseOption tid@TermId ssh@SchoolId csh@CourseShorthand coursen@CourseName: #{tid} - #{ssh} - #{csh}: #{coursen} BearerTokenUsageWarning: Mit diesem Interface können quesi beliebige Rechte als Tokens kodiert und somit ohne wesentliche weitere Beschränkung frei übertragen werden. Benutzen Sie dieses Interface nur, wenn Sie von einem erfahrenen Entwickler über die Auswirkungen des konkreten Tokens, dass sie ausstellen möchten, beraten wurden! BearerTokenAuthorityGroups: Token-Authorität (Gruppen) diff --git a/messages/uniworx/misc/en-eu.msg b/messages/uniworx/misc/en-eu.msg index a7a607e59..3e201a5fa 100644 --- a/messages/uniworx/misc/en-eu.msg +++ b/messages/uniworx/misc/en-eu.msg @@ -2849,7 +2849,7 @@ InfoLecturerTutorials: Tutorials InfoLecturerExams: Exams InfoLecturerAllocations: Central allocations -ParticipantsIntersectCourseOption tid@TermId ssh@SchoolId coursen@CourseName: #{tid} - #{ssh} - #{coursen} +ParticipantsIntersectCourseOption tid ssh csh coursen: #{tid} - #{ssh} - #{csh}: #{coursen} ParticipantsIntersectCourses: Courses AllocationUsersTitle tid ssh ash: #{tid}-#{ssh}-#{ash}: Applicants @@ -2941,7 +2941,7 @@ AllocationUsersCount: Participants AllocationCoursesCount: Courses AllocationCourseEligible: Considered -CourseOption tid ssh coursen: #{tid} - #{ssh} - #{coursen} +CourseOption tid ssh csh coursen: #{tid} - #{ssh} - #{csh}: #{coursen} BearerTokenUsageWarning: Using this interface you are able to encode essentially arbitrary permissions inte bearer tokens. This allows you to freely hand permissions off arbitrarily and without relevant restrictions. Only use this interface if you have discussed the consequences of the specific token, that you want to issue, with an experienced developer! BearerTokenAuthorityGroups: Authority (groups) diff --git a/src/Handler/Participants.hs b/src/Handler/Participants.hs index e04cf9496..569d8ea46 100644 --- a/src/Handler/Participants.hs +++ b/src/Handler/Participants.hs @@ -96,23 +96,21 @@ postParticipantsIntersectR = do } intersectionsRes <- formResultMaybe coursesRes . fmap (fmap Just) $ \cids -> runDB $ do - let coursePairs = do - cid <- Set.toList cids - other <- Set.toList . snd $ Set.split cid cids - return (cid, other) - intersections <- fmap Map.fromList . forM coursePairs $ \cidPair@(lCid, uCid) -> fmap (\[E.Value n] -> (cidPair, n)) . E.select . E.from $ \user -> do - E.where_ . E.exists . E.from $ \courseParticipant -> - E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId - E.&&. courseParticipant E.^. CourseParticipantCourse E.==. E.val lCid - E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive - E.where_ . E.exists . E.from $ \courseParticipant -> - E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId - E.&&. courseParticipant E.^. CourseParticipantCourse E.==. E.val uCid - E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive - return E.countRows :: E.SqlQuery (E.SqlExpr (E.Value Int)) - selfIntersections <- fmap Map.fromList . forM (Set.toList cids) $ \cid -> ((cid, cid), ) <$> count [CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantActive] - let intersections' = Map.union intersections selfIntersections + courseUsers <- flip mapFromSetM cids $ \cid -> fmap (Set.fromList . map E.unValue) . E.select . E.from $ \participant -> do + E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid + E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive + return $ participant E.^. CourseParticipantUser courses <- sortOn (view $ _entityVal . $(multifocusL 3) _courseTerm _courseSchool _courseShorthand) <$> forM (Set.toList cids) getEntity404 + + let coursePairs = Set.fromAscList $ do + cid <- Set.toAscList cids + other <- Set.toAscList . snd $ Set.split cid cids + return (cid, other) + intersections = flip Map.fromSet coursePairs $ \(lCid, uCid) + -> Set.size $ Map.findWithDefault Set.empty lCid courseUsers `Set.intersection` Map.findWithDefault Set.empty uCid courseUsers + selfIntersections = Map.mapKeysMonotonic (\cid -> (cid, cid)) $ Set.size <$> courseUsers + intersections' = Map.union intersections selfIntersections + return (courses, intersections') let diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 0cbf85785..1e8472019 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -2098,12 +2098,13 @@ courseSelectForm query coursePred miButtonAction' miIdent' fSettings fRequired m course <- query E.orderBy [ E.desc $ course E.^. CourseTerm , E.asc $ course E.^. CourseSchool + , E.asc $ course E.^. CourseShorthand , E.asc $ course E.^. CourseName ] return course miAdd' nudge btn csrf = do - let courseOptions = optionsCryptoIdE query' (\Course{..} -> MsgCourseOption courseTerm courseSchool courseName) >>= fmap (fmap entityKey . mkOptionList) . filterM (coursePred . optionInternalValue) . olOptions + let courseOptions = optionsCryptoIdE query' (\Course{..} -> MsgCourseOption courseTerm courseSchool courseShorthand courseName) >>= fmap (fmap entityKey . mkOptionList) . filterM (coursePred . optionInternalValue) . olOptions (courseRes, addView) <- mpopt (hoistField liftHandler $ selectField courseOptions) (fslI MsgCourse & addName (nudge "course")) Nothing let res = courseRes <&> \newCourse oldCourses -> pure (Set.toList $ Set.singleton newCourse `Set.difference` Set.fromList oldCourses) diff --git a/src/Handler/Workflow/Instance/Form.hs b/src/Handler/Workflow/Instance/Form.hs index 246ac38cf..ffa9c6fa1 100644 --- a/src/Handler/Workflow/Instance/Form.hs +++ b/src/Handler/Workflow/Instance/Form.hs @@ -39,7 +39,7 @@ workflowInstanceScopeForm scopeRestr fs mPrev = multiActionA scopeOptions' fs $ , WSCourse <$> apopt (selectField' Nothing courseOptions) (fslI MsgCourse) (mPrev ^? _Just . _wisCourse) ) ] - where courseOptions = fmap (fmap entityKey) . optionsPersistCryptoId [] [ Desc CourseTerm, Asc CourseSchool, Asc CourseName ] $ \Course{..} -> MsgCourseOption courseTerm courseSchool courseName + where courseOptions = fmap (fmap entityKey) . optionsPersistCryptoId [] [ Desc CourseTerm, Asc CourseSchool, Asc CourseName ] $ \Course{..} -> MsgCourseOption courseTerm courseSchool courseShorthand courseName data WorkflowInstanceForm = WorkflowInstanceForm diff --git a/templates/widgets/massinput/courses/add.hamlet b/templates/widgets/massinput/courses/add.hamlet index 879d67f4f..7103db24a 100644 --- a/templates/widgets/massinput/courses/add.hamlet +++ b/templates/widgets/massinput/courses/add.hamlet @@ -1,5 +1,5 @@ $newline never - + #{csrf} ^{fvWidget addView} diff --git a/templates/widgets/massinput/courses/cell.hamlet b/templates/widgets/massinput/courses/cell.hamlet index 5fd8639ae..ed4d08078 100644 --- a/templates/widgets/massinput/courses/cell.hamlet +++ b/templates/widgets/massinput/courses/cell.hamlet @@ -3,5 +3,7 @@ $newline never #{courseTerm} #{courseSchool} + + #{courseShorthand} #{courseName}