feat(exam-correct): add basic interface stub

messages/uniworx/de-de-formal.msg

@@ -1393,6 +1393,16 @@ ExamRegistrationInvitationDeclined examn@ExamName: Sie haben die Einladung, Teil
 ExamRegistrationInviteHeading examn@ExamName: Einladung zum Teilnehmer für #{examn}
 ExamRegistrationInviteExplanation: Sie wurden eingeladen, Prüfungsteilnehmer zu sein.
 
+ExamCorrectHeading examname@Text: Prüfungsergebnisse für #{examname} eintragen
+
+ExamCorrectHeadParticipant: Teilnehmer
+ExamCorrectHeadParticipantTooltip: Geben Sie hier einen beliebigen eindeutigen Identifikator des Teilnehmers an. Definitiv eindeutig ist die Matrikelnummer des Teilnehmers, aber auch der Name oder ein Teil der Matrikelnummer können unter Umständen (je nach Liste aller Prüfungsteilnehmer) bereits eindeutig sein.
+ExamCorrectHeadPart exampartnum@ExamPartNumber: #{exampartnum}
+ExamCorrectHeadPartName exampartname@ExamPartName: #{exampartname}
+ExamCorrectHeadStatus: Status
+
+ExamCorrectButtonSend: Senden
+
 SubmissionUserInvitationAccepted shn@SheetName: Sie wurden als Mitabgebende(r) für eine Abgabe zu #{shn} eingetragen
 SubmissionUserInvitationDeclined shn@SheetName: Sie haben die Einladung, Mitabgebende(r) für #{shn} zu werden, abgelehnt
 SubmissionUserInviteHeading shn@SheetName: Einladung zu einer Abgabe für #{shn}

messages/uniworx/en-eu.msg

@@ -1391,6 +1391,16 @@ ExamRegistrationInvitationDeclined examn: You have declined the invitation to pa
 ExamRegistrationInviteHeading examn: Invitation to participate in #{examn}
 ExamRegistrationInviteExplanation: You were invited to register for an exam.
 
+ExamCorrectHeading examname: Submit corrections for #{examname}
+
+ExamCorrectHeadParticipant: Participant
+ExamCorrectHeadParticipantTooltip: Enter any string that uniquely identifies the participant. Their matriculation number is definitely unique, but also their name or a part of their matriculation number may already be unique for this participant (depending on the list of all participants).
+ExamCorrectHeadPart exampartnum: #{exampartnum}
+ExamCorrectHeadPartName exampartname: #{exampartname}
+ExamCorrectHeadStatus: Status
+
+ExamCorrectButtonSend: Submit
+
 SubmissionUserInvitationAccepted shn: You now participate in a submission for #{shn}
 SubmissionUserInvitationDeclined shn: You have declined the invitation to participate in a submission for #{shn}
 SubmissionUserInviteHeading shn: Invitation to participate in a submission for #{shn}

src/Handler/Exam/Correct.hs

@@ -4,6 +4,12 @@ module Handler.Exam.Correct
 
 import Import
 
+import qualified Data.CaseInsensitive as CI (original)
+
+import Handler.Utils
+import Handler.Utils.Exam (fetchExam)
+
+
 data CorrectInterfaceResponse
   = CorrectInterfaceSuccess
     { ciUserIdent :: CryptoUUIDUser
@@ -34,7 +40,27 @@ deriveJSON defaultOptions
  
 
 getECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
-getECorrectR = error "ECorrectR not implemented"
+getECorrectR tid ssh csh examn = do
+  MsgRenderer mr <- getMsgRenderer
+
+  (Entity _ Exam{..}, examParts) <- runDB $ do
+    exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn
+    examParts <- sortOn (view $ _entityVal . _examPartNumber) <$> selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
+    return (exam, entityVal <$> examParts)
+  
+  let
+    heading = prependCourseTitle tid ssh csh $ (mr . MsgExamCorrectHeading . CI.original) examName
+    
+    ptsInput :: ExamPartNumber -> Widget
+    ptsInput n = do
+      name <- newIdent
+      fieldView (pointsField :: Field Handler Points) ("exam-correct__"<>(toPathPiece n)) name [("class","exam-correct__pts-input")] (Left "") False
+    
+    participantHeadTooltip = [whamlet| _{MsgExamCorrectHeadParticipantTooltip} |]
+
+  siteLayoutMsg heading $ do
+    setTitleI heading
+    $(widgetFile "widgets/exam-correct")
   
 postECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Value
 postECorrectR = error "ECorrectR not implemented" -- use returnJson & requireCheckJsonBody

src/Model/Types/Exam.hs

@@ -376,6 +376,8 @@ instance PathPiece ExamPartNumber where
 
 instance ToMarkup ExamPartNumber where
   toMarkup = toMarkup . view _ExamPartNumber
+instance ToMessage ExamPartNumber where
+  toMessage = toMessage . view _ExamPartNumber
 
 pathPieceCsv ''ExamPartNumber
 pathPieceJSON ''ExamPartNumber

src/Utils/Tooltip.hs

@@ -0,0 +1,6 @@
+module Utils.Tooltip where
+
+import ClassyPrelude.Yesod hiding (Proxy)
+
+textTooltip :: forall site. WidgetFor site () -> WidgetFor site () -> WidgetFor site ()
+textTooltip ttHandle ttContent = $(whamletFile "templates/widgets/text-tooltip.hamlet")

templates/widgets/exam-correct.hamlet

@@ -0,0 +1,30 @@
+$newline never
+
+<section>
+  <table #exam-correct uw-hide-columns="exam-corrections" .table .table--striped>
+    <thead>
+      <tr .table__row .table__row--head>
+        <th .table__th uw-hide-column-header="participant">
+          _{MsgExamCorrectHeadParticipant}
+          ^{iconTooltip participantHeadTooltip Nothing True}
+        $forall ExamPart{examPartNumber,examPartName} <- examParts
+          <th .table__th>
+            $maybe name <- examPartName
+              <span .tooltip>
+                <span>
+                  _{MsgExamCorrectHeadPart examPartNumber}
+                <span .tooltip__content>
+                  _{MsgExamCorrectHeadPartName name}
+            $nothing
+              _{MsgExamCorrectHeadPart examPartNumber}
+        <th .table__th uw-hide-column-header="status">_{MsgExamCorrectHeadStatus}
+    <tbody>
+      <tr #exam-correct__new .table__row>
+        <td .table__td>
+          <input #exam-correct__participant type="text">
+        $forall ExamPart{examPartNumber} <- examParts
+          <td .table__td>
+            ^{ptsInput examPartNumber}
+        <td #exam-correct__status .table__td>
+          <button #exam-correct__send-btn .btn .btn-primary>
+            _{MsgExamCorrectButtonSend}

templates/widgets/text-tooltip.hamlet

@@ -0,0 +1,6 @@
+$newline never
+<span .tooltip>
+  <span>
+    ^{ttHandle}
+  <span .tooltip__content>
+    ^{ttContent}