fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Additional information in rating files

Browse Source
This commit is contained in:
Gregor Kleen 2018-07-18 10:01:29 +02:00
parent 0479758e5b
commit 1c78032f1e
1 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Handler/Utils/Rating.hs
View File

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