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 0fed00bc4..5f8db47cf 100644 --- a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg +++ b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg @@ -1,4 +1,4 @@ -# SPDX-FileCopyrightText: 2022 Gregor Kleen ,Sarah Vaupel ,Winnie Ros +# SPDX-FileCopyrightText: 2022-25 Gregor Kleen ,Sarah Vaupel ,Winnie Ros ,Steffen Jost # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -35,7 +35,7 @@ ExamEditHeading examn@ExamName: #{examn} bearbeiten ExamNameTip: Muss innerhalb der Veranstaltung eindeutig sein ExamDescription: Beschreibung ExamFormTimes: Zeiten -ExamFormOccurrences: Prüfungstermine/Räume +ExamFormOccurrences: Prüfungstermine / Räume ExamFormAutomaticFunctions: Automatische Funktionen ExamFormCorrection: Korrektur ExamFormParts: Teile diff --git a/messages/uniworx/categories/courses/exam/exam/en-eu.msg b/messages/uniworx/categories/courses/exam/exam/en-eu.msg index 410341091..a469ed20e 100644 --- a/messages/uniworx/categories/courses/exam/exam/en-eu.msg +++ b/messages/uniworx/categories/courses/exam/exam/en-eu.msg @@ -1,4 +1,4 @@ -# SPDX-FileCopyrightText: 2022 Gregor Kleen ,Sarah Vaupel ,Winnie Ros +# SPDX-FileCopyrightText: 2022-25 Gregor Kleen ,Sarah Vaupel ,Winnie Ros ,Steffen Jost # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -35,7 +35,7 @@ ExamEditHeading examn: Edit #{examn} ExamNameTip: Needs to be unique within the course ExamDescription: Description ExamFormTimes: Times -ExamFormOccurrences: Occurrences/rooms +ExamFormOccurrences: Occurrences / Rooms ExamFormAutomaticFunctions: Automatic functions ExamFormCorrection: Correction ExamFormParts: Exam parts diff --git a/messages/uniworx/categories/courses/tutorial/de-de-formal.msg b/messages/uniworx/categories/courses/tutorial/de-de-formal.msg index 4b3d2a2ff..b2d09757d 100644 --- a/messages/uniworx/categories/courses/tutorial/de-de-formal.msg +++ b/messages/uniworx/categories/courses/tutorial/de-de-formal.msg @@ -1,4 +1,4 @@ -# SPDX-FileCopyrightText: 2022-24 Winnie Ros , Steffen Jost +# SPDX-FileCopyrightText: 2022-25 Winnie Ros ,Steffen Jost # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -66,3 +66,4 @@ CheckEyePermitIncompatible: Sehtest und Führerschein passen nicht zusammen GenTutActOccCopyLast: Prüfungstermine von früherem Kurs kopieren GenTutActOccCopyWeek: Prüfungstermine von früherer Woche kopieren GenTutActOccEdit: Relevante Prüfungstermine bearbeiten +GenTutActShowExam: Prüfungsergebnisse der Kursteilnehmer anzeigen \ No newline at end of file diff --git a/messages/uniworx/categories/courses/tutorial/en-eu.msg b/messages/uniworx/categories/courses/tutorial/en-eu.msg index 35440d821..2f7f4818c 100644 --- a/messages/uniworx/categories/courses/tutorial/en-eu.msg +++ b/messages/uniworx/categories/courses/tutorial/en-eu.msg @@ -1,4 +1,4 @@ -# SPDX-FileCopyrightText: 2022-24 Winnie Ros , Steffen Jost +# SPDX-FileCopyrightText: 2022-25 Winnie Ros ,Steffen Jost # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -67,3 +67,4 @@ CheckEyePermitIncompatible: Eye exam and driving permit are incompatible GenTutActOccCopyLast: Copy exam occurrences from previous course GenTutActOccCopyWeek: Copy exam occurrences from course on previous week GenTutActOccEdit: Edit relevant exam occurrences +GenTutActShowExam: Show exam results for course participants \ No newline at end of file diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index cd06ea982..9fbcee489 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -1,8 +1,9 @@ --- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Sarah Vaupel ,Sarah Vaupel ,Steffen Jost ,Winnie Ros +-- SPDX-FileCopyrightText: 2022-25 Gregor Kleen ,Sarah Vaupel ,Sarah Vaupel ,Steffen Jost ,Winnie Ros ,Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE TypeApplications #-} module Handler.Exam.Users ( getEUsersR, postEUsersR @@ -20,6 +21,8 @@ import Handler.Exam.AutoOccurrence (examAutoOccurrenceCalculateWidget) import Handler.ExamOffice.Exam (examCloseWidget, examFinishWidget) +import Database.Esqueleto.Experimental ((:&)(..)) +import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E import Database.Esqueleto.Utils.TH @@ -390,7 +393,7 @@ getEUsersR = postEUsersR postEUsersR tid ssh csh examn = do (((Any computedValues, registrationResult), examUsersTable), Entity eId examVal@Exam{..}, (bonus, resultSheets)) <- runDB $ do exam@(Entity eid examVal@Exam{..}) <- fetchExam tid ssh csh examn - Course{..} <- getJust examCourse + -- Course{..} <- getJust examCourse -- no longer needed somehow occurrences <- selectList [ExamOccurrenceExam ==. eid] [Asc ExamOccurrenceName] examParts <- selectList [ExamPartExam ==. eid] [Asc ExamPartName] bonus <- examRelevantSheets exam True @@ -522,29 +525,37 @@ postEUsersR tid ssh csh examn = do dbtFilter = mconcat [ uncurry singletonMap $ fltrUserNameEmail queryUser , uncurry singletonMap $ fltrUserMatriclenr queryUser - , uncurry singletonMap ("occurrence", FilterColumn . E.mkContainsFilterWith Just $ queryExamOccurrence >>> (E.?. ExamOccurrenceName)) + , singletonMap "occurrence" (FilterColumn . E.mkContainsFilterWith Just $ queryExamOccurrence >>> (E.?. ExamOccurrenceName)) , fltrExamResultPoints (to $ queryExamResult >>> (E.?. ExamResultResult)) - , fltrRelevantStudyFeaturesTerms (to $ - \t -> ( E.val courseTerm - , queryUser t E.^. UserId - )) - , fltrRelevantStudyFeaturesDegree (to $ - \t -> ( E.val courseTerm - , queryUser t E.^. UserId - )) - , fltrRelevantStudyFeaturesSemester (to $ - \t -> ( E.val courseTerm - , queryUser t E.^. UserId - )) + -- , fltrRelevantStudyFeaturesTerms (to $ + -- \t -> ( E.val courseTerm + -- , queryUser t E.^. UserId + -- )) + -- , fltrRelevantStudyFeaturesDegree (to $ + -- \t -> ( E.val courseTerm + -- , queryUser t E.^. UserId + -- )) + -- , fltrRelevantStudyFeaturesSemester (to $ + -- \t -> ( E.val courseTerm + -- , queryUser t E.^. UserId + -- )) + , singletonMap "tutorial" $ FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do + (tut :& usrTut) <- Ex.from $ Ex.table @Tutorial + `Ex.innerJoin` Ex.table @TutorialParticipant + `Ex.on` (\(tut :& usrTut) -> tut E.^. TutorialId E.==. usrTut E.^. TutorialParticipantTutorial) + Ex.where_ $ usrTut E.^. TutorialParticipantUser E.==. queryUser row E.^. UserId + E.&&. tut E.^. TutorialName `E.hasInfix` E.val (CI.mk criterion) ] - dbtFilterUI mPrev = mconcat $ catMaybes - [ Just $ fltrUserNameEmailUI mPrev - , Just $ fltrUserMatriclenrUI mPrev - , Just $ prismAForm (singletonFilter "occurrence") mPrev $ aopt (selectField' (Just $ SomeMessage MsgExamNoFilter) $ optionsF [CI.original examOccurrenceName | Entity _ ExamOccurrence{..} <- occurrences]) (fslI MsgTableExamOccurrence) - , Just $ fltrExamResultPointsUI mPrev - , Just $ fltrRelevantStudyFeaturesTermsUI mPrev - , Just $ fltrRelevantStudyFeaturesDegreeUI mPrev - , Just $ fltrRelevantStudyFeaturesSemesterUI mPrev + + dbtFilterUI mPrev = mconcat $ + [ fltrUserNameEmailUI mPrev + , fltrUserMatriclenrUI mPrev + , prismAForm (singletonFilter "occurrence") mPrev $ aopt (selectField' (Just $ SomeMessage MsgExamNoFilter) $ optionsF [CI.original examOccurrenceName | Entity _ ExamOccurrence{..} <- occurrences]) (fslI MsgTableExamOccurrence) + , fltrExamResultPointsUI mPrev + -- , fltrRelevantStudyFeaturesTermsUI mPrev + -- , fltrRelevantStudyFeaturesDegreeUI mPrev + -- , fltrRelevantStudyFeaturesSemesterUI mPrev + , prismAForm (singletonFilter "tutorial") mPrev $ aopt textField (fslI MsgCourseTutorial) ] dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtParams = DBParamsForm diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs index d522a03b2..17337dcc9 100644 --- a/src/Handler/Tutorial/Users.hs +++ b/src/Handler/Tutorial/Users.hs @@ -68,7 +68,8 @@ data TutorialUserActionData -- non-table form for general tutorial actions data GenTutAction - = GenTutActOccCopyWeek + = GenTutActShowExam + | GenTutActOccCopyWeek | GenTutActOccCopyLast | GenTutActOccEdit deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) @@ -77,18 +78,9 @@ data GenTutAction nullaryPathPiece ''GenTutAction $ camelToPathPiece' 1 embedRenderMessage ''UniWorX ''GenTutAction id -data GenTutActionData - = GenTutActOccCopyWeekData { gtaExam :: ExamId } - | GenTutActOccCopyLastData { gtaExam :: ExamId } - | GenTutActOccEditData { gtaExam :: ExamId } +data GenTutActionData = GenTutActionData { gtaAct :: GenTutAction, gtaExam :: ExamId } deriving (Eq, Ord, Show, Generic) -gta2gtad :: GenTutAction -> ExamId -> GenTutActionData -gta2gtad GenTutActOccCopyWeek = GenTutActOccCopyWeekData -gta2gtad GenTutActOccCopyLast = GenTutActOccCopyLastData -gta2gtad GenTutActOccEdit = GenTutActOccEditData - - -- mkGenTutForm :: [Filter Exam] -> Form GenTutActionData -- mkGenTutForm fltr = renderAForm FormStandard maa -- where @@ -104,7 +96,7 @@ mkGenTutForm fltr html = do (actRes, actView) <- mreq (selectFieldList ((\a->(a,a)) <$> universeF)) (fslI MsgCourseExam) Nothing (exmRes, exmView) <- mreq (examFieldFilter (Just $ SomeMessage MsgMenuExamNew) fltr) (fslI MsgCourseExam) Nothing let res :: FormResult GenTutAction -> FormResult ExamId -> FormResult GenTutActionData - res (FormSuccess gtao) (FormSuccess eid) = FormSuccess $ gta2gtad gtao eid + res (FormSuccess gta) (FormSuccess eid) = FormSuccess $ GenTutActionData{gtaAct=gta, gtaExam=eid} res (FormFailure e1) (FormFailure e2) = FormFailure $ e1 <> e2 res (FormFailure e) _ = FormFailure e res _ (FormFailure e) = FormFailure e @@ -122,7 +114,7 @@ postTUsersR tid ssh csh tutn = do let croute = CTutorialR tid ssh csh tutn TUsersR now <- liftIO getCurrentTime isAdmin <- hasReadAccessTo AdminR - (cid, Entity tutid tut@Tutorial{..}, (participantRes, participantTable), qualifications, timespan, exOccs) <- runDB do + (Entity tutid tut@Tutorial{..}, (participantRes, participantTable), qualifications, dbegin, hasExams, exmFltr, exOccs) <- runDB do trm <- get404 tid -- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh -- tutEnt@(Entity tutid _) <- fetchTutorial tid ssh csh tutn @@ -153,7 +145,13 @@ postTUsersR tid ssh csh tutn = do qualOptions = qualificationsOptionList qualifications lessons = occurringLessons trm $ tutEnt ^. _entityVal . _tutorialTime . _Wrapped' timespan = lessonTimesSpan lessons - exOccs <- flip foldMapM timespan $ getDayExamOccurrences False ssh $ Just cid + (dbegin, dend) = munzip timespan + tbegin = toMidnight . succ <$> dbegin + tend = toMidnight <$> dend + exmFltr = ([ExamEnd >=. tbegin] ||. [ExamEnd ==. Nothing]) ++ [ExamCourse ==. cid, ExamStart <=. tend] + -- $logInfoS "ExamOccurrenceForm" [st|Exams from #{tshow tbegin} until #{tshow tend}.|] + exOccs <- flip foldMapM timespan $ getDayExamOccurrences False ssh $ Just cid -- :: ExamOccurrenceMap + hasExams <- if null exOccs then exists exmFltr else pure True let acts :: Map TutorialUserAction (AForm Handler TutorialUserActionData) acts = Map.fromList $ @@ -180,7 +178,7 @@ postTUsersR tid ssh csh tutn = do , ( TutorialUserPrintQualification, pure TutorialUserPrintQualificationData ) ] table <- makeCourseUserTable cid acts isInTut colChoices psValidator (Just csvColChoices) - return (cid, tutEnt, table, qualifications, timespan, exOccs) + return (tutEnt, table, qualifications, dbegin, hasExams, exmFltr, exOccs) let courseQids = Set.fromList (entityKey <$> qualifications) tcontent <- formResultMaybe participantRes $ \case @@ -247,11 +245,6 @@ postTUsersR tid ssh csh tutn = do Just act -> act -- execute action and return produced content (i.e. pdf) Nothing -> do -- no table action content to return, continue normally let mkExamCreateBtn = linkButton mempty (msg2widget MsgMenuExamNew) [BCIsButton, BCPrimary] $ SomeRoute $ CourseR tid ssh csh CExamNewR - (dbegin, dend) = munzip timespan - tbegin = toMidnight . succ <$> dbegin - tend = toMidnight <$> dend - exmFltr = ([ExamEnd >=. tbegin] ||. [ExamEnd ==. Nothing]) ++ [ExamCourse ==. cid, ExamStart <=. tend] - $logInfoS "ExamOccurrenceForm" [st|Exams from #{tshow tbegin} until #{tshow tend}.|] ((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm ("FIDGeneralTutorialAction"::Text) $ mkGenTutForm exmFltr let gtaAnchor = "general-tutorial-action-form" :: Text gtaRoute = croute :#: gtaAnchor @@ -263,21 +256,24 @@ postTUsersR tid ssh csh tutn = do , formSubmit = FormSubmit , formAnchor = Just gtaAnchor } - formResult gtaRes $ \case - GenTutActOccEditData { gtaExam=eId } -> do - Exam{examName=ename} <- runDBRead $ get404 eId + copyAction eId step = case dbegin of + Nothing -> addMessageI Error MsgExamOccurrenceCopyNoStartDate + Just dto -> + let cfailure = addMessageI Error MsgExamOccurrenceCopyFail + csuccess n = addMessageI Success (MsgExamOccurrencesCopied n) >> reloadKeepGetParams croute + copyFrom dfrom = copyExamOccurrences eId dfrom dto <&> (toMaybe =<< (> 0)) + step_dto = addDays (negate step) dto + in maybeM cfailure csuccess $ + runDB $ firstJustM $ map copyFrom $ take 69 $ drop 1 [dto, step_dto..] -- search for up to 2 months / 1 year backwards + formResult gtaRes $ \GenTutActionData{..} -> case gtaAct of + GenTutActOccCopyWeek -> copyAction gtaExam 7 + GenTutActOccCopyLast -> copyAction gtaExam 1 + GenTutActOccEdit -> do + Exam{examName=ename} <- runDBRead $ get404 gtaExam redirect $ CTutorialR tid ssh csh tutn $ TExamR ename - copyAction -> case dbegin of - Nothing -> addMessageI Error MsgExamOccurrenceCopyNoStartDate - (Just dto) -> - let cfailure = addMessageI Error MsgExamOccurrenceCopyFail - csuccess n = addMessageI Success (MsgExamOccurrencesCopied n) >> reloadKeepGetParams croute - copyFrom dfrom = copyExamOccurrences (gtaExam copyAction) dfrom dto <&> (toMaybe =<< (> 0)) - step_dto = case copyAction of - GenTutActOccCopyWeekData{} -> addDays (-7) dto - _ -> pred dto - in maybeM cfailure csuccess $ - runDB $ firstJustM $ map copyFrom $ take 69 $ drop 1 [dto, step_dto..] -- search for up to 2 months / 1 year backwards + GenTutActShowExam -> do + Exam{examName=ename} <- runDBRead $ get404 gtaExam + redirect (CExamR tid ssh csh ename EUsersR, [("exam-users-tutorial", toPathPiece tutn)]) tutors <- runDBRead $ E.select do (tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User diff --git a/templates/exam-users.hamlet b/templates/exam-users.hamlet index 2e5096836..62d5f54f7 100644 --- a/templates/exam-users.hamlet +++ b/templates/exam-users.hamlet @@ -1,6 +1,6 @@ $newline never -$# SPDX-FileCopyrightText: 2022 Gregor Kleen +$# SPDX-FileCopyrightText: 2022-25 Gregor Kleen ,Steffen Jost $# $# SPDX-License-Identifier: AGPL-3.0-or-later @@ -21,7 +21,7 @@ $if examOccurrenceRuleAutomatic examOccurrenceRule

_{MsgExamAutoOccurrenceHeading} ^{examAutoOccurrenceCalculateWidget tid ssh csh examn} -
+
$if computedValues ^{computedValuesTip} ^{examUsersTable} diff --git a/templates/tutorial-participants.hamlet b/templates/tutorial-participants.hamlet index 960cbf20e..cf97bd114 100644 --- a/templates/tutorial-participants.hamlet +++ b/templates/tutorial-participants.hamlet @@ -1,6 +1,6 @@ $newline never -$# SPDX-FileCopyrightText: 2022 Sarah Vaupel ,Sarah Vaupel +$# SPDX-FileCopyrightText: 2022-25 Sarah Vaupel ,Sarah Vaupel ,Steffen Jost $# $# SPDX-License-Identifier: AGPL-3.0-or-later @@ -23,4 +23,7 @@ $#

_{MsgExamFormOccurrences}

- ^{gtaForm} ^{mkExamCreateBtn} \ No newline at end of file + $if hasExams + ^{gtaForm} + $else + ^{mkExamCreateBtn} \ No newline at end of file