diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 5a89c8133..3651476cc 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -1347,6 +1347,8 @@ ExamBonusRule: Prüfungsbonus aus Übungsbetrieb ExamNoBonus': Kein automatischer Bonus ExamBonusPoints': Umrechnung von Übungspunkten +ExamBonusAchieved: Bonuspunkte + ExamEditHeading examn@ExamName: #{examn} bearbeiten ExamBonusMaxPoints: Maximal erreichbare Prüfungs-Bonuspunkte @@ -1393,8 +1395,9 @@ ExamParts: Teilprüfungen/Aufgaben ExamPartWeightNegative: Gewicht aller Teilprüfungen muss größer oder gleich Null sein ExamPartAlreadyExists: Teilprüfung mit diesem Namen existiert bereits ExamPartNumber: Nummer +ExamPartNumbered examPartNumber@ExamPartNumber: Teil #{view _ExamPartNumber examPartNumber} ExamPartNumberTip: Wird als interne Bezeichnung z.B. bei CSV-Export verwendet -ExamPartName: Name +ExamPartName: Titel ExamPartNameTip: Wird den Studierenden angezeigt ExamPartMaxPoints: Maximalpunktzahl ExamPartWeight: Gewichtung @@ -1496,6 +1499,7 @@ CsvColumnExamUserExercisePoints: Anzahl von Punkten, die der Teilnehmer im Übun CsvColumnExamUserExercisePointsMax: Maximale Anzahl von Punkten, die der Teilnehmer im Übungsbetrieb bis zu seinem Prüfungstermin erreichen hätte können CsvColumnExamUserExercisePasses: Anzahl von Übungsblättern, die der Teilnehmer bestanden hat CsvColumnExamUserExercisePassesMax: Maximale Anzahl von Übungsblättern, die der Teilnehmer bis zu seinem Prüfungstermin bestehen hätte können +CsvColumnExamUserBonus: Anzurechnende Bonuspunkte CsvColumnExamUserResult: Erreichte Prüfungsleistung; "passed", "failed", "no-show", "voided", oder eine Note ("1.0", "1.3", "1.7", ..., "4.0", "5.0") CsvColumnExamUserCourseNote: Notizen zum Teilnehmer @@ -1527,10 +1531,13 @@ ExamUserCsvRegister: Kursteilnehmer zur Prüfung anmelden ExamUserCsvAssignOccurrence: Teilnehmern einen anderen Termin/Raum zuweisen ExamUserCsvDeregister: Teilnehmer von der Prüfung abmelden ExamUserCsvSetCourseField: Kurs-assoziiertes Studienfach ändern +ExamUserCsvOverrideBonus: Bonuspunkte entgegen Bonusregelung überschreiben ExamUserCsvOverrideResult: Ergebnis entgegen automatischer Notenberechnung überschreiben +ExamUserCsvSetBonus: Bonuspunkte eintragen ExamUserCsvSetResult: Ergebnis eintragen ExamUserCsvSetPartResult: Ergebnis einer Teilprüfung eintragen ExamUserCsvSetCourseNote: Teilnehmer-Notizen anpassen +ExamBonusNone: Keine Bonuspunkte ExamUserCsvCourseNoteDeleted: Notiz wird gelöscht diff --git a/models/exams b/models/exams index 22c34cc5b..7eff47789 100644 --- a/models/exams +++ b/models/exams @@ -20,11 +20,11 @@ Exam ExamPart exam ExamId number ExamPartNumber - name ExamPartName + name ExamPartName Maybe maxPoints Points Maybe weight Rational UniqueExamPartNumber exam number - UniqueExamPartName exam name + UniqueExamPartName exam name !force ExamOccurrence exam ExamId name ExamOccurrenceName @@ -46,6 +46,12 @@ ExamPartResult result ExamResultPoints lastChanged UTCTime default=now() UniqueExamPartResult examPart user +ExamBonus + exam ExamId + user UserId + bonus Points + lastChanged UTCTime default=now() + UniqueExamBonus exam user ExamResult exam ExamId user UserId diff --git a/src/Audit/Types.hs b/src/Audit/Types.hs index 994f74357..5b835a722 100644 --- a/src/Audit/Types.hs +++ b/src/Audit/Types.hs @@ -33,6 +33,15 @@ data Transaction , transactionUser :: UserId } + | TransactionExamBonusEdit + { transactionExam :: ExamId + , transactionUser :: UserId + } + | TransactionExamBonusDeleted + { transactionExam :: ExamId + , transactionUser :: UserId + } + | TransactionExamResultEdit { transactionExam :: ExamId , transactionUser :: UserId diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index ba1e2af6a..c0b1c87a1 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -57,7 +57,7 @@ data ExamOccurrenceForm = ExamOccurrenceForm data ExamPartForm = ExamPartForm { epfId :: Maybe CryptoUUIDExamPart , epfNumber :: ExamPartNumber - , epfName :: ExamPartName + , epfName :: Maybe ExamPartName , epfMaxPoints :: Maybe Points , epfWeight :: Rational } deriving (Read, Show, Eq, Ord, Generic, Typeable) @@ -202,7 +202,7 @@ examPartsForm prev = wFormToAForm $ do examPartForm' nudge mPrev csrf = do (epfIdRes, epfIdView) <- mopt hiddenField ("" & addName (nudge "id")) (Just $ epfId =<< mPrev) (epfNumberRes, epfNumberView) <- mpreq (isoField (from _ExamPartNumber) $ textField & cfStrip & cfCI) ("" & addName (nudge "number") & addPlaceholder "1, 6a, 3.1.4, ...") (epfNumber <$> mPrev) - (epfNameRes, epfNameView) <- mpreq (textField & cfStrip & cfCI) ("" & addName (nudge "name")) (epfName <$> mPrev) + (epfNameRes, epfNameView) <- mopt (textField & cfStrip & cfCI) ("" & addName (nudge "name")) (epfName <$> mPrev) (epfMaxPointsRes, epfMaxPointsView) <- mopt pointsField ("" & addName (nudge "max-points")) (epfMaxPoints <$> mPrev) (epfWeightRes, epfWeightView) <- mpreq (checkBool (>= 0) MsgExamPartWeightNegative rationalField) ("" & addName (nudge "weight")) (epfWeight <$> mPrev <|> Just 1) @@ -220,7 +220,8 @@ examPartsForm prev = wFormToAForm $ do (res, formWidget) <- examPartForm' nudge Nothing csrf let addRes = res <&> \newDat (Set.fromList -> oldDat) -> if - | any (((==) `on` epfName) newDat) oldDat -> FormFailure [mr MsgExamPartAlreadyExists] + | any (\old -> fromMaybe False $ (==) <$> epfName newDat <*> epfName old) oldDat + -> FormFailure [mr MsgExamPartAlreadyExists] | otherwise -> FormSuccess $ pure newDat return (addRes, $(widgetFile "widgets/massinput/examParts/add")) miCell' nudge dat = examPartForm' nudge (Just dat) diff --git a/src/Handler/Exam/Show.hs b/src/Handler/Exam/Show.hs index eceeecc1c..5f739d075 100644 --- a/src/Handler/Exam/Show.hs +++ b/src/Handler/Exam/Show.hs @@ -22,7 +22,7 @@ getEShowR tid ssh csh examn = do cTime <- liftIO getCurrentTime mUid <- maybeAuthId - (Entity _ Exam{..}, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown) <- runDB $ do + (Entity _ Exam{..}, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), lecturerInfoShown) <- runDB $ do exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn let examVisible = NTop (Just cTime) >= NTop examVisibleFrom @@ -62,9 +62,13 @@ getEShowR tid ssh csh examn = do registered <- for mUid $ existsBy . UniqueExamRegistration eId mayRegister <- (== Authorized) <$> evalAccessDB (CExamR tid ssh csh examName ERegisterR) True - occurrenceNamesShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR + lecturerInfoShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR - return (exam, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), occurrenceNamesShown) + return (exam, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), lecturerInfoShown) + + let occurrenceNamesShown = lecturerInfoShown + partNumbersShown = lecturerInfoShown + examClosedShown = lecturerInfoShown let examTimes = all (\(Entity _ ExamOccurrence{..}, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences registerWidget diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index fa087816e..ba71c331c 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -48,6 +48,7 @@ type ExamUserTableExpr = ( E.SqlExpr (Entity ExamRegistration) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms)) ) ) + `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamBonus)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamResult)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote)) type ExamUserTableData = DBRow ( Entity ExamRegistration @@ -56,6 +57,7 @@ type ExamUserTableData = DBRow ( Entity ExamRegistration , Maybe (Entity StudyFeatures) , Maybe (Entity StudyDegree) , Maybe (Entity StudyTerms) + , Maybe (Entity ExamBonus) , Maybe (Entity ExamResult) , Map ExamPartId (ExamPart, Maybe (Entity ExamPartResult)) , Maybe (Entity CourseUserNote) @@ -71,28 +73,51 @@ _userTableOccurrence :: Lens' ExamUserTableData (Maybe (Entity ExamOccurrence)) _userTableOccurrence = _dbrOutput . _3 queryUser :: ExamUserTableExpr -> E.SqlExpr (Entity User) -queryUser = $(sqlIJproj 2 2) . $(sqlLOJproj 5 1) - -queryStudyFeatures :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyFeatures)) -queryStudyFeatures = $(sqlIJproj 3 1) . $(sqlLOJproj 2 2) . $(sqlLOJproj 5 3) +queryUser = $(sqlIJproj 2 2) . $(sqlLOJproj 6 1) queryExamRegistration :: ExamUserTableExpr -> E.SqlExpr (Entity ExamRegistration) -queryExamRegistration = $(sqlIJproj 2 1) . $(sqlLOJproj 5 1) +queryExamRegistration = $(sqlIJproj 2 1) . $(sqlLOJproj 6 1) queryExamOccurrence :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity ExamOccurrence)) -queryExamOccurrence = $(sqlLOJproj 5 2) +queryExamOccurrence = $(sqlLOJproj 6 2) + +queryCourseParticipant :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity CourseParticipant)) +queryCourseParticipant = $(sqlLOJproj 2 1) . $(sqlLOJproj 6 3) + +queryStudyFeatures :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyFeatures)) +queryStudyFeatures = $(sqlIJproj 3 1) . $(sqlLOJproj 2 2) . $(sqlLOJproj 6 3) queryStudyDegree :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyDegree)) -queryStudyDegree = $(sqlIJproj 3 2) . $(sqlLOJproj 2 2) . $(sqlLOJproj 5 3) +queryStudyDegree = $(sqlIJproj 3 2) . $(sqlLOJproj 2 2) . $(sqlLOJproj 6 3) queryStudyField :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyTerms)) -queryStudyField = $(sqlIJproj 3 3) . $(sqlLOJproj 2 2) . $(sqlLOJproj 5 3) +queryStudyField = $(sqlIJproj 3 3) . $(sqlLOJproj 2 2) . $(sqlLOJproj 6 3) + +queryExamBonus :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity ExamBonus)) +queryExamBonus = $(sqlLOJproj 6 4) queryExamResult :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity ExamResult)) -queryExamResult = $(sqlLOJproj 5 4) +queryExamResult = $(sqlLOJproj 6 5) queryCourseNote :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity CourseUserNote)) -queryCourseNote = $(sqlLOJproj 5 5) +queryCourseNote = $(sqlLOJproj 6 6) + +queryExamPart :: forall a. + PersistField a + => ExamPartId + -> (E.SqlExpr (Entity ExamPart) -> E.SqlExpr (Maybe (Entity ExamPartResult)) -> E.SqlQuery (E.SqlExpr (E.Value a))) + -> ExamUserTableExpr + -> E.SqlExpr (E.Value a) +queryExamPart epId cont inp = E.sub_select . E.from $ \(examPart `E.LeftOuterJoin` examPartResult) -> flip runReaderT inp $ do + examRegistration <- asks queryExamRegistration + + lift $ do + E.on $ E.just (examPart E.^. ExamPartId) E.==. examPartResult E.?. ExamPartResultExamPart + E.&&. examPartResult E.?. ExamPartResultUser E.==. E.just (examRegistration E.^. ExamRegistrationUser) + E.where_ $ examPart E.^. ExamPartExam E.==. examRegistration E.^. ExamRegistrationExam + E.&&. examPart E.^. ExamPartId E.==. E.val epId + + cont examPart examPartResult resultExamRegistration :: Lens' ExamUserTableData (Entity ExamRegistration) resultExamRegistration = _dbrOutput . _1 @@ -112,23 +137,36 @@ resultStudyField = _dbrOutput . _6 . _Just resultExamOccurrence :: Traversal' ExamUserTableData (Entity ExamOccurrence) resultExamOccurrence = _dbrOutput . _3 . _Just +resultExamBonus :: Traversal' ExamUserTableData (Entity ExamBonus) +resultExamBonus = _dbrOutput . _7 . _Just + resultExamResult :: Traversal' ExamUserTableData (Entity ExamResult) -resultExamResult = _dbrOutput . _7 . _Just +resultExamResult = _dbrOutput . _8 . _Just resultExamParts :: IndexedTraversal' ExamPartId ExamUserTableData (ExamPart, Maybe (Entity ExamPartResult)) -resultExamParts = _dbrOutput . _8 . itraversed +resultExamParts = _dbrOutput . _9 . itraversed -- resultExamParts' :: Traversal' ExamUserTableData (Entity ExamPart) -- resultExamParts' = (resultExamParts <. _1) . withIndex . from _Entity --- resultExamPartResult :: ExamPartId -> Lens' ExamUserTableData (Maybe (Entity ExamPartResult)) --- resultExamPartResult epId = _dbrOutput . _8 . unsafeSingular (ix epId) . _2 +resultExamPartResult :: ExamPartId -> Lens' ExamUserTableData (Maybe (Entity ExamPartResult)) +resultExamPartResult epId = _dbrOutput . _9 . unsafeSingular (ix epId) . _2 --- resultExamPartResults :: IndexedTraversal' ExamPartId ExamUserTableData (Maybe (Entity ExamPartResult)) --- resultExamPartResults = resultExamParts <. _2 +resultExamPartResults :: IndexedTraversal' ExamPartId ExamUserTableData (Maybe (Entity ExamPartResult)) +resultExamPartResults = resultExamParts <. _2 resultCourseNote :: Traversal' ExamUserTableData (Entity CourseUserNote) -resultCourseNote = _dbrOutput . _9 . _Just +resultCourseNote = _dbrOutput . _10 . _Just + + +resultAutomaticExamBonus :: Exam -> Map UserId SheetTypeSummary -> Fold ExamUserTableData Points +resultAutomaticExamBonus exam examBonus' = resultUser . _entityKey . folding (\uid -> examResultBonus <$> examBonusRule exam <*> examBonusPossible uid examBonus' <*> examBonusAchieved uid examBonus') + +resultAutomaticExamResult :: Exam -> Map UserId SheetTypeSummary -> Fold ExamUserTableData ExamResultGrade +resultAutomaticExamResult exam examBonus' = folding . runReader $ do + parts' <- asks $ sequence . toListOf (resultExamPartResults . to (^? _Just . _entityVal . _examPartResultResult)) + bonus <- preview $ resultExamBonus . _entityVal . _examBonusBonus <> resultAutomaticExamBonus exam examBonus' + return $ examGrade exam bonus =<< parts' csvExamPartHeader :: Prism' Csv.Name ExamPartNumber @@ -151,10 +189,11 @@ data ExamUserTableCsv = ExamUserTableCsv , csvEUserDegree :: Maybe Text , csvEUserSemester :: Maybe Int , csvEUserOccurrence :: Maybe (CI Text) - , csvEUserExercisePoints :: Maybe Points - , csvEUserExerciseNumPasses :: Maybe Int - , csvEUserExercisePointsMax :: Maybe Points - , csvEUserExerciseNumPassesMax :: Maybe Int + , csvEUserExercisePoints :: Maybe (Maybe Points) + , csvEUserExerciseNumPasses :: Maybe (Maybe Int) + , csvEUserExercisePointsMax :: Maybe (Maybe Points) + , csvEUserExerciseNumPassesMax :: Maybe (Maybe Int) + , csvEUserBonus :: Maybe (Maybe Points) , csvEUserExamPartResults :: Map ExamPartNumber (Maybe ExamResultPoints) , csvEUserExamResult :: Maybe ExamResultPassedGrade , csvEUserCourseNote :: Maybe Html @@ -172,11 +211,14 @@ instance ToNamedRecord ExamUserTableCsv where , "degree" Csv..= csvEUserDegree , "semester" Csv..= csvEUserSemester , "occurrence" Csv..= csvEUserOccurrence - , "exercise-points" Csv..= csvEUserExercisePoints - , "exercise-num-passes" Csv..= csvEUserExerciseNumPasses - , "exercise-points-max" Csv..= csvEUserExercisePointsMax - , "exercise-num-passes-max" Csv..= csvEUserExerciseNumPassesMax - ] ++ examPartResults ++ + ] ++ catMaybes + [ fmap ("exercise-points" Csv..=) csvEUserExercisePoints + , fmap ("exercise-num-passes" Csv..=) csvEUserExerciseNumPasses + , fmap ("exercise-points-max" Csv..=) csvEUserExercisePointsMax + , fmap ("exercise-num-passes-max" Csv..=) csvEUserExerciseNumPassesMax + , fmap ("bonus" Csv..=) csvEUserBonus + ] + ++ examPartResults ++ [ "exam-result" Csv..= csvEUserExamResult , "course-note" Csv..= csvEUserCourseNote ] @@ -196,10 +238,11 @@ instance FromNamedRecord ExamUserTableCsv where <*> csv .:?? "degree" <*> csv .:?? "semester" <*> csv .:?? "occurrence" - <*> csv .:?? "exercise-points" - <*> csv .:?? "exercise-num-passes" - <*> csv .:?? "exercise-points-max" - <*> csv .:?? "exercise-num-passes-max" + <*> fmap Just (csv .:?? "exercise-points") + <*> fmap Just (csv .:?? "exercise-num-passes") + <*> fmap Just (csv .:?? "exercise-points-max") + <*> fmap Just (csv .:?? "exercise-num-passes-max") + <*> fmap Just (csv .:?? "bonus") <*> examPartResults <*> csv .:?? "exam-result" <*> csv .:?? "course-note" @@ -222,6 +265,7 @@ instance CsvColumnsExplained ExamUserTableCsv where , single "exercise-num-passes" MsgCsvColumnExamUserExercisePasses , single "exercise-points-max" MsgCsvColumnExamUserExercisePointsMax , single "exercise-num-passes-max" MsgCsvColumnExamUserExercisePassesMax + , single "bonus" MsgCsvColumnExamUserBonus , single "exam-result" MsgCsvColumnExamUserResult , single "course-note" MsgCsvColumnExamUserCourseNote ] @@ -232,17 +276,22 @@ instance CsvColumnsExplained ExamUserTableCsv where examUserTableCsvHeader :: ( MonoFoldable mono , Element mono ~ ExamPartNumber ) - => mono -> Csv.Header -examUserTableCsvHeader pNames = Csv.header $ + => SheetGradeSummary -> Bool -> mono -> Csv.Header +examUserTableCsvHeader allBoni doBonus pNames = Csv.header $ [ "surname", "first-name", "name" , "matriculation" , "field", "degree", "semester" , "course-note" , "occurrence" - , "exercise-points", "exercise-num-passes", "exercise-points-max", "exercise-num-passes-max" - ] ++ map (review csvExamPartHeader) (sort $ otoList pNames) ++ + ] ++ bool mempty ["exercise-points", "exercise-points-max"] (doBonus && showPoints) + ++ bool mempty ["exercise-num-passes", "exercise-num-passes-max"] (doBonus && showPasses) + ++ bool mempty ["bonus"] doBonus + ++ map (review csvExamPartHeader) (sort $ otoList pNames) ++ [ "exam-result" ] + where + showPasses = numSheetsPasses allBoni /= 0 + showPoints = getSum (numSheetsPoints allBoni) /= 0 data ExamUserAction = ExamUserDeregister | ExamUserAssignOccurrence @@ -262,6 +311,8 @@ data ExamUserCsvActionClass | ExamUserCsvAssignOccurrence | ExamUserCsvSetCourseField | ExamUserCsvSetPartResult + | ExamUserCsvSetBonus + | ExamUserCsvOverrideBonus | ExamUserCsvSetResult | ExamUserCsvOverrideResult | ExamUserCsvSetCourseNote @@ -295,6 +346,11 @@ data ExamUserCsvAction , examUserCsvActExamPart :: ExamPartNumber , examUserCsvActExamPartResult :: Maybe ExamResultPoints } + | ExamUserCsvSetBonusData + { examUserCsvIsBonusOverride :: Bool + , examUserCsvActUser :: UserId + , examUserCsvActExamBonus :: Maybe Points + } | ExamUserCsvSetResultData { examUserCsvIsResultOverride :: Bool , examUserCsvActUser :: UserId @@ -325,46 +381,88 @@ getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> getEUsersR = postEUsersR postEUsersR tid ssh csh examn = do ((registrationResult, examUsersTable), Entity eId _) <- runDB $ do - exam@(Entity eid Exam{..}) <- fetchExam tid ssh csh examn + exam@(Entity eid examVal@Exam{..}) <- fetchExam tid ssh csh examn examParts <- selectList [ExamPartExam ==. eid] [Asc ExamPartName] bonus <- examBonus exam let + allBoni :: SheetGradeSummary allBoni = (mappend <$> normalSummary <*> bonusSummary) $ fold bonus - showPasses = numSheetsPasses allBoni /= 0 - showPoints = getSum (numSheetsPoints allBoni) /= 0 + + doBonus = is _Just examGradingRule || is _Just examBonusRule + showPasses = doBonus && numSheetsPasses allBoni /= 0 + showPoints = doBonus && getSum (numSheetsPoints allBoni) /= 0 resultView :: ExamResultGrade -> ExamResultPassedGrade resultView = fmap $ bool (Left . view passingGrade) Right examShowGrades examPartNumbers = examParts ^.. folded . _entityVal . _examPartNumber + resultAutomaticExamBonus' :: Fold ExamUserTableData Points + resultAutomaticExamBonus' = resultAutomaticExamBonus examVal bonus + resultAutomaticExamResult' :: Fold ExamUserTableData ExamResultGrade + resultAutomaticExamResult' = resultAutomaticExamResult examVal bonus + + automaticCell :: forall msg m a r. + ( RenderMessage UniWorX msg + , IsDBTable m a + , Eq msg + ) + => Getting (Endo [Either msg msg]) r (Either msg msg) + -> r + -> DBCell m a + automaticCell l r = case toListOf l r of + [] -> mempty + (Left auto : _) + -> i18nCell auto & cellAttrs <>~ [("class", "table__td--automatic")] + (Right man : others) + | all ((== man) . either id id) others + -> i18nCell man + | otherwise + -> i18nCell man & cellAttrs <>~ [("class", "table__td--overriden")] + csvName <- getMessageRender <*> pure (MsgExamUserCsvName tid ssh csh examn) let examUsersDBTable = DBTable{..} where - dbtSQLQuery ((examRegistration `E.InnerJoin` user) `E.LeftOuterJoin` occurrence `E.LeftOuterJoin` (courseParticipant `E.LeftOuterJoin` (studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyField)) `E.LeftOuterJoin` examResult `E.LeftOuterJoin` courseUserNote) = do - E.on $ courseUserNote E.?. CourseUserNoteUser E.==. E.just (user E.^. UserId) - E.&&. courseUserNote E.?. CourseUserNoteCourse E.==. E.just (E.val examCourse) - E.on $ examResult E.?. ExamResultUser E.==. E.just (user E.^. UserId) - E.&&. examResult E.?. ExamResultExam E.==. E.just (E.val eid) - E.on $ studyField E.?. StudyTermsId E.==. studyFeatures E.?. StudyFeaturesField - E.on $ studyDegree E.?. StudyDegreeId E.==. studyFeatures E.?. StudyFeaturesDegree - E.on $ studyFeatures E.?. StudyFeaturesId E.==. E.joinV (courseParticipant E.?. CourseParticipantField) - E.on $ courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val examCourse) - E.&&. courseParticipant E.?. CourseParticipantUser E.==. E.just (user E.^. UserId) - E.on $ occurrence E.?. ExamOccurrenceExam E.==. E.just (E.val eid) - E.&&. occurrence E.?. ExamOccurrenceId E.==. examRegistration E.^. ExamRegistrationOccurrence - E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId - E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eid - return (examRegistration, user, occurrence, studyFeatures, studyDegree, studyField, examResult, courseUserNote) + dbtSQLQuery = runReaderT $ do + examRegistration <- asks queryExamRegistration + user <- asks queryUser + occurrence <- asks queryExamOccurrence + courseParticipant <- asks queryCourseParticipant + studyFeatures <- asks queryStudyFeatures + studyDegree <- asks queryStudyDegree + studyField <- asks queryStudyField + examBonus' <- asks queryExamBonus + examResult <- asks queryExamResult + courseUserNote <- asks queryCourseNote + + lift $ do + E.on $ courseUserNote E.?. CourseUserNoteUser E.==. E.just (user E.^. UserId) + E.&&. courseUserNote E.?. CourseUserNoteCourse E.==. E.just (E.val examCourse) + E.on $ examResult E.?. ExamResultUser E.==. E.just (user E.^. UserId) + E.&&. examResult E.?. ExamResultExam E.==. E.just (E.val eid) + E.on $ examBonus' E.?. ExamBonusUser E.==. E.just (user E.^. UserId) + E.&&. examBonus' E.?. ExamBonusExam E.==. E.just (E.val eid) + E.on $ studyField E.?. StudyTermsId E.==. studyFeatures E.?. StudyFeaturesField + E.on $ studyDegree E.?. StudyDegreeId E.==. studyFeatures E.?. StudyFeaturesDegree + E.on $ studyFeatures E.?. StudyFeaturesId E.==. E.joinV (courseParticipant E.?. CourseParticipantField) + E.on $ courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val examCourse) + E.&&. courseParticipant E.?. CourseParticipantUser E.==. E.just (user E.^. UserId) + E.on $ occurrence E.?. ExamOccurrenceExam E.==. E.just (E.val eid) + E.&&. occurrence E.?. ExamOccurrenceId E.==. examRegistration E.^. ExamRegistrationOccurrence + E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId + + E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eid + + return (examRegistration, user, occurrence, studyFeatures, studyDegree, studyField, examBonus', examResult, courseUserNote) dbtRowKey = queryExamRegistration >>> (E.^. ExamRegistrationId) dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $ - (,,,,,,,,) - <$> view _1 <*> view _2 <*> view _3 <*> view _4 <*> view _5 <*> view _6 <*> view _7 + (,,,,,,,,,) + <$> view _1 <*> view _2 <*> view _3 <*> view _4 <*> view _5 <*> view _6 <*> view _7 <*> view _8 <*> getExamParts - <*> view _8 + <*> view _9 where getExamParts :: ReaderT _ (MaybeT (YesodDB UniWorX)) (Map ExamPartId (ExamPart, Maybe (Entity ExamPartResult))) getExamParts = do @@ -395,25 +493,33 @@ postEUsersR tid ssh csh examn = do SheetGradeSummary{achievedPoints} <- examBonusAchieved uid bonus SheetGradeSummary{sumSheetsPoints} <- examBonusPossible uid bonus return $ propCell (getSum achievedPoints) (getSum sumSheetsPoints) - , guardOn examShowGrades $ sortable (Just "result") (i18nCell MsgExamResult) $ maybe mempty i18nCell . preview (resultExamResult . _entityVal . _examResultResult) - , guardOn (not examShowGrades) $ sortable (Just "result-bool") (i18nCell MsgExamResult) $ maybe mempty i18nCell . preview (resultExamResult . _entityVal . _examResultResult . to (over _examResult $ view passingGrade)) + , guardOn doBonus $ sortable (Just "bonus") (i18nCell MsgExamBonusAchieved) . automaticCell $ resultExamBonus . _entityVal . _examBonusBonus . to Right <> resultAutomaticExamBonus' . to Left + , pure $ mconcat + [ sortable (Just $ fromText [st|part-#{toPathPiece examPartNumber}|]) (i18nCell $ MsgExamPartNumbered examPartNumber) $ maybe mempty i18nCell . preview (resultExamPartResult epId . _Just . _entityVal . _examPartResultResult) + | Entity epId ExamPart{..} <- sortOn (examPartNumber . entityVal) examParts + ] + , pure $ sortable (Just $ bool "result-bool" "result" examShowGrades) (i18nCell MsgExamResult) . automaticCell $ (resultExamResult . _entityVal . _examResultResult . to Right <> resultAutomaticExamResult' . to Left) . to (bimap resultView resultView) , pure . sortable (Just "note") (i18nCell MsgCourseUserNote) $ \((,) <$> view (resultUser . _entityKey) <*> has resultCourseNote -> (uid, hasNote)) -> bool mempty (anchorCellM (CourseR tid ssh csh . CUserR <$> encrypt uid) $ hasComment True) hasNote ] - dbtSorting = Map.fromList - [ sortUserNameLink queryUser - , sortUserMatriclenr queryUser - , sortField queryStudyField - , sortDegreeShort queryStudyDegree - , sortFeaturesSemester queryStudyFeatures - , ("occurrence", SortColumn $ queryExamOccurrence >>> (E.?. ExamOccurrenceName)) - , ("result", SortColumn $ queryExamResult >>> (E.?. ExamResultResult)) - , ("result-bool", SortColumn $ queryExamResult >>> (E.?. ExamResultResult) >>> E.orderByList [Just ExamVoided, Just ExamNoShow, Just $ ExamAttended Grade50]) - , ("note", SortColumn $ queryCourseNote >>> \note -> -- sort by last edit date + dbtSorting = mconcat + [ uncurry singletonMap $ sortUserNameLink queryUser + , uncurry singletonMap $ sortUserMatriclenr queryUser + , uncurry singletonMap $ sortField queryStudyField + , uncurry singletonMap $ sortDegreeShort queryStudyDegree + , uncurry singletonMap $ sortFeaturesSemester queryStudyFeatures + , mconcat + [ singletonMap (fromText [st|part-#{toPathPiece examPartNumber}|]) . SortColumn . queryExamPart epId $ \_ examPartResult -> return $ examPartResult E.?. ExamPartResultResult + | Entity epId ExamPart{..} <- examParts + ] + , singletonMap "occurrence" . SortColumn $ queryExamOccurrence >>> (E.?. ExamOccurrenceName) + , singletonMap "bonus" . SortColumn $ queryExamBonus >>> (E.?. ExamBonusBonus) + , singletonMap "result" . SortColumn $ queryExamResult >>> (E.?. ExamResultResult) + , singletonMap "result-bool" . SortColumn $ queryExamResult >>> (E.?. ExamResultResult) >>> E.orderByList [Just ExamVoided, Just ExamNoShow, Just $ ExamAttended Grade50] + , singletonMap "note" . SortColumn $ queryCourseNote >>> \note -> -- sort by last edit date E.sub_select . E.from $ \edit -> do E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote) return . E.max_ $ edit E.^. CourseUserNoteEditTime - ) ] dbtFilter = Map.fromList [ fltrUserNameEmail queryUser @@ -479,7 +585,7 @@ postEUsersR tid ssh csh examn = do , dbtCsvDoEncode = \() -> C.map (doEncode' . view _2) , dbtCsvName = unpack csvName , dbtCsvNoExportData = Just id - , dbtCsvHeader = const . return . examUserTableCsvHeader $ examParts ^.. folded . _entityVal . _examPartNumber + , dbtCsvHeader = const . return . examUserTableCsvHeader allBoni doBonus $ examParts ^.. folded . _entityVal . _examPartNumber } where doEncode' = ExamUserTableCsv @@ -491,12 +597,13 @@ postEUsersR tid ssh csh examn = do <*> preview (resultStudyDegree . _entityVal . to (\StudyDegree{..} -> studyDegreeName <|> studyDegreeShorthand <|> Just (tshow studyDegreeKey)) . _Just) <*> preview (resultStudyFeatures . _entityVal . _studyFeaturesSemester) <*> preview (resultExamOccurrence . _entityVal . _examOccurrenceName) - <*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPoints . _Wrapped) - <*> preview (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPasses . _Wrapped . integral) - <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _sumSheetsPoints . _Wrapped) - <*> preview (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _numSheetsPasses . _Wrapped . integral) + <*> previews (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPoints . _Wrapped) (bool (const Nothing) Just showPoints) + <*> previews (resultUser . _entityKey . to (examBonusAchieved ?? bonus) . _Just . _achievedPasses . _Wrapped . integral) (bool (const Nothing) Just showPasses) + <*> previews (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _sumSheetsPoints . _Wrapped) (bool (const Nothing) Just showPoints) + <*> previews (resultUser . _entityKey . to (examBonusPossible ?? bonus) . _Just . _numSheetsPasses . _Wrapped . integral) (bool (const Nothing) Just showPasses) + <*> previews (resultExamBonus . _entityVal . _examBonusBonus <> resultAutomaticExamBonus') (bool (const Nothing) Just doBonus) <*> (Map.fromList . map (over _1 examPartNumber . over (_2 . _Just) (examPartResultResult . entityVal)) <$> asks (toListOf resultExamParts)) - <*> preview (resultExamResult . _entityVal . _examResultResult . to resultView) + <*> previews (resultExamResult . _entityVal . _examResultResult <> resultAutomaticExamResult') resultView <*> preview (resultCourseNote . _entityVal . _courseUserNoteNote) dbtCsvDecode = Just DBTCsvDecode { dbtCsvRowKey = \csv -> do @@ -523,6 +630,9 @@ postEUsersR tid ssh csh examn = do when (epNumber `elem` examPartNumbers) $ yield $ ExamUserCsvSetPartResultData uid epNumber (Just epRes) + when (is _Just . join $ csvEUserBonus dbCsvNew) $ + yield . ExamUserCsvSetBonusData False uid . join $ csvEUserBonus dbCsvNew + when (is _Just $ csvEUserExamResult dbCsvNew) $ yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew @@ -547,27 +657,39 @@ postEUsersR tid ssh csh examn = do when (epRes /= oldPartResult) $ yield $ ExamUserCsvSetPartResultData uid epNumber epRes - let newResults :: Map ExamPartNumber (Maybe ExamResultPoints) - newResults = csvEUserExamPartResults dbCsvNew - `Map.union` toMapOf (resultExamParts .> ito (over _1 $ examPartNumber) <. to (fmap $ examPartResultResult . entityVal)) dbCsvOld + let newResults :: Maybe (Map ExamPartNumber ExamResultPoints) + newResults = sequence (csvEUserExamPartResults dbCsvNew) + <|> sequence (toMapOf (resultExamParts .> ito (over _1 $ examPartNumber) <. to (fmap $ examPartResultResult . entityVal)) dbCsvOld) - newGrade :: Maybe ExamResultPassedGrade - newGrade = do - possible <- examBonusPossible uid bonus - achieved <- examBonusAchieved uid bonus - resultView <$> examGrade exam possible achieved (newResults ^.. folded . _Just) + newBonus, oldBonus :: Maybe Points + newBonus = join (csvEUserBonus dbCsvNew) + oldBonus = dbCsvOld ^? (resultExamBonus . _entityVal . _examBonusBonus <> resultAutomaticExamBonus') - oldResult = dbCsvOld ^? resultExamResult . _entityVal . _examResultResult . to resultView + newResult, oldResult :: Maybe ExamResultPassedGrade + newResult = fmap resultView <$> examGrade examVal (newBonus <|> oldBonus) =<< newResults + oldResult = dbCsvOld ^? (resultExamResult . _entityVal . _examResultResult <> resultAutomaticExamResult') . to resultView - case newGrade of + case newBonus of + _ | newBonus == oldBonus + -> return () + _ | is _Nothing newBonus + -> return () + Nothing + -> yield $ ExamUserCsvSetBonusData False uid newBonus + Just _ + -> yield $ ExamUserCsvSetBonusData True uid newBonus + + case newResult of _ | csvEUserExamResult dbCsvNew == oldResult -> return () + _ | is _Nothing $ csvEUserExamResult dbCsvNew + -> return () Nothing -> yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew Just _ - | csvEUserExamResult dbCsvNew /= newGrade + | csvEUserExamResult dbCsvNew /= newResult -> yield . ExamUserCsvSetResultData True uid $ csvEUserExamResult dbCsvNew - | oldResult /= newGrade + | oldResult /= newResult -> yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew | otherwise -> return () @@ -581,6 +703,9 @@ postEUsersR tid ssh csh examn = do ExamUserCsvAssignOccurrenceData{} -> ExamUserCsvAssignOccurrence ExamUserCsvSetCourseFieldData{} -> ExamUserCsvSetCourseField ExamUserCsvSetPartResultData{} -> ExamUserCsvSetPartResult + ExamUserCsvSetBonusData{..} + | examUserCsvIsBonusOverride -> ExamUserCsvOverrideBonus + | otherwise -> ExamUserCsvSetBonus ExamUserCsvSetResultData{..} | examUserCsvIsResultOverride -> ExamUserCsvOverrideResult | otherwise -> ExamUserCsvSetResult @@ -639,6 +764,19 @@ postEUsersR tid ssh csh examn = do , ExamPartResultLastChanged =. now ] audit $ TransactionExamPartResultEdit epid examUserCsvActUser + ExamUserCsvSetBonusData{..} -> case examUserCsvActExamBonus of + Nothing -> do + deleteBy $ UniqueExamBonus eid examUserCsvActUser + audit $ TransactionExamBonusDeleted eid examUserCsvActUser + Just res -> do + now <- liftIO getCurrentTime + void $ upsertBy + (UniqueExamBonus eid examUserCsvActUser) + (ExamBonus eid examUserCsvActUser res now) + [ ExamBonusBonus =. res + , ExamBonusLastChanged =. now + ] + audit $ TransactionExamBonusEdit eid examUserCsvActUser ExamUserCsvSetResultData{..} -> case examUserCsvActExamResult of Nothing -> do deleteBy $ UniqueExamResult eid examUserCsvActUser @@ -724,12 +862,25 @@ postEUsersR tid ssh csh examn = do [whamlet| $newline never ^{nameWidget userDisplayName userSurname} - , „#{examPartName}“ + $maybe pName <- examPartName + , „#{pName}“ + $nothing + , _{MsgExamPartNumbered examPartNumber} $maybe newResult <- examUserCsvActExamPartResult , _{newResult} $nothing , _{MsgExamResultNone} |] + ExamUserCsvSetBonusData{..} -> do + User{..} <- liftHandlerT . runDB $ getJust examUserCsvActUser + [whamlet| + $newline never + ^{nameWidget userDisplayName userSurname} + $maybe newBonus <- examUserCsvActExamBonus + , _{newBonus} + $nothing + , _{MsgExamBonusNone} + |] ExamUserCsvSetResultData{..} -> do User{..} <- liftHandlerT . runDB $ getJust examUserCsvActUser [whamlet| diff --git a/src/Handler/Utils/Exam.hs b/src/Handler/Utils/Exam.hs index dae79f3eb..8398abebd 100644 --- a/src/Handler/Utils/Exam.hs +++ b/src/Handler/Utils/Exam.hs @@ -2,7 +2,7 @@ module Handler.Utils.Exam ( fetchExamAux , fetchExam, fetchExamId, fetchCourseIdExamId, fetchCourseIdExam , examBonus, examBonusPossible, examBonusAchieved - , examGrade + , examResultBonus, examGrade ) where import Import.NoFoundation @@ -84,18 +84,42 @@ examBonusPossible uid bonusMap = normalSummary <$> Map.lookup uid bonusMap examBonusAchieved uid bonusMap = (mappend <$> normalSummary <*> bonusSummary) <$> Map.lookup uid bonusMap +examResultBonus :: ExamBonusRule + -> SheetGradeSummary -- ^ `examBonusPossible` + -> SheetGradeSummary -- ^ `examBonusAchieved` + -> Points +examResultBonus bonusRule bonusPossible bonusAchieved = case bonusRule of + ExamBonusPoints{..} + -> roundToPoints $ toRational bonusMaxPoints * bonusProp + where + bonusProp :: Rational + bonusProp + | possible <= 0 = 1 + | otherwise = achieved / possible + where + achieved = toRational (getSum $ achievedPoints bonusAchieved) + scalePasses (getSum $ achievedPasses bonusAchieved) + possible = toRational (getSum $ sumSheetsPoints bonusPossible) + scalePasses (getSum $ numSheetsPasses bonusPossible) + + scalePasses :: Integer -> Rational + -- ^ Rescale passes so count of all sheets with pass is worth as many points as sum of all sheets with points + scalePasses passes + | passesPossible <= 0 = 0 + | otherwise = fromInteger passes / fromInteger passesPossible * toRational pointsPossible + where + passesPossible = getSum $ numSheetsPasses bonusPossible + pointsPossible = getSum $ sumSheetsPoints bonusPossible + + roundToPoints :: forall a. HasResolution a => Rational -> Fixed a + roundToPoints = MkFixed . round . ((*) . toRational $ resolution (Proxy @a)) + examGrade :: ( MonoFoldable mono , Element mono ~ ExamResultPoints ) - => Entity Exam - -> SheetGradeSummary -- ^ `examBonusPossible` - -> SheetGradeSummary -- ^ `examBonusAchieved` + => Exam + -> Maybe Points -- ^ Bonus -> mono -- ^ `ExamPartResult`s -> Maybe ExamResultGrade -examGrade (Entity _ Exam{..}) bonusPossible bonusAchieved (otoList -> results) - | null results - = Nothing - | otherwise +examGrade Exam{..} mBonus (otoList -> results) = traverse pointsToGrade achievedPoints' where achievedPoints' :: ExamResultPoints @@ -103,37 +127,24 @@ examGrade (Entity _ Exam{..}) bonusPossible bonusAchieved (otoList -> results) withBonus :: Points -> Points withBonus ps - | Just ExamBonusPoints{..} <- examBonusRule + | Just bonusRule <- examBonusRule = if - | not bonusOnlyPassed + | maybe True not (bonusRule ^? _bonusOnlyPassed) || fmap (view passingGrade) (pointsToGrade ps) == Just (_Wrapped # True) - -> ps + roundToPoints (toRational bonusMaxPoints * bonusProp) + -> maybe id (+) mBonus ps | otherwise -> ps | otherwise = ps - where - bonusProp :: Rational - bonusProp = clamp 0 1 $ toRational (getSum (achievedPoints bonusAchieved) + scalePasses (getSum $ achievedPasses bonusAchieved)) - / toRational (getSum (sumSheetsPoints bonusPossible) + scalePasses (getSum $ numSheetsPasses bonusPossible)) - where - scalePasses :: Integer -> Points - -- ^ Rescale passes so count of all sheets with pass is worth as many points as sum of all sheets with points - scalePasses passes = fromInteger passes / (fromInteger . getSum $ numSheetsPasses bonusPossible) * (getSum $ sumSheetsPoints bonusPossible) - - roundToPoints :: forall a. HasResolution a => Rational -> Fixed a - roundToPoints = MkFixed . round . ((*) . toRational $ resolution (Proxy @a)) pointsToGrade :: Points -> Maybe ExamGrade - pointsToGrade ps - | Just ExamGradingKey{..} <- examGradingRule - = Just $ gradeFromKey examGradingKey - | otherwise - = Nothing + pointsToGrade ps = examGradingRule <&> \case + ExamGradingKey{..} + -> gradeFromKey examGradingKey where gradeFromKey :: [Points] -> ExamGrade - gradeFromKey examGradingKey' = maximum $ impureNonNull [ g | (g, b) <- lowerBounds, b <= clampMin 0 ps ] + gradeFromKey examGradingKey' = maximum $ Grade50 `ncons` [ g | (g, b) <- lowerBounds, b <= ps ] where lowerBounds :: [(ExamGrade, Points)] - lowerBounds = zip [Grade50, Grade40 ..] $ 0 : examGradingKey' + lowerBounds = zip [Grade40, Grade37 ..] examGradingKey' diff --git a/src/Utils.hs b/src/Utils.hs index a02ec0a65..f257bc312 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -241,7 +241,8 @@ stepTextCounter text notUsedT :: a -> Text notUsedT = notUsed - +fromText :: (IsString a, Textual t) => t -> a +fromText = fromString . unpack ---------- -- Bool -- diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index 1da95cd38..2ccebdbdd 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -167,6 +167,7 @@ makeLenses_ ''Invitation makeLenses_ ''ExamBonusRule makeLenses_ ''ExamGradingRule makeLenses_ ''ExamResult +makeLenses_ ''ExamBonus makeLenses_ ''ExamPart makeLenses_ ''ExamPartResult diff --git a/templates/corrections-overview.hamlet b/templates/corrections-overview.hamlet index 747f99d15..d6f118de5 100644 --- a/templates/corrections-overview.hamlet +++ b/templates/corrections-overview.hamlet @@ -57,9 +57,7 @@ $# Always iterate over orderedSheetNames for consistent sorting! Newest first, except in this table $forall shn <- orderedSheetNames - $# Links currently look ugly in table headers; used an icon as a workaround: - ^{simpleLink (toWidget iconLink) (CSheetR tid ssh csh shn SShowR)} - #{shn} + ^{simpleLink (toWidget shn) (CSheetR tid ssh csh shn SShowR)} _{MsgNrSubmissionsTotal} _{MsgNrSubmissionsNotCorrected} @@ -140,8 +138,9 @@ $# Always iterate over orderedSheetNames for consistent sorting! Newest first, except in this table $forall shn <- orderedSheetNames - #{shn} + + ^{simpleLink (toWidget shn) (CSheetR tid ssh csh shn SShowR)} ^{btnWdgt}
-

_{MsgAssignSubmissionsRandomWarning} \ No newline at end of file +

_{MsgAssignSubmissionsRandomWarning} diff --git a/templates/default-layout.lucius b/templates/default-layout.lucius index 9cb58b2b0..395b4cd01 100644 --- a/templates/default-layout.lucius +++ b/templates/default-layout.lucius @@ -366,11 +366,20 @@ input[type="button"].btn-info:hover, vertical-align: top; } +.table__td--automatic { + font-style: oblique; + color: var(--color-fontsec); +} + +.table__td--overriden { + font-weight: bold; +} + .table__th { background-color: var(--color-dark); position: relative; font-size: 16px; - color: #fff; + color: white; line-height: 1.4; padding-top: 10px; padding-bottom: 10px; @@ -378,7 +387,20 @@ input[type="button"].btn-info:hover, text-align: left; a { + color: white; text-decoration: none; + font-weight: bold; + + &:hover { + color: inherit; + } + + &::before { + content: "\f0c1"; + font-family: "Font Awesome 5 Free"; + font-weight: 900; + margin-right: 0.25em; + } } } @@ -395,11 +417,10 @@ input[type="button"].btn-info:hover, } .table__th-link { - color: white; font-weight: bold; - &:hover { - color: inherit; + &::before { + display: none; } } diff --git a/templates/exam-show.hamlet b/templates/exam-show.hamlet index f10bdd908..d3509f630 100644 --- a/templates/exam-show.hamlet +++ b/templates/exam-show.hamlet @@ -55,9 +55,10 @@ $maybe desc <- examDescription $maybe finished <- examFinished

_{MsgExamFinishedParticipant}
^{formatTimeW SelFormatDateTime finished} - $maybe closed <- examClosed -
_{MsgExamClosed} -
^{formatTimeW SelFormatDateTime closed} + $if examClosedShown + $maybe closed <- examClosed +
_{MsgExamClosed} ^{isVisible False} +
^{formatTimeW SelFormatDateTime closed} $if gradingShown $maybe gradingRule <- examGradingRule
@@ -137,7 +138,9 @@ $if gradingShown && not (null examParts) - $forall Entity partId ExamPart{examPartNumber, examPartName, examPartWeight, examPartMaxPoints} <- examParts -
_{MsgExamPartNumber} + $if partNumbersShown + + _{MsgExamPartNumber} ^{isVisible False} _{MsgExamPartName} $if showMaxPoints _{MsgExamPartMaxPoints} @@ -146,8 +149,13 @@ $if gradingShown && not (null examParts)
#{examPartNumber} - #{examPartName} + $if partNumbersShown + #{examPartNumber} + + $maybe pName <- examPartName + #{pName} + $nothing + _{MsgExamPartNumbered examPartNumber} $if showMaxPoints $maybe mPoints <- examPartMaxPoints diff --git a/templates/widgets/massinput/examParts/layout.hamlet b/templates/widgets/massinput/examParts/layout.hamlet index 1a89a8a11..86f968148 100644 --- a/templates/widgets/massinput/examParts/layout.hamlet +++ b/templates/widgets/massinput/examParts/layout.hamlet @@ -5,9 +5,7 @@ $newline never _{MsgExamPartNumber} # - - _{MsgExamPartName} # - + _{MsgExamPartName} _{MsgExamPartMaxPoints} _{MsgExamPartWeight} #