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

feat(exams): automatically compute examResults

Browse Source 
BREAKING CHANGE: examPartName no longer required
This commit is contained in:
Gregor Kleen 2019-09-18 17:17:18 +02:00
parent fb1e42dc69
commit ea5a398bab
13 changed files with 361 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
messages/uniworx/de.msg
View File

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

10
models/exams
View File

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

9
src/Audit/Types.hs
View File

@ -33,6 +33,15 @@ data Transaction
, transactionUser :: UserId
}
| TransactionExamBonusEdit
{ transactionExam :: ExamId
, transactionUser :: UserId
}
| TransactionExamBonusDeleted
{ transactionExam :: ExamId
, transactionUser :: UserId
}
| TransactionExamResultEdit
{ transactionExam :: ExamId
, transactionUser :: UserId

7
src/Handler/Exam/Form.hs
View File

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

10
src/Handler/Exam/Show.hs
View File

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

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

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

69
src/Handler/Utils/Exam.hs
View File

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

3
src/Utils.hs
View File

@ -241,7 +241,8 @@ stepTextCounter text
notUsedT :: a -> Text
notUsedT = notUsed
fromText :: (IsString a, Textual t) => t -> a
fromText = fromString . unpack
----------
-- Bool --

1
src/Utils/Lens.hs
View File

@ -167,6 +167,7 @@ makeLenses_ ''Invitation
makeLenses_ ''ExamBonusRule
makeLenses_ ''ExamGradingRule
makeLenses_ ''ExamResult
makeLenses_ ''ExamBonus
makeLenses_ ''ExamPart
makeLenses_ ''ExamPartResult

9
templates/corrections-overview.hamlet
View File

@ -57,9 +57,7 @@
$# Always iterate over orderedSheetNames for consistent sorting! Newest first, except in this table
$forall shn <- orderedSheetNames
<th .table__th colspan=5>
$# 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)}
<tr .table__row .table__row--head>
<th .table__th>_{MsgNrSubmissionsTotal}
<th .table__th>_{MsgNrSubmissionsNotCorrected}
@ -140,8 +138,9 @@
<th colspan=3>
$# Always iterate over orderedSheetNames for consistent sorting! Newest first, except in this table
$forall shn <- orderedSheetNames
<th .table__th colspan=5>#{shn}
<th .table__th colspan=5>
^{simpleLink (toWidget shn) (CSheetR tid ssh csh shn SShowR)}
^{btnWdgt}
<div>
<p>_{MsgAssignSubmissionsRandomWarning}
<p>_{MsgAssignSubmissionsRandomWarning}

29
templates/default-layout.lucius
View File

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

20
templates/exam-show.hamlet
View File

@ -55,9 +55,10 @@ $maybe desc <- examDescription
$maybe finished <- examFinished
<dt .deflist__dt>_{MsgExamFinishedParticipant}
<dd .deflist__dd>^{formatTimeW SelFormatDateTime finished}
$maybe closed <- examClosed
<dt .deflist__dt>_{MsgExamClosed}
<dd .deflist__dd>^{formatTimeW SelFormatDateTime closed}
$if examClosedShown
$maybe closed <- examClosed
<dt .deflist__dt>_{MsgExamClosed} ^{isVisible False}
<dd .deflist__dd>^{formatTimeW SelFormatDateTime closed}
$if gradingShown
$maybe gradingRule <- examGradingRule
<dt .deflist__dt>
@ -137,7 +138,9 @@ $if gradingShown && not (null examParts)
<table .table .table--striped .table--hover >
<thead>
<tr .table__row .table__row--head>
<th .table__th>_{MsgExamPartNumber}
$if partNumbersShown
<th .table__th>
_{MsgExamPartNumber} ^{isVisible False}
<th .table__th>_{MsgExamPartName}
$if showMaxPoints
<th .table__th>_{MsgExamPartMaxPoints}
@ -146,8 +149,13 @@ $if gradingShown && not (null examParts)
<tbody>
$forall Entity partId ExamPart{examPartNumber, examPartName, examPartWeight, examPartMaxPoints} <- examParts
<tr .table__row>
<td .table__td>#{examPartNumber}
<td .table__td>#{examPartName}
$if partNumbersShown
<td .table__td>#{examPartNumber}
<td .table__td>
$maybe pName <- examPartName
#{pName}
$nothing
_{MsgExamPartNumbered examPartNumber}
$if showMaxPoints
<td .table__td>
$maybe mPoints <- examPartMaxPoints

4
templates/widgets/massinput/examParts/layout.hamlet
View File

@ -5,9 +5,7 @@ $newline never
<th>
_{MsgExamPartNumber} #
<span .form-group__required-marker>
<th>
_{MsgExamPartName} #
<span .form-group__required-marker>
<th>_{MsgExamPartName}
<th>_{MsgExamPartMaxPoints}
<th>
_{MsgExamPartWeight} #