fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(tutorial): convenience button to show tutorial exam results

Browse Source 
required new filter on exam participants page
This commit is contained in:
Steffen Jost 2025-01-30 17:34:31 +01:00 committed by Sarah Vaupel
parent c1ed89a30b
commit e8a21610a4
8 changed files with 79 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
messages/uniworx/categories/courses/exam/exam/de-de-formal.msg
View File

@ -1,4 +1,4 @@
# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
# SPDX-FileCopyrightText: 2022-25 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
#
# 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

4
messages/uniworx/categories/courses/exam/exam/en-eu.msg
View File

@ -1,4 +1,4 @@
# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
# SPDX-FileCopyrightText: 2022-25 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
#
# 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

3
messages/uniworx/categories/courses/tutorial/de-de-formal.msg
View File

@ -1,4 +1,4 @@
# SPDX-FileCopyrightText: 2022-24 Winnie Ros <winnie.ros@campus.lmu.de>, Steffen Jost <s.jost@fraport.de>
# SPDX-FileCopyrightText: 2022-25 Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
#
# 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

3
messages/uniworx/categories/courses/tutorial/en-eu.msg
View File

@ -1,4 +1,4 @@
# SPDX-FileCopyrightText: 2022-24 Winnie Ros <winnie.ros@campus.lmu.de>, Steffen Jost <s.jost@fraport.de>
# SPDX-FileCopyrightText: 2022-25 Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
#
# 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

57
src/Handler/Exam/Users.hs
View File

@ -1,8 +1,9 @@
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
-- SPDX-FileCopyrightText: 2022-25 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
--
-- 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

64
src/Handler/Tutorial/Users.hs
View File

@ -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

4
templates/exam-users.hamlet
View File

@ -1,6 +1,6 @@
$newline never
$# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
$# SPDX-FileCopyrightText: 2022-25 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
@ -21,7 +21,7 @@ $if examOccurrenceRuleAutomatic examOccurrenceRule
<section>
<h2>_{MsgExamAutoOccurrenceHeading}
^{examAutoOccurrenceCalculateWidget tid ssh csh examn}
<section>
<section id="general-tutorial-action-form">
$if computedValues
^{computedValuesTip}
^{examUsersTable}

7
templates/tutorial-participants.hamlet
View File

@ -1,6 +1,6 @@
$newline never
$# SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>
$# SPDX-FileCopyrightText: 2022-25 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
@ -23,4 +23,7 @@ $# <h2 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
_{MsgExamFormOccurrences}
<div>
<p>
^{gtaForm} ^{mkExamCreateBtn}
$if hasExams
^{gtaForm}
$else
^{mkExamCreateBtn}