feat(exams): CRU (no D) for exams
This commit is contained in:
Gregor Kleen
parent
d054370b29
commit
67a50c9e87
@ -839,6 +839,7 @@ MenuTutorialEdit: Tutorium editieren
|
||||
MenuTutorialComm: Mitteilung an Teilnehmer
|
||||
MenuExamList: Klausuren
|
||||
MenuExamNew: Neue Klausur anlegen
|
||||
MenuExamEdit: Bearbeiten
|
||||
|
||||
AuthPredsInfo: Um eigene Veranstaltungen aus Sicht der Teilnehmer anzusehen, können Veranstalter und Korrektoren hier die Prüfung ihrer erweiterten Berechtigungen temporär deaktivieren. Abgewählte Prädikate schlagen immer fehl. Abgewählte Prädikate werden also nicht geprüft um Zugriffe zu gewähren, welche andernfalls nicht erlaubt wären. Diese Einstellungen gelten nur temporär bis Ihre Sitzung abgelaufen ist, d.h. bis ihr Browser-Cookie abgelaufen ist. Durch Abwahl von Prädikaten kann man sich höchstens temporär aussperren.
|
||||
AuthPredsActive: Aktive Authorisierungsprädikate
|
||||
@ -979,6 +980,7 @@ TutorialsHeading: Tutorien
|
||||
TutorialEdit: Bearbeiten
|
||||
TutorialDelete: Löschen
|
||||
|
||||
CourseExams: Klausuren
|
||||
CourseTutorials: Übungen
|
||||
|
||||
ParticipantsN n@Int: Teilnehmer
|
||||
@ -1000,6 +1002,7 @@ TutorialNew: Neues Tutorium
|
||||
|
||||
TutorialNameTaken tutn@TutorialName: Es existiert bereits anderes Tutorium mit Namen #{tutn}
|
||||
TutorialCreated tutn@TutorialName: Tutorium #{tutn} erfolgreich angelegt
|
||||
TutorialEdited tutn@TutorialName: Tutiorium #{tutn} erfolgreich bearbeitet
|
||||
|
||||
TutorialEditHeading tutn@TutorialName: #{tutn} bearbeiten
|
||||
|
||||
@ -1037,10 +1040,14 @@ ExamRegisterFromTip: Zeitpunkt ab dem sich Kursteilnehmer selbständig zur Klaus
|
||||
ExamRegisterTo: Anmeldung bis
|
||||
ExamDeregisterUntil: Abmeldung bis
|
||||
ExamPublishOccurrenceAssignments: Terminzuteilung den Teilnehmern mitteilen um
|
||||
ExamPublishOccurrenceAssignmentsParticipant: Terminzuteilung einsehbar ab
|
||||
ExamFinished: Bewertung abgeschlossen ab
|
||||
ExamFinishedParticipant: Bewertung vorrausichtlich abgeschlossen
|
||||
ExamFinishedTip: Zeitpunkt zu dem Klausurergebnisse den Teilnehmern gemeldet werden
|
||||
ExamClosed: Noten stehen fest ab
|
||||
ExamClosedTip: Zeitpunkt ab dem keine Änderungen an den Ergebnissen zulässig sind; Prüfungsämter bekommen Einsicht
|
||||
ExamShowGrades: Noten anzeigen
|
||||
ExamShowGradesTip: Soll den Teilnehmern ihre genaue Note angezeigt werden, oder sollen sie nur informiert werden, ob sie bestanden haben?
|
||||
ExamPublicStatistics: Statistik veröffentlichen
|
||||
ExamPublicStatisticsTip: Soll die statistische Auswertung auch den Teilnehmer angezeigt werden, sobald diese ihre Noten einsehen können?
|
||||
ExamGradingRule: Notenberechnung
|
||||
@ -1057,11 +1064,14 @@ ExamBonusRule: Klausurbonus aus Übungsbetrieb
|
||||
ExamNoBonus': Kein Bonus
|
||||
ExamBonusPoints': Umrechnung von Übungspunkten
|
||||
|
||||
ExamEditHeading examn@ExamName: #{examn} bearbeiten
|
||||
|
||||
ExamBonusMaxPoints: Maximal erreichbare Klausur-Bonuspunkte
|
||||
ExamBonusMaxPointsNonPositive: Maximaler Klausurbonus muss positiv und größer null sein
|
||||
ExamBonusOnlyPassed: Bonus nur nach Bestehen anrechnen
|
||||
|
||||
ExamOccurrenceRule: Automatische Terminzuteilung
|
||||
ExamOccurrenceRuleParticipant: Terminzuteilung
|
||||
ExamRoomManual': Keine automatische Zuteilung
|
||||
ExamRoomSurname': Nach Nachname
|
||||
ExamRoomMatriculation': Nach Matrikelnummer
|
||||
@ -1072,10 +1082,12 @@ ExamRoomAlreadyExists: Prüfung ist bereits eingetragen
|
||||
ExamRoom: Raum
|
||||
ExamRoomCapacity: Kapazität
|
||||
ExamRoomCapacityNonPositive: Kapazität muss positiv und größer null sein
|
||||
ExamRoomTime: Termin
|
||||
ExamRoomStart: Beginn
|
||||
ExamRoomEnd: Ende
|
||||
ExamRoomDescription: Beschreibung
|
||||
ExamTimeTip: Nur zur Information der Studierenden, die tatsächliche Zeitangabe erfolgt pro Prüfung
|
||||
ExamRoomRegistered: Zugeteilt
|
||||
|
||||
ExamFormTimes: Zeiten
|
||||
ExamFormOccurrences: Prüfungstermine
|
||||
@ -1092,6 +1104,18 @@ ExamPartAlreadyExists: Teilaufgabe mit diesem Namen existiert bereits
|
||||
ExamPartName: Name
|
||||
ExamPartMaxPoints: Maximalpunktzahl
|
||||
ExamPartWeight: Gewichtung
|
||||
ExamPartResultPoints: Erreichte Punkte
|
||||
|
||||
ExamNameTaken exam@ExamName: Es existiert bereits eine Klausur mit Namen #{exam}
|
||||
ExamCreated exam@ExamName: Klausur #{exam} erfolgreich angelegt
|
||||
ExamCreated exam@ExamName: Klausur #{exam} erfolgreich angelegt
|
||||
ExamEdited exam@ExamName: Klausur #{exam} erfolgreich bearbeitet
|
||||
|
||||
ExamNoShow: Nicht erschienen
|
||||
ExamVoided: Entwertet
|
||||
|
||||
ExamBonusPoints possible@Points: Maximal #{showFixed True possible} Klausurpunkte
|
||||
ExamBonusPointsPassed possible@Points: Maximal #{showFixed True possible} Klausurpunkte, falls die Klausur auch ohne Bonus bereits bestanden ist
|
||||
|
||||
ExamPassed: Bestanden
|
||||
ExamNotPassed: Nicht bestanden
|
||||
ExamResult: Klausurergebnis
|
||||
14
models/exams
14
models/exams
@ -14,6 +14,7 @@ Exam
|
||||
finished UTCTime Maybe -- Grades shown to students, `ExamCorrector`s locked out
|
||||
closed UTCTime Maybe -- Prüfungsamt hat Einsicht (notification)
|
||||
publicStatistics Bool
|
||||
showGrades Bool
|
||||
description Html Maybe
|
||||
UniqueExam course name
|
||||
ExamPart
|
||||
@ -32,13 +33,18 @@ ExamOccurrence
|
||||
ExamRegistration
|
||||
exam ExamId
|
||||
user UserId
|
||||
occurance ExamOccurrenceId Maybe
|
||||
occurrence ExamOccurrenceId Maybe
|
||||
UniqueExamRegistration exam user
|
||||
ExamResult
|
||||
ExamPartResult
|
||||
examPart ExamPartId
|
||||
user UserId
|
||||
result ExamPartResult
|
||||
UniqueExamResult examPart user
|
||||
result ExamResultPoints
|
||||
UniqueExamPartResult examPart user
|
||||
ExamResult
|
||||
exam ExamId
|
||||
user UserId
|
||||
result ExamResultGrade
|
||||
UniqueExamResult exam user
|
||||
ExamCorrector
|
||||
exam ExamId
|
||||
user UserId
|
||||
|
||||
1
routes
1
routes
@ -141,6 +141,7 @@
|
||||
/exams/new CExamNewR GET POST
|
||||
/exams/#ExamName ExamR:
|
||||
/show EShowR GET !time
|
||||
/edit EEditR GET POST
|
||||
/corrector-invite ECInviteR GET POST
|
||||
|
||||
|
||||
|
||||
@ -43,6 +43,8 @@ decCryptoIDs [ ''SubmissionId
|
||||
, ''SystemMessageId
|
||||
, ''SystemMessageTranslationId
|
||||
, ''StudyFeaturesId
|
||||
, ''ExamOccurrenceId
|
||||
, ''ExamPartId
|
||||
]
|
||||
|
||||
instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => PathPiece (E.CryptoID namespace (CI FilePath)) where
|
||||
|
||||
@ -1456,6 +1456,7 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb (CourseR tid ssh csh CExamNewR) = return ("Anlegen", Just $ CourseR tid ssh csh CExamListR)
|
||||
|
||||
breadcrumb (CExamR tid ssh csh examn EShowR) = return (CI.original examn, Just $ CourseR tid ssh csh CExamListR)
|
||||
breadcrumb (CExamR tid ssh csh examn EEditR) = return ("Bearbeiten", Just $ CExamR tid ssh csh examn EShowR)
|
||||
|
||||
breadcrumb (CTutorialR tid ssh csh tutn TUsersR) = return (CI.original tutn, Just $ CourseR tid ssh csh CTutorialListR)
|
||||
breadcrumb (CTutorialR tid ssh csh tutn TEditR) = return ("Bearbeiten", Just $ CTutorialR tid ssh csh tutn TUsersR)
|
||||
@ -1885,7 +1886,7 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
return $ sheet E.^. SheetName
|
||||
anyM sheetNames (sheetAccess . E.unValue)
|
||||
anyM sheetNames $ sheetAccess . E.unValue
|
||||
in runDB $ lecturerAccess `or2M` existsVisible
|
||||
}
|
||||
] ++ pageActions (CourseR tid ssh csh SheetListR) ++
|
||||
@ -1903,7 +1904,18 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CExamListR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
, menuItemAccessCallback' =
|
||||
let lecturerAccess = hasWriteAccessTo $ CourseR tid ssh csh CExamNewR
|
||||
examAccess examn = hasReadAccessTo $ CExamR tid ssh csh examn EShowR
|
||||
existsVisible = do
|
||||
examNames <- E.select . E.from $ \(course `E.InnerJoin` exam) -> do
|
||||
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
||||
E.where_ $ course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
return $ exam E.^. ExamName
|
||||
anyM examNames $ examAccess . E.unValue
|
||||
in runDB $ lecturerAccess `or2M` existsVisible
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
@ -2119,6 +2131,16 @@ pageActions (CourseR tid ssh csh CExamListR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CExamR tid ssh csh examn EShowR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuExamEdit
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CExamR tid ssh csh examn EEditR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CSheetR tid ssh csh shn SShowR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
|
||||
@ -407,6 +407,49 @@ getCShowR tid ssh csh = do
|
||||
& defaultSorting [SortAscBy "type", SortAscBy "name"]
|
||||
(Any hasTutorials, tutorialTable) <- runDB $ dbTable tutorialDBTableValidator tutorialDBTable
|
||||
|
||||
let
|
||||
examDBTable = DBTable{..}
|
||||
where
|
||||
dbtSQLQuery exam = do
|
||||
E.where_ $ exam E.^. ExamCourse E.==. E.val cid
|
||||
return exam
|
||||
dbtRowKey = (E.^. ExamId)
|
||||
dbtProj r@DBRow{ dbrOutput = Entity _ Exam{..} } = do
|
||||
guardM . hasReadAccessTo $ CExamR tid ssh csh examName EShowR
|
||||
return r
|
||||
dbtColonnade = dbColonnade $ mconcat
|
||||
[ sortable (Just "name") (i18nCell MsgExamName) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> indicatorCell <> anchorCell (CExamR tid ssh csh examName EShowR) (toWidget examName)
|
||||
, sortable (Just "register-from") (i18nCell MsgExamRegisterFrom) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterFrom
|
||||
, sortable (Just "register-to") (i18nCell MsgExamRegisterTo) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo
|
||||
, sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> cell $ do
|
||||
startT <- formatTime SelFormatDateTime examStart
|
||||
endT <- traverse (\examEnd' -> formatTime (bool SelFormatDateTime SelFormatTime $ ((==) `on` utctDay) examStart examEnd') examEnd') examEnd
|
||||
[whamlet|
|
||||
$newline never
|
||||
#{startT}
|
||||
$maybe endT' <- endT
|
||||
\ – #{endT'}
|
||||
|]
|
||||
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
[ ("name", SortColumn $ \exam -> exam E.^. ExamName )
|
||||
, ("time", SortColumn $ \exam -> exam E.^. ExamStart )
|
||||
, ("register-from", SortColumn $ \exam -> exam E.^. ExamRegisterFrom )
|
||||
, ("register-to", SortColumn $ \exam -> exam E.^. ExamRegisterTo )
|
||||
, ("visible", SortColumn $ \exam -> exam E.^. ExamVisibleFrom )
|
||||
]
|
||||
dbtFilter = Map.empty
|
||||
dbtFilterUI = const mempty
|
||||
dbtStyle = def
|
||||
dbtParams = def
|
||||
dbtIdent :: Text
|
||||
dbtIdent = "exams"
|
||||
|
||||
examDBTableValidator = def
|
||||
& defaultSorting [SortAscBy "time"]
|
||||
(Any hasExams, examTable) <- runDB $ dbTable examDBTableValidator examDBTable
|
||||
|
||||
siteLayout (toWgt $ courseName course) $ do
|
||||
setTitleI $ prependCourseTitle tid ssh csh (""::Text)
|
||||
$(widgetFile "course")
|
||||
|
||||
@ -10,11 +10,12 @@ import Handler.Utils.Invitations
|
||||
import Handler.Utils.Table.Cells
|
||||
import Jobs.Queue
|
||||
|
||||
import Utils.Lens
|
||||
import Utils.Lens hiding (parts)
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import Data.Map ((!))
|
||||
import Data.Map ((!), (!?))
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
@ -22,6 +23,8 @@ import Data.Aeson hiding (Result(..))
|
||||
import Text.Hamlet (ihamlet)
|
||||
import Text.Blaze.Html.Renderer.String (renderHtml)
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
|
||||
getCExamListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCExamListR tid ssh csh = do
|
||||
@ -57,6 +60,9 @@ getCExamListR tid ssh csh = do
|
||||
dbtSorting = Map.fromList
|
||||
[ ("name", SortColumn $ \exam -> exam E.^. ExamName )
|
||||
, ("time", SortColumn $ \exam -> exam E.^. ExamStart )
|
||||
, ("register-from", SortColumn $ \exam -> exam E.^. ExamRegisterFrom )
|
||||
, ("register-to", SortColumn $ \exam -> exam E.^. ExamRegisterTo )
|
||||
, ("visible", SortColumn $ \exam -> exam E.^. ExamVisibleFrom )
|
||||
]
|
||||
dbtFilter = Map.empty
|
||||
dbtFilterUI = const mempty
|
||||
@ -147,6 +153,7 @@ data ExamForm = ExamForm
|
||||
, efFinished :: Maybe UTCTime
|
||||
, efClosed :: Maybe UTCTime
|
||||
, efOccurrences :: Set ExamOccurrenceForm
|
||||
, efShowGrades :: Bool
|
||||
, efPublicStatistics :: Bool
|
||||
, efGradingRule :: ExamGradingRule
|
||||
, efBonusRule :: ExamBonusRule
|
||||
@ -156,7 +163,8 @@ data ExamForm = ExamForm
|
||||
}
|
||||
|
||||
data ExamOccurrenceForm = ExamOccurrenceForm
|
||||
{ eofRoom :: Text
|
||||
{ eofId :: Maybe CryptoUUIDExamOccurrence
|
||||
, eofRoom :: Text
|
||||
, eofCapacity :: Natural
|
||||
, eofStart :: UTCTime
|
||||
, eofEnd :: Maybe UTCTime
|
||||
@ -164,7 +172,8 @@ data ExamOccurrenceForm = ExamOccurrenceForm
|
||||
} deriving (Read, Show, Eq, Ord, Generic, Typeable)
|
||||
|
||||
data ExamPartForm = ExamPartForm
|
||||
{ epfName :: ExamPartName
|
||||
{ epfId :: Maybe CryptoUUIDExamPart
|
||||
, epfName :: ExamPartName
|
||||
, epfMaxPoints :: Maybe Points
|
||||
, epfWeight :: Rational
|
||||
} deriving (Read, Show, Eq, Ord, Generic, Typeable)
|
||||
@ -198,6 +207,7 @@ examForm template html = do
|
||||
<* aformSection MsgExamFormOccurrences
|
||||
<*> examOccurrenceForm (efOccurrences <$> template)
|
||||
<* aformSection MsgExamFormAutomaticFunctions
|
||||
<*> (fromMaybe False <$> aopt checkBoxField (fslI MsgExamShowGrades & setTooltip MsgExamShowGradesTip) (Just . efShowGrades <$> template))
|
||||
<*> (fromMaybe False <$> aopt checkBoxField (fslI MsgExamPublicStatistics & setTooltip MsgExamPublicStatisticsTip) (Just . efPublicStatistics <$> template))
|
||||
<*> examGradingRuleForm (efGradingRule <$> template)
|
||||
<*> bonusRuleForm (efBonusRule <$> template)
|
||||
@ -263,6 +273,7 @@ examOccurrenceForm prev = wFormToAForm $ do
|
||||
fmap (fmap Set.fromList) . massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' (fslI MsgExamOccurrences & setTooltip MsgMassInputTip) True $ Set.toList <$> prev
|
||||
where
|
||||
examOccurrenceForm' nudge mPrev csrf = do
|
||||
(eofIdRes, eofIdView) <- mopt hiddenField ("" & addName (nudge "id")) (Just $ eofId =<< mPrev)
|
||||
(eofRoomRes, eofRoomView) <- mpreq textField ("" & addName (nudge "name")) (eofRoom <$> mPrev)
|
||||
(eofCapacityRes, eofCapacityView) <- mpreq (posIntFieldI MsgExamRoomCapacityNonPositive) ("" & addName (nudge "capacity")) (eofCapacity <$> mPrev)
|
||||
(eofStartRes, eofStartView) <- mpreq utcTimeField ("" & addName (nudge "start")) (eofStart <$> mPrev)
|
||||
@ -270,7 +281,8 @@ examOccurrenceForm prev = wFormToAForm $ do
|
||||
(eofDescRes, eofDescView) <- mopt htmlFieldSmall ("" & addName (nudge "description")) (eofDescription <$> mPrev)
|
||||
|
||||
return ( ExamOccurrenceForm
|
||||
<$> eofRoomRes
|
||||
<$> eofIdRes
|
||||
<*> eofRoomRes
|
||||
<*> eofCapacityRes
|
||||
<*> eofStartRes
|
||||
<*> eofEndRes
|
||||
@ -301,12 +313,14 @@ examPartsForm prev = wFormToAForm $ do
|
||||
fmap (fmap Set.fromList) . massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' (fslI MsgExamParts & setTooltip MsgMassInputTip) True $ Set.toList <$> prev
|
||||
where
|
||||
examPartForm' nudge mPrev csrf = do
|
||||
(epfIdRes, epfIdView) <- mopt hiddenField ("" & addName (nudge "id")) (Just $ epfId =<< mPrev)
|
||||
(epfNameRes, epfNameView) <- mpreq ciField ("" & 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)
|
||||
|
||||
return ( ExamPartForm
|
||||
<$> epfNameRes
|
||||
<$> epfIdRes
|
||||
<*> epfNameRes
|
||||
<*> epfMaxPointsRes
|
||||
<*> epfWeightRes
|
||||
, $(widgetFile "widgets/massinput/examParts/form")
|
||||
@ -325,12 +339,114 @@ examPartsForm prev = wFormToAForm $ do
|
||||
miIdent' :: Text
|
||||
miIdent' = "exam-parts"
|
||||
|
||||
examFormTemplate :: Entity Exam -> DB ExamForm
|
||||
examFormTemplate (Entity eId Exam{..}) = do
|
||||
parts <- selectList [ ExamPartExam ==. eId ] []
|
||||
occurrences <- selectList [ ExamOccurrenceExam ==. eId ] []
|
||||
correctors <- selectList [ ExamCorrectorExam ==. eId ] []
|
||||
invitations <- map (\(email, InvDBDataExamCorrector) -> email) <$> sourceInvitationsList eId
|
||||
|
||||
parts' <- forM parts $ \(Entity pid part) -> (,) <$> encrypt pid <*> pure part
|
||||
occurrences' <- forM occurrences $ \(Entity oid occ) -> (,) <$> encrypt oid <*> pure occ
|
||||
|
||||
return ExamForm
|
||||
{ efName = examName
|
||||
, efGradingRule = examGradingRule
|
||||
, efBonusRule = examBonusRule
|
||||
, efOccurrenceRule = examOccurrenceRule
|
||||
, efVisibleFrom = examVisibleFrom
|
||||
, efRegisterFrom = examRegisterFrom
|
||||
, efRegisterTo = examRegisterTo
|
||||
, efDeregisterUntil = examDeregisterUntil
|
||||
, efPublishOccurrenceAssignments = examPublishOccurrenceAssignments
|
||||
, efStart = examStart
|
||||
, efEnd = examEnd
|
||||
, efFinished = examFinished
|
||||
, efClosed = examClosed
|
||||
, efShowGrades = examShowGrades
|
||||
, efPublicStatistics = examPublicStatistics
|
||||
, efDescription = examDescription
|
||||
, efOccurrences = Set.fromList $ do
|
||||
(Just -> eofId, ExamOccurrence{..}) <- occurrences'
|
||||
return ExamOccurrenceForm
|
||||
{ eofId
|
||||
, eofRoom = examOccurrenceRoom
|
||||
, eofCapacity = examOccurrenceCapacity
|
||||
, eofStart = examOccurrenceStart
|
||||
, eofEnd = examOccurrenceEnd
|
||||
, eofDescription = examOccurrenceDescription
|
||||
}
|
||||
, efExamParts = Set.fromList $ do
|
||||
(Just -> epfId, ExamPart{..}) <- parts'
|
||||
return ExamPartForm
|
||||
{ epfId
|
||||
, epfName = examPartName
|
||||
, epfMaxPoints = examPartMaxPoints
|
||||
, epfWeight = examPartWeight
|
||||
}
|
||||
, efCorrectors = Set.unions
|
||||
[ Set.fromList $ map Left invitations
|
||||
, Set.fromList . map Right $ do
|
||||
Entity _ ExamCorrector{..} <- correctors
|
||||
return examCorrectorUser
|
||||
]
|
||||
}
|
||||
|
||||
examTemplate :: CourseId -> DB (Maybe ExamForm)
|
||||
examTemplate cid = runMaybeT $ do
|
||||
newCourse <- MaybeT $ get cid
|
||||
|
||||
[(Entity _ oldCourse, Entity _ oldExam)] <- lift . E.select . E.from $ \(course `E.InnerJoin` exam) -> do
|
||||
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
||||
E.where_ $ ( course E.^. CourseShorthand E.==. E.val (courseShorthand newCourse)
|
||||
E.||. course E.^. CourseName E.==. E.val (courseName newCourse)
|
||||
)
|
||||
E.&&. course E.^. CourseSchool E.==. E.val (courseSchool newCourse)
|
||||
E.where_ . E.not_ . E.exists . E.from $ \exam' -> do
|
||||
E.where_ $ exam' E.^. ExamCourse E.==. E.val cid
|
||||
E.where_ $ exam E.^. ExamName E.==. exam' E.^. ExamName
|
||||
E.where_ . E.not_ . E.isNothing $ exam E.^. ExamVisibleFrom
|
||||
E.limit 1
|
||||
E.orderBy [ E.desc $ course E.^. CourseTerm, E.asc $ exam E.^. ExamVisibleFrom ]
|
||||
return (course, exam)
|
||||
|
||||
oldTerm <- MaybeT . get $ courseTerm oldCourse
|
||||
newTerm <- MaybeT . get $ courseTerm newCourse
|
||||
|
||||
let
|
||||
dateOffset = over _utctDay . addDays $ (diffDays `on` termLectureEnd) newTerm oldTerm
|
||||
|
||||
return ExamForm
|
||||
{ efName = examName oldExam
|
||||
, efGradingRule = examGradingRule oldExam
|
||||
, efBonusRule = examBonusRule oldExam
|
||||
, efOccurrenceRule = examOccurrenceRule oldExam
|
||||
, efVisibleFrom = dateOffset <$> examVisibleFrom oldExam
|
||||
, efRegisterFrom = dateOffset <$> examRegisterFrom oldExam
|
||||
, efRegisterTo = dateOffset <$> examRegisterTo oldExam
|
||||
, efDeregisterUntil = dateOffset <$> examDeregisterUntil oldExam
|
||||
, efPublishOccurrenceAssignments = dateOffset $ examPublishOccurrenceAssignments oldExam
|
||||
, efStart = dateOffset $ examStart oldExam
|
||||
, efEnd = dateOffset <$> examEnd oldExam
|
||||
, efFinished = dateOffset <$> examFinished oldExam
|
||||
, efClosed = dateOffset <$> examClosed oldExam
|
||||
, efShowGrades = examShowGrades oldExam
|
||||
, efPublicStatistics = examPublicStatistics oldExam
|
||||
, efDescription = examDescription oldExam
|
||||
, efOccurrences = Set.empty
|
||||
, efExamParts = Set.empty
|
||||
, efCorrectors = Set.empty
|
||||
}
|
||||
|
||||
getCExamNewR, postCExamNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCExamNewR = postCExamNewR
|
||||
postCExamNewR tid ssh csh = do
|
||||
cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
(cid, template) <- runDB $ do
|
||||
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
template <- examTemplate cid
|
||||
return (cid, template)
|
||||
|
||||
((newExamResult, newExamWidget), newExamEnctype) <- runFormPost $ examForm Nothing
|
||||
((newExamResult, newExamWidget), newExamEnctype) <- runFormPost $ examForm template
|
||||
|
||||
formResult newExamResult $ \ExamForm{..} -> do
|
||||
insertRes <- runDBJobs $ do
|
||||
@ -349,6 +465,7 @@ postCExamNewR tid ssh csh = do
|
||||
, examEnd = efEnd
|
||||
, examFinished = efFinished
|
||||
, examClosed = efClosed
|
||||
, examShowGrades = efShowGrades
|
||||
, examPublicStatistics = efPublicStatistics
|
||||
, examDescription = efDescription
|
||||
}
|
||||
@ -398,5 +515,179 @@ postCExamNewR tid ssh csh = do
|
||||
}
|
||||
$(widgetFile "exam-new")
|
||||
|
||||
getEEditR, postEEditR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
|
||||
getEEditR = postEEditR
|
||||
postEEditR tid ssh csh examn = do
|
||||
(cid, eId, template) <- runDB $ do
|
||||
(cid, exam@(Entity eId _)) <- fetchCourseIdExam tid ssh csh examn
|
||||
|
||||
template <- examFormTemplate exam
|
||||
|
||||
return (cid, eId, template)
|
||||
|
||||
((editExamResult, editExamWidget), editExamEnctype) <- runFormPost . examForm $ Just template
|
||||
|
||||
formResult editExamResult $ \ExamForm{..} -> do
|
||||
insertRes <- runDBJobs $ do
|
||||
insertRes <- myReplaceUnique eId Exam
|
||||
{ examCourse = cid
|
||||
, examName = efName
|
||||
, examGradingRule = efGradingRule
|
||||
, examBonusRule = efBonusRule
|
||||
, examOccurrenceRule = efOccurrenceRule
|
||||
, examVisibleFrom = efVisibleFrom
|
||||
, examRegisterFrom = efRegisterFrom
|
||||
, examRegisterTo = efRegisterTo
|
||||
, examDeregisterUntil = efDeregisterUntil
|
||||
, examPublishOccurrenceAssignments = efPublishOccurrenceAssignments
|
||||
, examStart = efStart
|
||||
, examEnd = efEnd
|
||||
, examFinished = efFinished
|
||||
, examClosed = efClosed
|
||||
, examPublicStatistics = efPublicStatistics
|
||||
, examShowGrades = efShowGrades
|
||||
, examDescription = efDescription
|
||||
}
|
||||
|
||||
when (is _Nothing insertRes) $ do
|
||||
occIds <- fmap catMaybes . forM (Set.toList efOccurrences) $ traverse decrypt . eofId
|
||||
deleteWhere [ ExamOccurrenceExam ==. eId, ExamOccurrenceId /<-. occIds ]
|
||||
forM_ (Set.toList efOccurrences) $ \case
|
||||
ExamOccurrenceForm{ eofId = Nothing, .. } -> insert_
|
||||
ExamOccurrence
|
||||
{ examOccurrenceExam = eId
|
||||
, examOccurrenceRoom = eofRoom
|
||||
, examOccurrenceCapacity = eofCapacity
|
||||
, examOccurrenceStart = eofStart
|
||||
, examOccurrenceEnd = eofEnd
|
||||
, examOccurrenceDescription = eofDescription
|
||||
}
|
||||
ExamOccurrenceForm{ .. } -> void . runMaybeT $ do
|
||||
cID <- hoistMaybe eofId
|
||||
eofId' <- decrypt cID
|
||||
oldOcc <- MaybeT $ get eofId'
|
||||
guard $ examOccurrenceExam oldOcc == eId
|
||||
lift $ replace eofId' ExamOccurrence
|
||||
{ examOccurrenceExam = eId
|
||||
, examOccurrenceRoom = eofRoom
|
||||
, examOccurrenceCapacity = eofCapacity
|
||||
, examOccurrenceStart = eofStart
|
||||
, examOccurrenceEnd = eofEnd
|
||||
, examOccurrenceDescription = eofDescription
|
||||
}
|
||||
|
||||
|
||||
pIds <- fmap catMaybes . forM (Set.toList efExamParts) $ traverse decrypt . epfId
|
||||
deleteWhere [ ExamPartExam ==. eId, ExamPartId /<-. pIds ]
|
||||
forM_ (Set.toList efExamParts) $ \case
|
||||
ExamPartForm{ epfId = Nothing, .. } -> insert_
|
||||
ExamPart
|
||||
{ examPartExam = eId
|
||||
, examPartName = epfName
|
||||
, examPartMaxPoints = epfMaxPoints
|
||||
, examPartWeight = epfWeight
|
||||
}
|
||||
ExamPartForm{ .. } -> void . runMaybeT $ do
|
||||
cID <- hoistMaybe epfId
|
||||
epfId' <- decrypt cID
|
||||
oldPart <- MaybeT $ get epfId'
|
||||
guard $ examPartExam oldPart == eId
|
||||
lift $ replace epfId' ExamPart
|
||||
{ examPartExam = eId
|
||||
, examPartName = epfName
|
||||
, examPartMaxPoints = epfMaxPoints
|
||||
, examPartWeight = epfWeight
|
||||
}
|
||||
|
||||
|
||||
let (invites, adds) = partitionEithers $ Set.toList efCorrectors
|
||||
|
||||
deleteWhere [ ExamCorrectorExam ==. eId ]
|
||||
insertMany_ $ map (ExamCorrector eId) adds
|
||||
|
||||
deleteWhere [ InvitationFor ==. invRef @ExamCorrector eId, InvitationEmail /<-. invites ]
|
||||
sinkInvitationsF examCorrectorInvitationConfig $ map (, eId, (InvDBDataExamCorrector, InvTokenDataExamCorrector)) invites
|
||||
|
||||
return insertRes
|
||||
|
||||
case insertRes of
|
||||
Just _ -> addMessageI Error $ MsgExamNameTaken efName
|
||||
Nothing -> do
|
||||
addMessageI Success $ MsgExamEdited efName
|
||||
redirect $ CExamR tid ssh csh efName EShowR
|
||||
|
||||
let heading = prependCourseTitle tid ssh csh . MsgExamEditHeading $ efName template
|
||||
|
||||
siteLayoutMsg heading $ do
|
||||
setTitleI heading
|
||||
let
|
||||
editExamForm = wrapForm editExamWidget def
|
||||
{ formMethod = POST
|
||||
, formAction = Just . SomeRoute $ CExamR tid ssh csh examn EEditR
|
||||
, formEncoding = editExamEnctype
|
||||
}
|
||||
$(widgetFile "exam-edit")
|
||||
|
||||
|
||||
getEShowR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
|
||||
getEShowR = error "getExamShowR"
|
||||
getEShowR tid ssh csh examn = do
|
||||
cTime <- liftIO getCurrentTime
|
||||
mUid <- maybeAuthId
|
||||
|
||||
(Entity _ Exam{..}, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences) <- runDB $ do
|
||||
exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn
|
||||
|
||||
let examVisible = NTop (Just cTime) >= NTop examVisibleFrom
|
||||
|
||||
let gradingVisible = NTop (Just cTime) >= NTop examFinished
|
||||
gradingShown <- or2M (return gradingVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR
|
||||
|
||||
let occurrenceAssignmentsVisible = cTime >= examPublishOccurrenceAssignments
|
||||
occurrenceAssignmentsShown <- or2M (return occurrenceAssignmentsVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR
|
||||
|
||||
parts <- selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
|
||||
|
||||
resultsRaw <- for mUid $ \uid ->
|
||||
E.select . E.from $ \examPartResult -> do
|
||||
E.where_ $ examPartResult E.^. ExamPartResultUser E.==. E.val uid
|
||||
E.&&. examPartResult E.^. ExamPartResultExamPart `E.in_` E.valList (map entityKey parts)
|
||||
return examPartResult
|
||||
let results = maybe Map.empty (\rs -> Map.fromList [ (examPartResultExamPart, res) | res@(Entity _ ExamPartResult{..}) <- rs ]) resultsRaw
|
||||
|
||||
result <- fmap join . for mUid $ getBy . UniqueExamResult eId
|
||||
|
||||
occurrencesRaw <- E.select . E.from $ \examOccurrence -> do
|
||||
E.where_ $ examOccurrence E.^. ExamOccurrenceExam E.==. E.val eId
|
||||
let
|
||||
registered
|
||||
| Just uid <- mUid
|
||||
= E.exists . E.from $ \examRegistration -> do
|
||||
E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val eId
|
||||
E.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val uid
|
||||
E.&&. examRegistration E.^. ExamRegistrationOccurrence E.==. E.just (examOccurrence E.^. ExamOccurrenceId)
|
||||
| otherwise = E.false
|
||||
E.orderBy [E.desc registered, E.asc $ examOccurrence E.^. ExamOccurrenceStart, E.asc $ examOccurrence E.^. ExamOccurrenceRoom]
|
||||
return (examOccurrence, registered)
|
||||
|
||||
let occurrences = map (over _2 E.unValue) occurrencesRaw
|
||||
|
||||
return (exam, parts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences)
|
||||
|
||||
let examTimes = all (\(Entity _ ExamOccurrence{..}, _) -> examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
|
||||
|
||||
let heading = prependCourseTitle tid ssh csh $ CI.original examName
|
||||
|
||||
siteLayoutMsg heading $ do
|
||||
setTitleI heading
|
||||
let
|
||||
gradingKeyW :: [Points] -> Widget
|
||||
gradingKeyW bounds
|
||||
= let boundWidgets :: [Widget]
|
||||
boundWidgets = map (toWidget . (pack :: String -> Text) . showFixed True) bounds
|
||||
grades :: [ExamGrade]
|
||||
grades = universeF
|
||||
in $(widgetFile "widgets/gradingKey")
|
||||
|
||||
examBonusW :: ExamBonusRule -> Widget
|
||||
examBonusW bonusRule = $(widgetFile "widgets/bonusRule")
|
||||
$(widgetFile "exam-show")
|
||||
|
||||
@ -456,7 +456,7 @@ postTEditR tid ssh csh tutn = do
|
||||
case insertRes of
|
||||
Just _ -> addMessageI Error $ MsgTutorialNameTaken tfName
|
||||
Nothing -> do
|
||||
addMessageI Success $ MsgTutorialCreated tfName
|
||||
addMessageI Success $ MsgTutorialEdited tfName
|
||||
redirect $ CourseR tid ssh csh CTutorialListR
|
||||
|
||||
let heading = prependCourseTitle tid ssh csh . MsgTutorialEditHeading $ tfName template
|
||||
|
||||
@ -559,7 +559,8 @@ examGradingRuleForm prev = multiActionA actions (fslI MsgExamGradingRule) $ clas
|
||||
{ fvLabel = toMarkup $ mr fsLabel
|
||||
, fvTooltip = toMarkup . mr <$> fsTooltip
|
||||
, fvId
|
||||
, fvInput = $(widgetFile "widgets/gradingKey")
|
||||
, fvInput = let boundWidgets = map (fvInput . snd) bounds
|
||||
in $(widgetFile "widgets/gradingKey")
|
||||
, fvErrors = if
|
||||
| (e : _) <- errors -> Just $ toMarkup e
|
||||
| otherwise -> Nothing
|
||||
|
||||
@ -35,6 +35,7 @@ deriving instance Eq (Unique Course) -- instance Eq TermSchoolCourseShort; in
|
||||
deriving instance Eq (Unique Sheet) -- instance Eq CourseSheet
|
||||
deriving instance Eq (Unique Material) -- instance Eq UniqueMaterial
|
||||
deriving instance Eq (Unique Tutorial) -- instance Eq Tutorial
|
||||
deriving instance Eq (Unique Exam)
|
||||
|
||||
submissionRatingDone :: Submission -> Bool
|
||||
submissionRatingDone Submission{..} = isJust submissionRatingTime
|
||||
|
||||
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
{-|
|
||||
Module: Model.Types.Exam
|
||||
Description: Types for modeling Exams
|
||||
@ -11,17 +13,17 @@ import Model.Types.Common
|
||||
|
||||
import Control.Lens
|
||||
|
||||
data ExamPartResult = ExamAttended { examPartResult :: Maybe Points }
|
||||
| ExamNoShow
|
||||
| ExamVoided
|
||||
data ExamResult' res = ExamAttended { examResult :: res }
|
||||
| ExamNoShow
|
||||
| ExamVoided
|
||||
deriving (Show, Read, Eq, Ord, Generic, Typeable)
|
||||
deriveJSON defaultOptions
|
||||
{ constructorTagModifier = camelToPathPiece' 1
|
||||
, fieldLabelModifier = camelToPathPiece' 2
|
||||
, fieldLabelModifier = camelToPathPiece' 1
|
||||
, omitNothingFields = True
|
||||
, sumEncoding = TaggedObject "status" "result"
|
||||
} ''ExamPartResult
|
||||
derivePersistFieldJSON ''ExamPartResult
|
||||
} ''ExamResult'
|
||||
derivePersistFieldJSON ''ExamResult'
|
||||
|
||||
data ExamBonusRule = ExamNoBonus
|
||||
| ExamBonusPoints
|
||||
@ -94,12 +96,15 @@ numberGrade = prism toNumberGrade fromNumberGrade
|
||||
n -> Left n
|
||||
|
||||
instance PathPiece ExamGrade where
|
||||
toPathPiece = tshow . review numberGrade
|
||||
toPathPiece = tshow . (fromRational :: Rational -> Deci) . review numberGrade
|
||||
fromPathPiece = finiteFromPathPiece
|
||||
|
||||
pathPieceJSON ''ExamGrade
|
||||
pathPieceJSONKey ''ExamGrade
|
||||
|
||||
passingGrade :: ExamGrade -> Bool
|
||||
passingGrade = (>= Grade40)
|
||||
|
||||
data ExamGradingRule
|
||||
= ExamGradingManual
|
||||
| ExamGradingKey
|
||||
@ -112,3 +117,6 @@ deriveJSON defaultOptions
|
||||
, sumEncoding = TaggedObject "rule" "settings"
|
||||
} ''ExamGradingRule
|
||||
derivePersistFieldJSON ''ExamGradingRule
|
||||
|
||||
type ExamResultPoints = ExamResult' (Maybe Points)
|
||||
type ExamResultGrade = ExamResult' ExamGrade
|
||||
|
||||
@ -126,6 +126,8 @@ makeLenses_ ''PredDNF
|
||||
makeLenses_ ''ExamBonusRule
|
||||
makeLenses_ ''ExamGradingRule
|
||||
|
||||
makeLenses_ ''UTCTime
|
||||
|
||||
|
||||
-- makeClassy_ ''Load
|
||||
|
||||
|
||||
@ -93,6 +93,10 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
|
||||
$else
|
||||
Eine Anmeldung zum Kurs ist Voraussetzung zum Zugang zu Kursmaterial
|
||||
(z.B. Übungsblätter).
|
||||
$if hasExams
|
||||
<dt .deflist__dt>_{MsgCourseExams}
|
||||
<dd .deflist__dd>
|
||||
^{examTable}
|
||||
$if hasTutorials
|
||||
<dt .deflist__dt>_{MsgCourseTutorials}
|
||||
<dd .deflist__dd>
|
||||
|
||||
2
templates/exam-edit.hamlet
Normal file
2
templates/exam-edit.hamlet
Normal file
@ -0,0 +1,2 @@
|
||||
$newline never
|
||||
^{editExamForm}
|
||||
6
templates/exam-show.cassius
Normal file
6
templates/exam-show.cassius
Normal file
@ -0,0 +1,6 @@
|
||||
.occurrence--not-registered
|
||||
text-decoration: strike-through;
|
||||
|
||||
.result
|
||||
padding-left: 2em;
|
||||
font-size: 20px;
|
||||
149
templates/exam-show.hamlet
Normal file
149
templates/exam-show.hamlet
Normal file
@ -0,0 +1,149 @@
|
||||
$newline never
|
||||
$maybe Entity _ ExamResult{examResultResult} <- result
|
||||
$if gradingShown
|
||||
<section>
|
||||
<h2>
|
||||
_{MsgExamResult}
|
||||
$if gradingShown && not gradingVisible
|
||||
\ ^{isVisible False}
|
||||
<p .result>
|
||||
$case examResultResult
|
||||
$of ExamAttended grade
|
||||
$if examShowGrades
|
||||
_{grade}
|
||||
$else
|
||||
$if passingGrade grade
|
||||
_{MsgExamPassed}
|
||||
$else
|
||||
_{MsgExamNotPassed}
|
||||
$of ExamNoShow
|
||||
_{MsgExamNoShow}
|
||||
$of ExamVoided
|
||||
_{MsgExamVoided}
|
||||
|
||||
$maybe desc <- examDescription
|
||||
<section>
|
||||
#{desc}
|
||||
|
||||
<section>
|
||||
<dl .deflist>
|
||||
$if not examVisible
|
||||
<dt .deflist__dt>_{MsgExamVisibleFrom}
|
||||
<dd .deflist__dd>
|
||||
$maybe from <- examVisibleFrom
|
||||
^{formatTimeW SelFormatDateTime from}
|
||||
$nothing
|
||||
_{MsgNever}
|
||||
\ ^{isVisible False}
|
||||
$maybe regFrom <- examRegisterFrom
|
||||
<dt .deflist__dt>_{MsgExamRegisterFrom}
|
||||
<dd .deflist__dd>^{formatTimeW SelFormatDateTime regFrom}
|
||||
$maybe regTo <- examRegisterTo
|
||||
<dt .deflist__dt>_{MsgExamRegisterTo}
|
||||
<dd .deflist__dd>^{formatTimeW SelFormatDateTime regTo}
|
||||
$maybe deregUntil <- examDeregisterUntil
|
||||
<dt .deflist__dt>_{MsgExamDeregisterUntil}
|
||||
<dd .deflist__dd>^{formatTimeW SelFormatDateTime deregUntil}
|
||||
<dt .deflist__dt>_{MsgExamPublishOccurrenceAssignmentsParticipant}
|
||||
<dd .deflist__dd>^{formatTimeW SelFormatDateTime examPublishOccurrenceAssignments}
|
||||
$if examTimes
|
||||
<dt .deflist__dt>_{MsgExamTime}
|
||||
<dd .deflist__dd>
|
||||
^{formatTimeW SelFormatDateTime examStart}
|
||||
$maybe end <- examEnd
|
||||
\ – ^{formatTimeW (bool SelFormatDateTime SelFormatTime ((on (==) utctDay) examStart end)) end}
|
||||
$maybe finished <- examFinished
|
||||
<dt .deflist__dt>_{MsgExamFinishedParticipant}
|
||||
<dd .deflist__dd>^{formatTimeW SelFormatDateTime finished}
|
||||
$if gradingShown
|
||||
$if examGradingRule /= ExamGradingManual
|
||||
<dt .deflist__dt>
|
||||
_{MsgExamGradingRule}
|
||||
$if not gradingVisible
|
||||
\ ^{isVisible False}
|
||||
<dd .deflist__dd>
|
||||
$case examGradingRule
|
||||
$of ExamGradingManual
|
||||
_{MsgExamGradingManual'}
|
||||
$of ExamGradingKey{..}
|
||||
^{gradingKeyW examGradingKey}
|
||||
$if examBonusRule /= ExamNoBonus
|
||||
<dt .deflist__dt>
|
||||
_{MsgExamBonusRule}
|
||||
$if not gradingVisible
|
||||
\ ^{isVisible False}
|
||||
<dd .deflist__dd>
|
||||
^{examBonusW examBonusRule}
|
||||
$if occurrenceAssignmentsShown
|
||||
<dt .deflist__dt>
|
||||
_{MsgExamOccurrenceRuleParticipant}
|
||||
$if not occurrenceAssignmentsVisible
|
||||
\ ^{isVisible False}
|
||||
<dd .deflist__dd>
|
||||
$# TODO
|
||||
|
||||
$if not (null occurrences)
|
||||
<section>
|
||||
<h2>
|
||||
_{MsgExamOccurrences}
|
||||
<table .table .table--striped .table--hover>
|
||||
<thead>
|
||||
<tr .table__row .table__row--head>
|
||||
<th .table__th>_{MsgExamRoom}
|
||||
$if not examTimes
|
||||
<th .table__th>_{MsgExamRoomTime}
|
||||
<th .table__th>_{MsgExamRoomDescription}
|
||||
$if occurrenceAssignmentsShown
|
||||
<th .table__th>
|
||||
_{MsgExamRoomRegistered}
|
||||
$if not occurrenceAssignmentsVisible
|
||||
\ ^{isVisible False}
|
||||
<tbody>
|
||||
$forall (Entity _occId ExamOccurrence{examOccurrenceRoom, examOccurrenceStart, examOccurrenceEnd, examOccurrenceDescription}, registered) <- occurrences
|
||||
<tr .table__row :occurrenceAssignmentsShown && not registered:.occurrence--not-registered>
|
||||
<td .table__td>#{examOccurrenceRoom}
|
||||
$if not examTimes
|
||||
<td .table__td>
|
||||
^{formatTimeW SelFormatDateTime examOccurrenceStart}
|
||||
$maybe end <- examOccurrenceEnd
|
||||
\ – ^{formatTimeW (bool SelFormatDateTime SelFormatTime ((on (==) utctDay) examStart end)) end}
|
||||
<td .table__td>
|
||||
$maybe desc <- examOccurrenceDescription
|
||||
#{desc}
|
||||
$if occurrenceAssignmentsShown
|
||||
<td .table__td>
|
||||
$if registered
|
||||
#{fontAwesomeIcon "check"}
|
||||
|
||||
$if gradingShown && not (null parts)
|
||||
<section>
|
||||
<h2>
|
||||
_{MsgExamParts}
|
||||
$if gradingShown && not gradingVisible
|
||||
\ ^{isVisible False}
|
||||
<table .table .table--striped .table--hover >
|
||||
<thead>
|
||||
<tr .table__row .table__row--head>
|
||||
<th .table__th>_{MsgExamPartName}
|
||||
<th .table__th>_{MsgExamPartMaxPoints}
|
||||
<th .table__th>_{MsgExamPartResultPoints}
|
||||
<tbody>
|
||||
$forall Entity partId ExamPart{examPartName, examPartWeight, examPartMaxPoints} <- parts
|
||||
<tr .table__row>
|
||||
<td .table__td>#{examPartName}
|
||||
<td .table__td>
|
||||
$maybe mPoints <- examPartMaxPoints
|
||||
#{showFixed True (fromRational examPartWeight * mPoints)}
|
||||
<td .table__td>
|
||||
$case fmap (examPartResultResult . entityVal) (results !? partId)
|
||||
$of Nothing
|
||||
$of Just (ExamAttended (Just ps))
|
||||
#{showFixed True ps}
|
||||
$of Just (ExamAttended Nothing)
|
||||
#{fontAwesomeIcon "check"}
|
||||
$of Just ExamNoShow
|
||||
_{MsgExamNoShow}
|
||||
$of Just ExamVoided
|
||||
_{MsgExamVoided}
|
||||
|
||||
$# TODO: Statistics
|
||||
8
templates/widgets/bonusRule.hamlet
Normal file
8
templates/widgets/bonusRule.hamlet
Normal file
@ -0,0 +1,8 @@
|
||||
$newline never
|
||||
$case bonusRule
|
||||
$of ExamNoBonus
|
||||
_{MsgExamNoBonus'}
|
||||
$of ExamBonusPoints ps False
|
||||
_{MsgExamBonusPoints ps}
|
||||
$of ExamBonusPoints ps True
|
||||
_{MsgExamBonusPointsPassed ps}
|
||||
@ -10,6 +10,6 @@ $newline never
|
||||
<tr>
|
||||
<th>
|
||||
_{MsgGradingFrom}
|
||||
$forall (_, fv) <- bounds
|
||||
$forall w <- boundWidgets
|
||||
<td>
|
||||
^{fvInput fv}
|
||||
^{w}
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
$newline never
|
||||
<td>#{csrf}^{fvInput epfNameView}
|
||||
<td>#{csrf}^{fvInput epfIdView}^{fvInput epfNameView}
|
||||
<td>^{fvInput epfMaxPointsView}
|
||||
<td>^{fvInput epfWeightView}
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
$newline never
|
||||
<td>#{csrf}^{fvInput eofRoomView}
|
||||
<td>#{csrf}^{fvInput eofIdView}^{fvInput eofRoomView}
|
||||
<td>^{fvInput eofCapacityView}
|
||||
<td>^{fvInput eofStartView}
|
||||
<td>^{fvInput eofEndView}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user