Additional information in rating files
This commit is contained in:
parent
0479758e5b
commit
1c78032f1e
@ -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)
|
||||
, "============================================="
|
||||
|
||||
Loading…
Reference in New Issue
Block a user