diff --git a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg index 43e4bf4ed..6d8938f9c 100644 --- a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg +++ b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg @@ -43,12 +43,13 @@ ExamFormMode: Ausgestaltung der Prüfung ExamFormGrades: Prüfungsleistungen ExamStart: Beginn ExamEnd: Ende -ExamTimeTip: Nur zur Information der Studierenden, die tatsächliche Zeitangabe erfolgt pro Prüfungstermin/Raum +ExamTimeTip: Nur zur Information, die tatsächliche Zeitangabe erfolgt pro Prüfungstermin/Raum. +ExamTimeFilterTip: In der Kursansicht für Kursverwaltende wird diese Zeit zur Filterung verwendet. ExamVisibleFrom: Sichtbar ab ExamVisibleFromTip: Ohne Datum nie sichtbar und keine Anmeldung möglich ExamRegisterFrom: Anmeldung ab ExamRegisterTo: Anmeldung bis -ExamRegisterFromTip: Zeitpunkt ab dem sich Kursartteilnehmer:innen selbständig zur Prüfung anmelden können; ohne Datum ist keine Anmeldung möglich +ExamRegisterFromTip: Zeitpunkt ab dem sich Kursartteilnehmer:innen selbständig zur Prüfung anmelden können; ohne Datum ist keine selbständige Anmeldung möglich ExamDeregisterUntil: Abmeldung bis ExamPublishOccurrenceAssignments: Termin- bzw. Raumzuteilung den Teilnehmer:innen mitteilen um ExamPublishOccurrenceAssignmentsTip: Ab diesem Zeitpunkt können Teilnehmer:innen einsehen zu welcher Teilprüfung bzw. welchen Raum sie angemeldet sind diff --git a/messages/uniworx/categories/courses/exam/exam/en-eu.msg b/messages/uniworx/categories/courses/exam/exam/en-eu.msg index 773d9bd47..907aeac4e 100644 --- a/messages/uniworx/categories/courses/exam/exam/en-eu.msg +++ b/messages/uniworx/categories/courses/exam/exam/en-eu.msg @@ -43,12 +43,13 @@ ExamFormMode: Exam design ExamFormGrades: Exam achievements ExamStart: Start ExamEnd: End -ExamTimeTip: Only for informational purposes. The actual times are set for each occurrence/room +ExamTimeTip: Only for informational purposes. The actual times are set for each occurrence/room. +ExamTimeFilterTip: Also used for Filtering in the course administrator course view. ExamVisibleFrom: Visible from ExamVisibleFromTip: If left empty the exam is never visible and course type participants may not register. ExamRegisterFrom: Register from ExamRegisterTo: Register to -ExamRegisterFromTip: Start of the period in which course type participants may register themselves for the exam. If left empty participants are never allowed to register. +ExamRegisterFromTip: Start of the period in which course type participants may register themselves for the exam. If left empty participants are never allowed to register themselves. ExamDeregisterUntil: Deregister until ExamPublishOccurrenceAssignments: Publish occurrence/room-assignments ExamPublishOccurrenceAssignmentsTip: At this time participants can find out to which occurrence/room they are assigned diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index a447f4870..64bbcad6f 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -129,15 +129,15 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do <$> areq ciField (fslpI MsgTableExamName (mr MsgTableExamName) & setTooltip MsgExamNameTip) (efName <$> template) <*> aopt htmlField (fslI MsgExamDescription) (efDescription <$> template) <* aformSection MsgExamFormTimes - <*> aopt utcTimeField (fslpI MsgExamStart (mr MsgDate) & setTooltip MsgExamTimeTip) (efStart <$> template) - <*> aopt utcTimeField (fslpI MsgExamEnd (mr MsgDate) & setTooltip MsgExamTimeTip) (efEnd <$> template) - <*> aopt utcTimeField (fslpI MsgExamVisibleFrom (mr MsgDate) & setTooltip MsgExamVisibleFromTip) (efVisibleFrom <$> template) - <*> aopt utcTimeField (fslpI MsgExamRegisterFrom (mr MsgDate) & setTooltip MsgExamRegisterFromTip) (efRegisterFrom <$> template) - <*> aopt utcTimeField (fslpI MsgExamRegisterTo (mr MsgDate)) (efRegisterTo <$> template) + <*> aopt utcTimeField (fslpI MsgExamStart (mr MsgDate) & setTooltip (someMessages [MsgExamTimeTip,MsgExamTimeFilterTip])) (efStart <$> template) + <*> aopt utcTimeField (fslpI MsgExamEnd (mr MsgDate) & setTooltip (someMessages [MsgExamTimeTip,MsgExamTimeFilterTip])) (efEnd <$> template) + <*> aopt utcTimeField (fslpI MsgExamVisibleFrom (mr MsgDate) & setTooltip MsgExamVisibleFromTip ) (efVisibleFrom <$> template) + <*> aopt utcTimeField (fslpI MsgExamRegisterFrom (mr MsgDate) & setTooltip MsgExamRegisterFromTip) (efRegisterFrom <$> template) + <*> aopt utcTimeField (fslpI MsgExamRegisterTo (mr MsgDate)) (efRegisterTo <$> template) <*> aopt utcTimeField (fslpI MsgExamDeregisterUntil (mr MsgDate)) (efDeregisterUntil <$> template) <*> aopt utcTimeField (fslpI MsgExamPublishOccurrenceAssignments (mr MsgDate) & setTooltip MsgExamPublishOccurrenceAssignmentsTip) (efPublishOccurrenceAssignments <$> template) <*> aopt utcTimeField (fslpI MsgExamPartsFrom (mr MsgDate) & setTooltip MsgExamPartsFromTip) (efPartsFrom <$> template) - <*> aopt utcTimeField (fslpI MsgExamFinished (mr MsgDate) & setTooltip (bool MsgExamFinishedTip MsgExamFinishedTipCloseOnFinished $ is _ExamCloseOnFinished' schoolExamCloseMode)) (efFinished <$> template) + <*> aopt utcTimeField (fslpI MsgExamFinished (mr MsgDate) & setTooltip (bool MsgExamFinishedTip MsgExamFinishedTipCloseOnFinished $ is _ExamCloseOnFinished' schoolExamCloseMode)) (efFinished <$> template) <* aformSection MsgExamFormOccurrences <*> examOccurrenceMultiForm (efOccurrences <$> template) <* aformSection MsgExamFormAutomaticFunctions diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs index 58cda967a..c9b6c22fc 100644 --- a/src/Handler/Tutorial/Users.hs +++ b/src/Handler/Tutorial/Users.hs @@ -54,8 +54,8 @@ mkExamOccurrenceForm exs eom = renderAForm FormStandard maa let (cuEoIds, eos) = munzip $ Map.lookup eId eid2eos in (,,) <$ for_ eDescr (aformInfoWidget . toWgt) - <*> areq hiddenField "" (Just cueId) - <*> areq (mkSetField hiddenField) "" cuEoIds + <*> apreq hiddenField "" (Just cueId) + <*> apreq (mkSetField hiddenField) "" cuEoIds <*> examOccurrenceMultiForm eos ) @@ -127,7 +127,7 @@ postTUsersR tid ssh csh tutn = do qualOptions = qualificationsOptionList qualifications lessons = occurringLessons trm $ tutEnt ^. _entityVal . _tutorialTime . _Wrapped' timespan = lessonTimesSpan lessons - exOccs <- flip foldMapM timespan $ getDayExamOccurrences True ssh $ Just cid + exOccs <- flip foldMapM timespan $ getDayExamOccurrences False ssh $ Just cid let acts :: Map TutorialUserAction (AForm Handler TutorialUserActionData) acts = Map.fromList $ @@ -221,8 +221,9 @@ postTUsersR tid ssh csh tutn = do Just act -> act -- execute action and return produced content Nothing -> do -- no table action, continue normally let (fmap (toMidnight . succ) -> tbegin, fmap toMidnight -> tend) = munzip timespan + $logInfoS "ExamOccurrenceForm" [st|Exam from #{tshow tbegin} until #{tshow tend}.|] (openExams, tutors) <- runDBRead $ (,) - <$> selectList ([ExamCourse ==. cid, ExamStart <=. tbegin] ++ ([ExamEnd >=. tend] ||. [ExamEnd ==. Nothing])) [Asc ExamName] + <$> selectList ([ExamCourse ==. cid, ExamStart <=. tend] ++ ([ExamEnd >=. tbegin] ||. [ExamEnd ==. Nothing])) [Asc ExamName] <*> E.select (do (tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User `E.on` (\(tutor :& user) -> tutor E.^. TutorUser E.==. user E.^. UserId) @@ -236,7 +237,7 @@ postTUsersR tid ssh csh tutn = do in return $(i18nWidgetFile "exam-missing") else do openExamsUUIDs <- forM openExams $ \ent@Entity{entityKey=k} -> (ent,) <$> encrypt k - ((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm FIDGeneralTutorialAction $ mkExamOccurrenceForm openExamsUUIDs exOccs -- TODO + ((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm FIDGeneralTutorialAction $ mkExamOccurrenceForm openExamsUUIDs exOccs -- TODO also TODO: occurrence name auto generation let gtaAnchor = "general-tutorial-action-form" :: Text gtaRoute = croute :#: gtaAnchor gtaForm = wrapForm gtaWgt FormSettings @@ -247,10 +248,12 @@ postTUsersR tid ssh csh tutn = do , formSubmit = FormSubmit , formAnchor = Just gtaAnchor } + $logInfoS "ExamOccurrenceEdit" $ tshow (Set.map (eofName &&& eofId) . trd3 <$> gtaRes) formResult gtaRes $ \(cEId, cEOIds, occs) -> do -- (CryptoUUIDExam, Set CryptoUUIDExamOccurrence, Set ExamOccurrenceForm) let ceoidsDelete = cEOIds `Set.difference` setMapMaybe eofId occs eId <- decrypt cEId eoIdsDelete <- mapM decrypt $ Set.toList ceoidsDelete + $logInfoS "ExamOccurrenceEdit" [st|Exam-Edit: #{length cEOIds} old occurrences, #{length eoIdsDelete} to delete, #{length $ Set.filter (isNothing . eofId) occs} to insert, #{length $ Set.filter (isJust . eofId) occs} to edit|] runDB do deleteWhere [ExamOccurrenceExam ==. eId, ExamOccurrenceId <-. eoIdsDelete] upsertExamOccurrences eId $ Set.toList occs diff --git a/src/Handler/Utils/Course/Cache.hs b/src/Handler/Utils/Course/Cache.hs index 40fce11b1..fb1c97abb 100644 --- a/src/Handler/Utils/Course/Cache.hs +++ b/src/Handler/Utils/Course/Cache.hs @@ -147,12 +147,13 @@ getDayExamOccurrences onlyOpen ssh mbcid dlimit@(dstart, dend) `E.innerJoin` E.table @Exam `E.on` (\(crs :& exm) -> crs E.^. CourseId E.==. exm E.^. ExamCourse) `E.innerJoin` E.table @ExamOccurrence `E.on` (\(_ :& exm :& occ) -> exm E.^. ExamId E.==. occ E.^. ExamOccurrenceExam) E.where_ $ E.and $ catMaybes - [ toMaybe onlyOpen $ E.justVal now E.>=. exm E.^. ExamStart -- fail on null - E.&&. E.val now E.<~. exm E.^. ExamEnd -- success on null + [ toMaybe onlyOpen $ E.justVal now E.>=. exm E.^. ExamRegisterFrom -- fail on null + E.&&. E.val now E.<~. exm E.^. ExamRegisterTo -- success on null , mbcid <&> ((E.==. (crs E.^. CourseId)) . E.val) , Just $ crs E.^. CourseSchool E.==. E.val ssh , Just $ E.withinPeriod dlimit (occ E.^. ExamOccurrenceStart) (occ E.^. ExamOccurrenceEnd) ] + -- E.orderBy [E.asc $ exm E.^. ExamName] -- we return a map, so the order does not matter return (occ, exm E.^. ExamId, exm E.^. ExamName) -- No Binary instance for Entity Exam, so we only extract what is needed for now foldMapM mkOccMap candidates where @@ -160,7 +161,7 @@ getDayExamOccurrences onlyOpen ssh mbcid dlimit@(dstart, dend) mkOccMap (Entity{..}, E.Value eId, E.Value eName) = encrypt entityKey <&> (\ceoId -> Map.singleton entityKey (entityVal, ceoId, (eId, eName))) mkExamOccurrenceOptions :: ExamOccurrenceMap -> OptionList ExamOccurrenceId -mkExamOccurrenceOptions = mkOptionListGrouped . groupSort . map mkEOOption . Map.toList +mkExamOccurrenceOptions = mkOptionListGrouped . map (over _2 $ sortBy (compare `on` optionDisplay)) . groupSort . map mkEOOption . Map.toList where mkEOOption :: (ExamOccurrenceId, (ExamOccurrence, CryptoUUIDExamOccurrence, (ExamId, ExamName))) -> (Text, [Option ExamOccurrenceId]) mkEOOption (eid, (ExamOccurrence{examOccurrenceName}, ceoId, (_,eName))) = (ciOriginal eName, [Option{..}]) diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs index 58beaf373..f8261636c 100644 --- a/src/Handler/Utils/DateTime.hs +++ b/src/Handler/Utils/DateTime.hs @@ -118,7 +118,7 @@ formatTimeW :: (HasLocalTime t, YesodAuthPersist UniWorX, AuthEntity UniWorX ~ U formatTimeW s t = toWidget =<< formatTime s t formatTimeMail :: (MonadMail m, HasLocalTime t) => SelDateTimeFormat -> t -> m Text -formatTimeMail sel t = fmap fromString $ Time.formatTime <$> (getTimeLocale' . view _Wrapped <$> askMailLanguages) <*> (unDateTimeFormat <$> askMailDateTimeFormat sel) <*> pure (toLocalTime t) +formatTimeMail sel t = fmap fromString $ (Time.formatTime . getTimeLocale' . view _Wrapped <$> askMailLanguages) <*> (unDateTimeFormat <$> askMailDateTimeFormat sel) <*> pure (toLocalTime t) getTimeLocale :: MonadHandler m => m TimeLocale getTimeLocale = getTimeLocale' <$> languages diff --git a/src/Utils.hs b/src/Utils.hs index 514c174a2..a1044b82d 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -783,6 +783,18 @@ adjustAssoc upd key = aux groupSort :: (Ord k, Semigroup v) => [(k,v)] -> [(k,v)] groupSort = Map.toAscList . Map.fromListWith (<>) +-- -- Like groupSort, but also sort the +-- groupSortSorted :: (Ord k, Ord v, Semigroup v) => [(k,[v])] -> [(k,[v])] +-- groupSortSorted = Map.toAscList . Map.fromListWith merge + +-- -- Merge to sorted list to a single sorted list. Precondition is not checked, but element will not be lost. +-- merge :: Ord a => [a] -> [a] -> [a] +-- merge [] ys = ys +-- merge xs [] = xs +-- merge xs@(x:xt) ys@(y:yt) +-- | x<=y = x : merge xt ys +-- | otherwise = y : merge xs yt + -- | Copied form Util from package ghc partitionWith :: (a -> Either b c) -> [a] -> ([b], [c]) -- ^ Uses a function to determine which of two output lists an input element should join diff --git a/templates/tutorial-participants.hamlet b/templates/tutorial-participants.hamlet index c5929e969..bef9804b9 100644 --- a/templates/tutorial-participants.hamlet +++ b/templates/tutorial-participants.hamlet @@ -18,7 +18,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
^{participantTable}
-

+$#

+

_{MsgExamFormOccurrences}

diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 5d2f571b5..cd621e641 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -1235,12 +1235,12 @@ fillDb = do , examOccurrenceRule = ExamRoomManual , examExamOccurrenceMapping = Nothing , examPublishOccurrenceAssignments = Nothing - , examVisibleFrom = jtt TermDayLectureStart 0 Nothing toMidnight - , examRegisterFrom = jtt TermDayLectureStart 0 Nothing toMidnight - , examRegisterTo = jtt TermDayLectureStart 14 Nothing toMidnight - , examDeregisterUntil = jtt TermDayLectureStart 21 Nothing toMidnight - , examStart = jtt TermDayLectureStart 27 Nothing $ toTimeOfDay 16 0 0 - , examEnd = jtt TermDayLectureStart 32 Nothing $ toTimeOfDay 16 30 0 + , examVisibleFrom = jtt TermDayLectureStart 0 Nothing toMidnight + , examRegisterFrom = jtt TermDayLectureStart 0 Nothing toMidnight + , examRegisterTo = jtt TermDayLectureStart 14 Nothing toMidnight + , examDeregisterUntil = jtt TermDayLectureStart 21 Nothing toMidnight + , examStart = jtt TermDayLectureStart 0 Nothing $ toTimeOfDay 10 0 0 + , examEnd = jtt TermDayLectureStart 128 Nothing $ toTimeOfDay 16 30 0 , examFinished = Nothing , examPartsFrom = Nothing , examClosed = Nothing