Single correction view

messages/de.msg

@@ -62,6 +62,7 @@ Submission: Abgabenummer
 SubmissionWrongSheet: Abgabenummer gehört nicht zum angegebenen Übungsblatt.
 SubmissionAlreadyExists: Sie haben bereits eine Abgabe zu diesem Übungsblatt.
 SubmissionEditHead tid@TermId courseShortHand@Text sheetName@Text: #{display tid}-#{courseShortHand} #{sheetName}: Abgabe editieren/anlegen
+CorrectionHead tid@TermId courseShortHand@Text sheetName@Text cid@CryptoFileNameSubmission: #{display tid}-#{courseShortHand} #{sheetName}: Korrektur
 SubmissionMember g@Int: Mitabgebende(r) ##{display g}
 SubmissionArchive: Zip-Archiv der Abgabedatei(en)
 SubmissionFile: Datei zur Abgabe
@@ -144,3 +145,15 @@ UpdatedAssignedCorrectorsAuto num@Int64: #{display num} Abgaben wurden unter den
 CouldNotAssignCorrectorsAuto num@Int64: #{display num} Abgaben konnten nicht automatisch zugewiesen werden:
 
 CorrectionsUploaded num@Int64: #{display num} Korrekturen wurden gespeichert:
+
+RatingBy: Korrigiert von:
+AchievedBonusPoints: Erreichte Bonuspunkte:
+AchievedNormalPoints: Erreichte Punkte:
+AchievedPassPoints: Erreichte Punkte:
+AchievedOf achieved@Points possible@Points: #{display achieved} von #{display possible}
+PassAchievedOf points@Points passingPoints@Points maxPoints@Points: #{display points} von #{display maxPoints} (Bestanden ab #{display passingPoints})
+PassedResult: Ergebnis:
+Passed: Bestanden
+NotPassed: Nicht bestanden
+RatingTime: Korrigiert:
+RatingComment: Kommentar:

routes

@@ -60,9 +60,9 @@
     /delete                     SDelR         GET POST
     /subs                       SSubsR        GET POST
     /subs/new                   SubmissionNewR GET POST        !timeANDregistered
-    /subs/own                   SubmissionOwnR GET             !free
+    /subs/own                   SubmissionOwnR GET             !free -- just redirect
     /sub/#CryptoFileNameSubmission SubmissionR !corrector:
-      /                           SubShowR                   GET POST !owner
+      /                           SubShowR                   GET POST !ownerANDtime !ownerANDisRead
       /archive                    SubArchiveR                GET      !owner
       /correction                 CorrectionR                GET POST !ownerANDisRead
       !/#SubmissionFileType/*FilePath SubDownloadR           GET      !owner

src/Foundation.hs

@@ -303,6 +303,7 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req
           SFileR SheetSolution _ -> guard $ maybe False (<= cTime) sheetSolutionFrom
           SFileR SheetMarking  _ -> mzero -- only for correctors and lecturers
           SubmissionNewR         -> guard $ sheetActiveFrom <= cTime && cTime <= sheetActiveTo
+          SubmissionR _ _        -> guard $ sheetActiveFrom <= cTime && cTime <= sheetActiveTo
           _ -> guard started
         return Authorized
 
@@ -604,6 +605,7 @@ instance YesodBreadcrumbs UniWorX where
   breadcrumb (CSheetR tid csh shn SubmissionNewR)  = return ("Abgabe", Just $ CSheetR tid csh shn SShowR)
   breadcrumb (CSheetR tid csh shn SubmissionOwnR)  = return ("Abgabe", Just $ CSheetR tid csh shn SShowR)
   breadcrumb (CSubmissionR tid csh shn _ SubShowR) = return ("Abgabe", Just $ CSheetR tid csh shn SShowR)
+  breadcrumb (CSubmissionR tid csh shn cid CorrectionR) = return ("Korrektur", Just $ CSubmissionR tid csh shn cid SubShowR)
   -- Others
   breadcrumb  _ = return ("Uni2work", Nothing) -- Default is no breadcrumb at all
 
@@ -699,6 +701,14 @@ pageActions (CSheetR tid csh shn SShowR) =
       , menuItemAccessCallback' = return True
       }
   ]
+pageActions (CSubmissionR tid csh shn cid SubShowR) =
+  [ PageActionPrime $ MenuItem
+      { menuItemLabel = "Korrektur"
+      , menuItemIcon  = Nothing
+      , menuItemRoute = CSubmissionR tid csh shn cid CorrectionR
+      , menuItemAccessCallback' = return True
+      }
+  ]
 pageActions TermShowR =
   [ PageActionPrime $ MenuItem
       { menuItemLabel = "Neues Semester anlegen"
@@ -808,6 +818,8 @@ pageHeading (CSheetR tid csh shn SubmissionOwnR)
   = Just $ i18nHeading $ MsgSubmissionEditHead tid csh shn
 pageHeading (CSubmissionR tid csh shn _ SubShowR) -- TODO: Rethink this one!
   = Just $ i18nHeading $ MsgSubmissionEditHead tid csh shn
+pageHeading (CSubmissionR tid csh shn cid CorrectionR)
+  = Just $ i18nHeading $ MsgCorrectionHead tid csh shn cid
 
 -- TODO: add headings for more single course- and single term-pages
 pageHeading _

src/Handler/Corrections.hs

@@ -29,6 +29,8 @@ import qualified Data.Set as Set
 import Data.Map (Map)
 import qualified Data.Map as Map
 
+import qualified Data.Text as Text
+
 -- import Data.Time
 -- import qualified Data.Text as T
 -- import Data.Function ((&))
@@ -346,7 +348,28 @@ getCorrectionR tid csh shn cid = do
   mayPost <- isAuthorized (CSubmissionR tid csh shn cid CorrectionR) True
   bool getCorrectionUserR postCorrectionR (mayPost == Authorized) tid csh shn cid
 postCorrectionR tid csh shn cid = undefined
-getCorrectionUserR tid csh shn cid = undefined
+getCorrectionUserR tid csh shn cid = do
+  sub <- decrypt cid
+  
+  results <- runDB . E.select . E.from $ \((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) -> do
+    E.on $ corrector E.?. UserId E.==. submission E.^. SubmissionRatingBy
+    E.on $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId
+    E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
+
+    E.where_ $ course E.^. CourseTerm E.==. E.val tid
+         E.&&. course E.^. CourseShorthand E.==. E.val csh
+         E.&&. sheet  E.^. SheetName E.==. E.val shn
+         E.&&. submission E.^. SubmissionId E.==. E.val sub
+
+    return (course, sheet, submission, corrector)
+
+  case results of
+    [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, Just (Entity _ User{..}))] -> do
+      let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c))
+      
+      defaultLayout $ do
+        $(widgetFile "correction-user")
+    _ -> notFound
 
   
 getCorrectionsUploadR, postCorrectionsUploadR :: Handler Html

templates/correction-user.hamlet

@@ -0,0 +1,37 @@
+<div .scrolltable>
+  <table .table .table--striped .table--hover .table--vertical>
+    <tr .table__row>
+      <th .table__th> _{MsgSubmission}
+      <td .table__td> #{display cid}
+    <tr .table__row>
+      <th .table__th> _{MsgRatingBy}
+      <td .table__td> #{display userDisplayName}
+    $maybe time <- submissionRatingTime
+      <tr .table__row>
+        <th .table__th> _{MsgRatingTime}
+        <td .table__td> #{display time}
+    $maybe points <- submissionRatingPoints
+      $case sheetType
+        $of Bonus{..}
+          <tr .table__row>
+            <th .table__th> _{MsgAchievedBonusPoints}
+            <td .table__td> _{MsgAchievedOf points maxPoints}
+        $of Normal{..}
+          <tr .table__row>
+            <th .table__th> _{MsgAchievedNormalPoints}
+            <td .table__td> _{MsgAchievedOf points maxPoints}
+        $of Pass{..}
+          <tr .table__row>
+            <th .table__th> _{MsgPassedResult}
+            <td .table__td>
+              $if points >= passingPoints
+                _{MsgPassed}
+              $else
+                _{MsgNotPassed}
+          <tr .table__row>
+            <th .table__th> _{MsgAchievedPassPoints}
+            <td .table__td> _{MsgPassAchievedOf points passingPoints maxPoints}
+    $maybe comment <- ratingComment
+      <tr .table__row>
+        <th .table__th> _{MsgRatingComment}
+        <td .table__td style="white-space: pre;"> #{comment}