Additional information in rating files

This commit is contained in:
Gregor Kleen 2018-07-18 10:01:29 +02:00
parent 0479758e5b
commit 1c78032f1e

View File

@ -68,6 +68,8 @@ instance Pretty x => Pretty (CI x) where
data Rating = Rating
{ ratingCourseName :: Text
, ratingSheetName :: Text
, ratingCorrectorName :: Maybe Text
, ratingSheetType :: SheetType
, ratingValues :: Rating'
} deriving (Read, Show, Eq, Generic, Typeable)
@ -89,15 +91,18 @@ instance Exception RatingException
getRating :: SubmissionId -> YesodDB UniWorX (Maybe Rating)
getRating submissionId = runMaybeT $ do
let query = E.select . E.from $ \(submission `E.InnerJoin` sheet `E.InnerJoin` course) -> do
let query = E.select . E.from $ \(corrector `E.RightOuterJoin` (submission `E.InnerJoin` sheet `E.InnerJoin` course)) -> do
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
E.on $ corrector E.?. UserId E.==. submission E.^. SubmissionRatingBy
E.where_ $ submission E.^. SubmissionId E.==. E.val submissionId
-- Yes, we can only pass a tuple through 'E.select'
return ( course E.^. CourseName
, sheet E.^. SheetName
, corrector E.?. UserDisplayName
, sheet E.^. SheetType
, submission E.^. SubmissionRatingPoints
, submission E.^. SubmissionRatingComment
, submission E.^. SubmissionRatingTime
@ -105,6 +110,8 @@ getRating submissionId = runMaybeT $ do
[ ( E.unValue -> ratingCourseName
, E.unValue -> ratingSheetName
, E.unValue -> ratingCorrectorName
, E.unValue -> ratingSheetType
, E.unValue -> ratingPoints
, E.unValue -> ratingComment
, E.unValue -> ratingTime
@ -117,12 +124,14 @@ formatRating cID Rating{ ratingValues = Rating'{..}, ..} = let
doc = renderPretty 1 45 $ foldr (<$$>) mempty
[ "= Bitte nur Bewertung und Kommentare ändern ="
, "============================================="
, "========== Uni2work Bewertungsdatei =========="
, "========== Uni2work Bewertungsdatei ========="
, "======= diese Datei ist UTF8 encodiert ======"
, "Informationen zum Übungsblatt:"
, indent 2 $ foldr (<$$>) mempty
[ "Veranstaltung:" <+> pretty ratingCourseName
, "Blatt:" <+> pretty ratingSheetName
, indent 2 . foldr (<$$>) mempty . catMaybes $
[ Just $ "Veranstaltung:" <+> pretty ratingCourseName
, Just $ "Blatt:" <+> pretty ratingSheetName
, ("Korrektor:" <+>) . pretty <$> ratingCorrectorName
, Just $ "Bewertung:" <+> pretty (display ratingSheetType)
]
, "Abgabe-Id:" <+> pretty (ciphertext cID)
, "============================================="