diff --git a/messages/de.msg b/messages/de.msg index a1eeab4f1..2870e68cf 100644 --- a/messages/de.msg +++ b/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: \ No newline at end of file diff --git a/routes b/routes index 1c10335ea..39556f1c7 100644 --- a/routes +++ b/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 diff --git a/src/Foundation.hs b/src/Foundation.hs index c3991f64d..0e884c651 100644 --- a/src/Foundation.hs +++ b/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 _ diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index fefec4dd6..0430185d7 100644 --- a/src/Handler/Corrections.hs +++ b/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 diff --git a/templates/correction-user.hamlet b/templates/correction-user.hamlet new file mode 100644 index 000000000..07e243267 --- /dev/null +++ b/templates/correction-user.hamlet @@ -0,0 +1,37 @@ +
+ + + + + + + + + +
_{MsgSubmission} + #{display cid} +
_{MsgRatingBy} + #{display userDisplayName} + $maybe time <- submissionRatingTime +
_{MsgRatingTime} + #{display time} + $maybe points <- submissionRatingPoints + $case sheetType + $of Bonus{..} +
_{MsgAchievedBonusPoints} + _{MsgAchievedOf points maxPoints} + $of Normal{..} +
_{MsgAchievedNormalPoints} + _{MsgAchievedOf points maxPoints} + $of Pass{..} +
_{MsgPassedResult} + + $if points >= passingPoints + _{MsgPassed} + $else + _{MsgNotPassed} +
_{MsgAchievedPassPoints} + _{MsgPassAchievedOf points passingPoints maxPoints} + $maybe comment <- ratingComment +
_{MsgRatingComment} + #{comment}