chore(tutorial): convenience button to show tutorial exam results
required new filter on exam participants page
This commit is contained in:
parent
c1ed89a30b
commit
e8a21610a4
@ -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
|
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
@ -35,7 +35,7 @@ ExamEditHeading examn@ExamName: #{examn} bearbeiten
|
|||||||
ExamNameTip: Muss innerhalb der Veranstaltung eindeutig sein
|
ExamNameTip: Muss innerhalb der Veranstaltung eindeutig sein
|
||||||
ExamDescription: Beschreibung
|
ExamDescription: Beschreibung
|
||||||
ExamFormTimes: Zeiten
|
ExamFormTimes: Zeiten
|
||||||
ExamFormOccurrences: Prüfungstermine/Räume
|
ExamFormOccurrences: Prüfungstermine / Räume
|
||||||
ExamFormAutomaticFunctions: Automatische Funktionen
|
ExamFormAutomaticFunctions: Automatische Funktionen
|
||||||
ExamFormCorrection: Korrektur
|
ExamFormCorrection: Korrektur
|
||||||
ExamFormParts: Teile
|
ExamFormParts: Teile
|
||||||
|
|||||||
@ -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
|
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
@ -35,7 +35,7 @@ ExamEditHeading examn: Edit #{examn}
|
|||||||
ExamNameTip: Needs to be unique within the course
|
ExamNameTip: Needs to be unique within the course
|
||||||
ExamDescription: Description
|
ExamDescription: Description
|
||||||
ExamFormTimes: Times
|
ExamFormTimes: Times
|
||||||
ExamFormOccurrences: Occurrences/rooms
|
ExamFormOccurrences: Occurrences / Rooms
|
||||||
ExamFormAutomaticFunctions: Automatic functions
|
ExamFormAutomaticFunctions: Automatic functions
|
||||||
ExamFormCorrection: Correction
|
ExamFormCorrection: Correction
|
||||||
ExamFormParts: Exam parts
|
ExamFormParts: Exam parts
|
||||||
|
|||||||
@ -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
|
# 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
|
GenTutActOccCopyLast: Prüfungstermine von früherem Kurs kopieren
|
||||||
GenTutActOccCopyWeek: Prüfungstermine von früherer Woche kopieren
|
GenTutActOccCopyWeek: Prüfungstermine von früherer Woche kopieren
|
||||||
GenTutActOccEdit: Relevante Prüfungstermine bearbeiten
|
GenTutActOccEdit: Relevante Prüfungstermine bearbeiten
|
||||||
|
GenTutActShowExam: Prüfungsergebnisse der Kursteilnehmer anzeigen
|
||||||
@ -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
|
# 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
|
GenTutActOccCopyLast: Copy exam occurrences from previous course
|
||||||
GenTutActOccCopyWeek: Copy exam occurrences from course on previous week
|
GenTutActOccCopyWeek: Copy exam occurrences from course on previous week
|
||||||
GenTutActOccEdit: Edit relevant exam occurrences
|
GenTutActOccEdit: Edit relevant exam occurrences
|
||||||
|
GenTutActShowExam: Show exam results for course participants
|
||||||
@ -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
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
module Handler.Exam.Users
|
module Handler.Exam.Users
|
||||||
( getEUsersR, postEUsersR
|
( getEUsersR, postEUsersR
|
||||||
@ -20,6 +21,8 @@ import Handler.Exam.AutoOccurrence (examAutoOccurrenceCalculateWidget)
|
|||||||
|
|
||||||
import Handler.ExamOffice.Exam (examCloseWidget, examFinishWidget)
|
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.Legacy as E
|
||||||
import qualified Database.Esqueleto.Utils as E
|
import qualified Database.Esqueleto.Utils as E
|
||||||
import Database.Esqueleto.Utils.TH
|
import Database.Esqueleto.Utils.TH
|
||||||
@ -390,7 +393,7 @@ getEUsersR = postEUsersR
|
|||||||
postEUsersR tid ssh csh examn = do
|
postEUsersR tid ssh csh examn = do
|
||||||
(((Any computedValues, registrationResult), examUsersTable), Entity eId examVal@Exam{..}, (bonus, resultSheets)) <- runDB $ do
|
(((Any computedValues, registrationResult), examUsersTable), Entity eId examVal@Exam{..}, (bonus, resultSheets)) <- runDB $ do
|
||||||
exam@(Entity eid examVal@Exam{..}) <- fetchExam tid ssh csh examn
|
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]
|
occurrences <- selectList [ExamOccurrenceExam ==. eid] [Asc ExamOccurrenceName]
|
||||||
examParts <- selectList [ExamPartExam ==. eid] [Asc ExamPartName]
|
examParts <- selectList [ExamPartExam ==. eid] [Asc ExamPartName]
|
||||||
bonus <- examRelevantSheets exam True
|
bonus <- examRelevantSheets exam True
|
||||||
@ -522,29 +525,37 @@ postEUsersR tid ssh csh examn = do
|
|||||||
dbtFilter = mconcat
|
dbtFilter = mconcat
|
||||||
[ uncurry singletonMap $ fltrUserNameEmail queryUser
|
[ uncurry singletonMap $ fltrUserNameEmail queryUser
|
||||||
, uncurry singletonMap $ fltrUserMatriclenr 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))
|
, fltrExamResultPoints (to $ queryExamResult >>> (E.?. ExamResultResult))
|
||||||
, fltrRelevantStudyFeaturesTerms (to $
|
-- , fltrRelevantStudyFeaturesTerms (to $
|
||||||
\t -> ( E.val courseTerm
|
-- \t -> ( E.val courseTerm
|
||||||
, queryUser t E.^. UserId
|
-- , queryUser t E.^. UserId
|
||||||
))
|
-- ))
|
||||||
, fltrRelevantStudyFeaturesDegree (to $
|
-- , fltrRelevantStudyFeaturesDegree (to $
|
||||||
\t -> ( E.val courseTerm
|
-- \t -> ( E.val courseTerm
|
||||||
, queryUser t E.^. UserId
|
-- , queryUser t E.^. UserId
|
||||||
))
|
-- ))
|
||||||
, fltrRelevantStudyFeaturesSemester (to $
|
-- , fltrRelevantStudyFeaturesSemester (to $
|
||||||
\t -> ( E.val courseTerm
|
-- \t -> ( E.val courseTerm
|
||||||
, queryUser t E.^. UserId
|
-- , 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
|
dbtFilterUI mPrev = mconcat $
|
||||||
, Just $ fltrUserMatriclenrUI mPrev
|
[ fltrUserNameEmailUI mPrev
|
||||||
, Just $ prismAForm (singletonFilter "occurrence") mPrev $ aopt (selectField' (Just $ SomeMessage MsgExamNoFilter) $ optionsF [CI.original examOccurrenceName | Entity _ ExamOccurrence{..} <- occurrences]) (fslI MsgTableExamOccurrence)
|
, fltrUserMatriclenrUI mPrev
|
||||||
, Just $ fltrExamResultPointsUI mPrev
|
, prismAForm (singletonFilter "occurrence") mPrev $ aopt (selectField' (Just $ SomeMessage MsgExamNoFilter) $ optionsF [CI.original examOccurrenceName | Entity _ ExamOccurrence{..} <- occurrences]) (fslI MsgTableExamOccurrence)
|
||||||
, Just $ fltrRelevantStudyFeaturesTermsUI mPrev
|
, fltrExamResultPointsUI mPrev
|
||||||
, Just $ fltrRelevantStudyFeaturesDegreeUI mPrev
|
-- , fltrRelevantStudyFeaturesTermsUI mPrev
|
||||||
, Just $ fltrRelevantStudyFeaturesSemesterUI mPrev
|
-- , fltrRelevantStudyFeaturesDegreeUI mPrev
|
||||||
|
-- , fltrRelevantStudyFeaturesSemesterUI mPrev
|
||||||
|
, prismAForm (singletonFilter "tutorial") mPrev $ aopt textField (fslI MsgCourseTutorial)
|
||||||
]
|
]
|
||||||
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
|
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
|
||||||
dbtParams = DBParamsForm
|
dbtParams = DBParamsForm
|
||||||
|
|||||||
@ -68,7 +68,8 @@ data TutorialUserActionData
|
|||||||
|
|
||||||
-- non-table form for general tutorial actions
|
-- non-table form for general tutorial actions
|
||||||
data GenTutAction
|
data GenTutAction
|
||||||
= GenTutActOccCopyWeek
|
= GenTutActShowExam
|
||||||
|
| GenTutActOccCopyWeek
|
||||||
| GenTutActOccCopyLast
|
| GenTutActOccCopyLast
|
||||||
| GenTutActOccEdit
|
| GenTutActOccEdit
|
||||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
||||||
@ -77,18 +78,9 @@ data GenTutAction
|
|||||||
nullaryPathPiece ''GenTutAction $ camelToPathPiece' 1
|
nullaryPathPiece ''GenTutAction $ camelToPathPiece' 1
|
||||||
embedRenderMessage ''UniWorX ''GenTutAction id
|
embedRenderMessage ''UniWorX ''GenTutAction id
|
||||||
|
|
||||||
data GenTutActionData
|
data GenTutActionData = GenTutActionData { gtaAct :: GenTutAction, gtaExam :: ExamId }
|
||||||
= GenTutActOccCopyWeekData { gtaExam :: ExamId }
|
|
||||||
| GenTutActOccCopyLastData { gtaExam :: ExamId }
|
|
||||||
| GenTutActOccEditData { gtaExam :: ExamId }
|
|
||||||
deriving (Eq, Ord, Show, Generic)
|
deriving (Eq, Ord, Show, Generic)
|
||||||
|
|
||||||
gta2gtad :: GenTutAction -> ExamId -> GenTutActionData
|
|
||||||
gta2gtad GenTutActOccCopyWeek = GenTutActOccCopyWeekData
|
|
||||||
gta2gtad GenTutActOccCopyLast = GenTutActOccCopyLastData
|
|
||||||
gta2gtad GenTutActOccEdit = GenTutActOccEditData
|
|
||||||
|
|
||||||
|
|
||||||
-- mkGenTutForm :: [Filter Exam] -> Form GenTutActionData
|
-- mkGenTutForm :: [Filter Exam] -> Form GenTutActionData
|
||||||
-- mkGenTutForm fltr = renderAForm FormStandard maa
|
-- mkGenTutForm fltr = renderAForm FormStandard maa
|
||||||
-- where
|
-- where
|
||||||
@ -104,7 +96,7 @@ mkGenTutForm fltr html = do
|
|||||||
(actRes, actView) <- mreq (selectFieldList ((\a->(a,a)) <$> universeF)) (fslI MsgCourseExam) Nothing
|
(actRes, actView) <- mreq (selectFieldList ((\a->(a,a)) <$> universeF)) (fslI MsgCourseExam) Nothing
|
||||||
(exmRes, exmView) <- mreq (examFieldFilter (Just $ SomeMessage MsgMenuExamNew) fltr) (fslI MsgCourseExam) Nothing
|
(exmRes, exmView) <- mreq (examFieldFilter (Just $ SomeMessage MsgMenuExamNew) fltr) (fslI MsgCourseExam) Nothing
|
||||||
let res :: FormResult GenTutAction -> FormResult ExamId -> FormResult GenTutActionData
|
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 e1) (FormFailure e2) = FormFailure $ e1 <> e2
|
||||||
res (FormFailure e) _ = FormFailure e
|
res (FormFailure e) _ = FormFailure e
|
||||||
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
|
let croute = CTutorialR tid ssh csh tutn TUsersR
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
isAdmin <- hasReadAccessTo AdminR
|
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
|
trm <- get404 tid
|
||||||
-- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
-- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||||
-- tutEnt@(Entity tutid _) <- fetchTutorial tid ssh csh tutn
|
-- tutEnt@(Entity tutid _) <- fetchTutorial tid ssh csh tutn
|
||||||
@ -153,7 +145,13 @@ postTUsersR tid ssh csh tutn = do
|
|||||||
qualOptions = qualificationsOptionList qualifications
|
qualOptions = qualificationsOptionList qualifications
|
||||||
lessons = occurringLessons trm $ tutEnt ^. _entityVal . _tutorialTime . _Wrapped'
|
lessons = occurringLessons trm $ tutEnt ^. _entityVal . _tutorialTime . _Wrapped'
|
||||||
timespan = lessonTimesSpan lessons
|
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
|
let
|
||||||
acts :: Map TutorialUserAction (AForm Handler TutorialUserActionData)
|
acts :: Map TutorialUserAction (AForm Handler TutorialUserActionData)
|
||||||
acts = Map.fromList $
|
acts = Map.fromList $
|
||||||
@ -180,7 +178,7 @@ postTUsersR tid ssh csh tutn = do
|
|||||||
, ( TutorialUserPrintQualification, pure TutorialUserPrintQualificationData )
|
, ( TutorialUserPrintQualification, pure TutorialUserPrintQualificationData )
|
||||||
]
|
]
|
||||||
table <- makeCourseUserTable cid acts isInTut colChoices psValidator (Just csvColChoices)
|
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)
|
let courseQids = Set.fromList (entityKey <$> qualifications)
|
||||||
tcontent <- formResultMaybe participantRes $ \case
|
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)
|
Just act -> act -- execute action and return produced content (i.e. pdf)
|
||||||
Nothing -> do -- no table action content to return, continue normally
|
Nothing -> do -- no table action content to return, continue normally
|
||||||
let mkExamCreateBtn = linkButton mempty (msg2widget MsgMenuExamNew) [BCIsButton, BCPrimary] $ SomeRoute $ CourseR tid ssh csh CExamNewR
|
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
|
((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm ("FIDGeneralTutorialAction"::Text) $ mkGenTutForm exmFltr
|
||||||
let gtaAnchor = "general-tutorial-action-form" :: Text
|
let gtaAnchor = "general-tutorial-action-form" :: Text
|
||||||
gtaRoute = croute :#: gtaAnchor
|
gtaRoute = croute :#: gtaAnchor
|
||||||
@ -263,21 +256,24 @@ postTUsersR tid ssh csh tutn = do
|
|||||||
, formSubmit = FormSubmit
|
, formSubmit = FormSubmit
|
||||||
, formAnchor = Just gtaAnchor
|
, formAnchor = Just gtaAnchor
|
||||||
}
|
}
|
||||||
formResult gtaRes $ \case
|
copyAction eId step = case dbegin of
|
||||||
GenTutActOccEditData { gtaExam=eId } -> do
|
Nothing -> addMessageI Error MsgExamOccurrenceCopyNoStartDate
|
||||||
Exam{examName=ename} <- runDBRead $ get404 eId
|
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
|
redirect $ CTutorialR tid ssh csh tutn $ TExamR ename
|
||||||
copyAction -> case dbegin of
|
GenTutActShowExam -> do
|
||||||
Nothing -> addMessageI Error MsgExamOccurrenceCopyNoStartDate
|
Exam{examName=ename} <- runDBRead $ get404 gtaExam
|
||||||
(Just dto) ->
|
redirect (CExamR tid ssh csh ename EUsersR, [("exam-users-tutorial", toPathPiece tutn)])
|
||||||
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
|
|
||||||
|
|
||||||
tutors <- runDBRead $ E.select do
|
tutors <- runDBRead $ E.select do
|
||||||
(tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User
|
(tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User
|
||||||
|
|||||||
@ -1,6 +1,6 @@
|
|||||||
$newline never
|
$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
|
$# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
@ -21,7 +21,7 @@ $if examOccurrenceRuleAutomatic examOccurrenceRule
|
|||||||
<section>
|
<section>
|
||||||
<h2>_{MsgExamAutoOccurrenceHeading}
|
<h2>_{MsgExamAutoOccurrenceHeading}
|
||||||
^{examAutoOccurrenceCalculateWidget tid ssh csh examn}
|
^{examAutoOccurrenceCalculateWidget tid ssh csh examn}
|
||||||
<section>
|
<section id="general-tutorial-action-form">
|
||||||
$if computedValues
|
$if computedValues
|
||||||
^{computedValuesTip}
|
^{computedValuesTip}
|
||||||
^{examUsersTable}
|
^{examUsersTable}
|
||||||
|
|||||||
@ -1,6 +1,6 @@
|
|||||||
$newline never
|
$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
|
$# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
@ -23,4 +23,7 @@ $# <h2 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
|
|||||||
_{MsgExamFormOccurrences}
|
_{MsgExamFormOccurrences}
|
||||||
<div>
|
<div>
|
||||||
<p>
|
<p>
|
||||||
^{gtaForm} ^{mkExamCreateBtn}
|
$if hasExams
|
||||||
|
^{gtaForm}
|
||||||
|
$else
|
||||||
|
^{mkExamCreateBtn}
|
||||||
Loading…
Reference in New Issue
Block a user