fix(tutorial): fix exam occurrence form
works better, but still not 100% some debugging added
This commit is contained in:
parent
11bcef67f8
commit
6cc929e377
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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{..}])
|
||||
|
||||
@ -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
|
||||
|
||||
12
src/Utils.hs
12
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
|
||||
|
||||
@ -18,7 +18,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<section>
|
||||
^{participantTable}
|
||||
<section>
|
||||
<h2 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
|
||||
$# <h2 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
|
||||
<h2>
|
||||
_{MsgExamFormOccurrences}
|
||||
<div>
|
||||
<p>
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user