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

feat(exam-correct): examResult interface, no styling or functionality

Browse Source
This commit is contained in:
Sarah Vaupel 2020-02-06 12:54:40 +01:00
parent be187ae907
commit 970076e730
2 changed files with 31 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -70,9 +70,11 @@ getECorrectR tid ssh csh examn = do
MsgRenderer mr <- getMsgRenderer MsgRenderer mr <- getMsgRenderer
(Entity eId Exam{..}, examParts) <- runDB $ do (Entity eId Exam{..}, examParts) <- runDB $ do
exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn exam@(Entity eId _) <- fetchExam tid ssh csh examn
examParts <- sortOn (view $ _entityVal . _examPartNumber) <$> selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ] examParts <- sortOn (view $ _entityVal . _examPartNumber) <$> selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
return (exam, entityVal <$> examParts) return (exam, entityVal <$> examParts)
mayEditResults <- hasWriteAccessTo $ CExamR tid ssh csh examn EUsersR
let let
heading = prependCourseTitle tid ssh csh $ (mr . MsgExamCorrectHeading . CI.original) examName heading = prependCourseTitle tid ssh csh $ (mr . MsgExamCorrectHeading . CI.original) examName
@ -84,6 +86,9 @@ getECorrectR tid ssh csh examn = do
participantHeadTooltip = [whamlet| _{MsgExamCorrectHeadParticipantTooltip} |] participantHeadTooltip = [whamlet| _{MsgExamCorrectHeadParticipantTooltip} |]
examGrades :: [ExamGrade]
examGrades = universeF
examCorrectIdent <- encrypt eId :: Handler CryptoUUIDExam examCorrectIdent <- encrypt eId :: Handler CryptoUUIDExam
siteLayoutMsg heading $ do siteLayoutMsg heading $ do

25
templates/exam-correct.hamlet
View File

@ -20,6 +20,9 @@ $newline never
_{MsgExamCorrectHeadPartName name} _{MsgExamCorrectHeadPartName name}
$nothing $nothing
_{MsgExamCorrectHeadPart examPartNumber} _{MsgExamCorrectHeadPart examPartNumber}
$if mayEditResults
<th .table__th .uw-exam-correct--result-cell uw-exam-correct-header="result" uw-hide-column-header="result" colspan=2>
_{MsgExamResult}
<th .table__th uw-exam-correct-header="status" uw-hide-column-header="status"> <th .table__th uw-exam-correct-header="status" uw-hide-column-header="status">
_{MsgExamCorrectHeadStatus} _{MsgExamCorrectHeadStatus}
<tbody> <tbody>
@ -32,6 +35,28 @@ $newline never
$forall ExamPart{examPartNumber} <- examParts $forall ExamPart{examPartNumber} <- examParts
<td .table__td .uw-exam-correct--part-cell> <td .table__td .uw-exam-correct--part-cell>
^{ptsInput examPartNumber} ^{ptsInput examPartNumber}
$if mayEditResults
<td .table__td>
<select #uw-exam-correct__result>
<option>
_{MsgExamResultNone}
$if examShowGrades
<option>
_{MsgExamResult}
$else
<option>
_{MsgExamPassed}
<option>
_{MsgExamNotPassed}
<option>
_{MsgExamResultVoided}
<option>
_{MsgExamResultNoShow}
<td .table__td>
<select #uw-exam-correct__result__grade>
$forall grade <- (toPathPiece <$> examGrades)
<option>
#{grade}
<td #exam-correct__status .table__td> <td #exam-correct__status .table__td>
<button #exam-correct__send-btn .btn .btn-primary> <button #exam-correct__send-btn .btn .btn-primary>
_{MsgExamCorrectButtonSend} _{MsgExamCorrectButtonSend}