diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index be5c435f5..eda91acdf 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -169,7 +169,9 @@ Corrector: Korrektor Correctors: Korrektoren CorState: Status CorByTut: Nach Tutorium +Tutorial: Tutorium CorProportion: Anteil +CorrectionProportion: Anteile DeleteRow: Zeile entfernen ProportionNegative: Anteile dürfen nicht negativ sein CorrectorsUpdated: Korrektoren erfolgreich aktualisiert diff --git a/src/Foundation.hs b/src/Foundation.hs index 88a4cad75..6ee75a3e2 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -205,6 +205,25 @@ instance RenderMessage UniWorX CorrectorState where CorrectorExcused -> renderMessage' MsgCorrectorExcused where renderMessage' = renderMessage foundation ls + +instance RenderMessage UniWorX Load where + renderMessage foundation ls (Load {..}) = loadText <> tutorialText + where + loadText = if byProportion > 0 + then (tshow $ fromRational byProportion) <> " " <> renderMessage' MsgCorrectionProportion + else mempty + + tutorialText = case byTutorial of + Nothing -> mempty + (Just plusLoad) -> + let connector = if + | loadText == mempty -> mempty + | plusLoad -> " - " + | otherwise -> " + " + in connector <> renderMessage' MsgTutorial + + renderMessage' = renderMessage foundation ls + instance RenderMessage UniWorX (UnsupportedAuthPredicate (Route UniWorX)) where renderMessage f ls (UnsupportedAuthPredicate tag route) = renderMessage f ls $ MsgUnsupportedAuthPredicate tag (show route) diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index a86509bf0..caade0118 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -113,11 +113,10 @@ getProfileR = do return (course E.^. CourseTerm, course E.^.CourseSchool, course E.^. CourseShorthand) ) <*> - (E.select $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do + (E.select $ E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid - return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand) ) <*> @@ -205,7 +204,7 @@ mkOwnedCoursesTable = schoolCell <$> view (_dbrOutput . _1 . re _Just) <*> view (_dbrOutput . _2 ) , sortable (Just "course") (i18nCell MsgCourse) $ - courseLinkCell <$> view (_dbrOutput) + courseCellCL <$> view (_dbrOutput) ] validator = def & defaultSorting [("term",SortDesc),("school",SortAsc),("course",SortAsc)] @@ -312,7 +311,7 @@ mkSubmissionTable = schoolCell <$> view ( _1. re _Just) <*> view ( _2 ) , sortable (Just "course") (i18nCell MsgCourse) $ - courseLinkCell <$> view (_dbrOutput . _1) + courseCellCL <$> view (_dbrOutput . _1) , sortable (Just "sheet") (i18nCell MsgSheet) . magnify _dbrOutput $ sheetCell <$> view _1 <*> view _2 @@ -389,7 +388,7 @@ mkSubmissionGroupTable = schoolCell <$> view ( _1. re _Just) <*> view ( _2 ) , sortable (Just "course") (i18nCell MsgCourse) $ - courseLinkCell <$> view (_dbrOutput . _1) + courseCellCL <$> view (_dbrOutput . _1) , sortable (Just "submissiongroup") (i18nCell MsgSubmissionGroupName) . magnify (_dbrOutput . _2 . _entityVal) $ maybe mempty textCell <$> view _submissionGroupName , sortable (Just "edit") (i18nCell MsgLastEdit) $ @@ -423,60 +422,53 @@ mkCorrectionsTable = let dbtIdent = "corrections" :: Text dbtStyle = def -- TODO Continue here - withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroup) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroupUser) )->a) - -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroup) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroupUser) )->a) + withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity SheetCorrector))->a) + -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity SheetCorrector))->a) withType = id - dbtSQLQuery' uid = \(course `E.InnerJoin` sgroup `E.InnerJoin` sguser) -> do - E.on $ sguser E.^. SubmissionGroupUserSubmissionGroup E.==. sgroup E.^. SubmissionGroupId - E.on $ sgroup E.^. SubmissionGroupCourse E.==. course E.^. CourseId - E.where_ $ sguser E.^. SubmissionGroupUserUser E.==. E.val uid + dbtSQLQuery' uid = \(course `E.InnerJoin` sheet `E.InnerJoin` corrector) -> do + E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet + E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId + E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid let crse = ( course E.^. CourseTerm , course E.^. CourseSchool , course E.^. CourseShorthand ) - return (crse, sgroup, lastSGEdit sgroup) - - lastSGEdit sgroup = -- latest Edit-Time of this Submission Group by a user - E.sub_select . E.from $ \(user `E.InnerJoin` sgEdit) -> do - E.on $ user E.^. UserId E.==. sgEdit E.^. SubmissionGroupEditUser - E.where_ $ sgEdit E.^. SubmissionGroupEditSubmissionGroup E.==. sgroup E.^. SubmissionGroupId - return . E.max_ $ sgEdit E.^. SubmissionGroupEditTime + return (crse, sheet E.^. SheetName, corrector) dbtProj = \x -> return $ x & _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh)) - & _dbrOutput . _3 %~ E.unValue + & _dbrOutput . _2 %~ E.unValue dbtColonnade = mconcat [ dbRow , sortable (Just "term") (i18nCell MsgTerm) $ - termCell <$> view (_dbrOutput . _1 . _1) - , sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $ - schoolCell <$> view ( _1. re _Just) - <*> view ( _2 ) + termCellCL <$> view (_dbrOutput . _1) + , sortable (Just "school") (i18nCell MsgCourseSchool) $ + schoolCellCL <$> view (_dbrOutput . _1) , sortable (Just "course") (i18nCell MsgCourse) $ - courseLinkCell <$> view (_dbrOutput . _1) - , sortable (Just "submissiongroup") (i18nCell MsgSubmissionGroupName) . magnify (_dbrOutput . _2 . _entityVal) $ - maybe mempty textCell <$> view _submissionGroupName - , sortable (Just "edit") (i18nCell MsgLastEdit) $ - maybe mempty timeCell <$> view (_dbrOutput . _3) + courseCellCL <$> view (_dbrOutput . _1) + , sortable (Just "sheet") (i18nCell MsgSheet) . magnify _dbrOutput $ + sheetCell <$> view _1 <*> view _2 + , sortable (Just "cstate") (i18nCell MsgCorState) $ + correctorStateCell <$> view (_dbrOutput . _3 . _entityVal) + , sortable (Just "cload") (i18nCell MsgCorProportion) $ + correctorLoadCell <$> view (_dbrOutput . _3 . _entityVal) ] - validator = def -- DUPLICATED CODE: Handler.Corrections - & restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information - & restrictSorting (\name _ -> name /= "corrector") - & defaultSorting [("edit",SortDesc)] + validator = def & defaultSorting [("term",SortDesc),("school",SortAsc),("course",SortAsc),("sheet",SortAsc)] dbtSorting = Map.fromList - [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseShorthand) - , ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseTerm ) - , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseSchool ) - , ( "submissiongroup" , SortColumn $ withType $ \(_ `E.InnerJoin` sgroup `E.InnerJoin` _) -> sgroup E.^. SubmissionGroupName ) - , ( "edit" , SortColumn $ withType $ \(_ `E.InnerJoin` sgroup `E.InnerJoin` _ ) -> lastSGEdit sgroup) + [ ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseTerm ) + , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseSchool ) + , ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseShorthand) + , ( "sheet" , SortColumn $ withType $ \(_ `E.InnerJoin` sheet `E.InnerJoin` _) -> sheet E.^. SheetName ) + , ( "cstate", SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.InnerJoin` cs) -> cs E.^. SheetCorrectorState ) + , ( "cload" , SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.InnerJoin` cs) -> cs E.^. SheetCorrectorLoad ) ] dbtFilter = Map.fromList - [ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand) - , ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm ) + [ ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm ) , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool ) + , ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand) ] in \uid -> let dbtSQLQuery = dbtSQLQuery' uid in dbTableWidget' validator $ DBTable {..} diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 4b9ccd9f2..c5a4f784b 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -157,8 +157,8 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do E.orderBy [E.asc $ user E.^. UserEmail] return $ (user E.^. UserId, user E.^. UserEmail) let breakUserFromBuddies (E.Value userID, E.Value email) - | uid == userID = (Any True , []) - | otherwise = (Any False, [email]) + | uid == userID = (Any True , []) + | otherwise = (Any False, [email]) return $ foldMap breakUserFromBuddies submittors lastEdits <- do @@ -167,7 +167,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime] -- E.limit numberOfSubmissionEditDates -- DEPRECATED we always show all edit times - let userName = if maySubmit || isOwner + let userName = if isOwner || maySubmit then E.just $ user E.^. UserDisplayName else E.nothing return $ (userName, submissionEdit E.^. SubmissionEditTime) diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index 7b48f4052..ef1deabf8 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -38,6 +38,9 @@ termCell tid = anchorCell link name link = TermCourseListR tid name = text2widget $ display tid +termCellCL :: IsDBTable m a => CourseLink -> DBCell m a +termCellCL (tid,_,_) = termCell tid + schoolCell :: IsDBTable m a => Maybe TermId -> SchoolId -> DBCell m a schoolCell (Just tid) ssh = anchorCell link name where @@ -48,8 +51,11 @@ schoolCell Nothing ssh = anchorCell link name link = SchoolShowR ssh name = text2widget $ display ssh -courseLinkCell :: IsDBTable m a => CourseLink -> DBCell m a -courseLinkCell (tid,ssh,csh) = anchorCell link name +schoolCellCL :: IsDBTable m a => CourseLink -> DBCell m a +schoolCellCL (tid,ssh,_) = schoolCell (Just tid) ssh + +courseCellCL :: IsDBTable m a => CourseLink -> DBCell m a +courseCellCL (tid,ssh,csh) = anchorCell link name where link = CourseR tid ssh csh CShowR name = citext2widget csh @@ -81,3 +87,10 @@ submissionCell crse shn sid = mkText cid = display2widget cid in anchorCellM' mkCid mkRoute mkText +correctorStateCell :: IsDBTable m a => SheetCorrector -> DBCell m a +correctorStateCell sc = + i18nCell $ sheetCorrectorState sc + +correctorLoadCell :: IsDBTable m a => SheetCorrector -> DBCell m a +correctorLoadCell sc = + i18nCell $ sheetCorrectorLoad sc diff --git a/templates/correction-user.hamlet b/templates/correction-user.hamlet index 7bdd3e25d..5b1086511 100644 --- a/templates/correction-user.hamlet +++ b/templates/correction-user.hamlet @@ -1,39 +1,39 @@
- - - - - - - -
_{MsgSubmission} - #{display cid} + _{MsgSubmission} + #{display cid} $maybe Entity _ User{..} <- corrector
_{MsgRatingBy} - #{display userDisplayName} + _{MsgRatingBy} + #{display userDisplayName} $maybe time <- submissionRatingTime
_{MsgRatingTime} - #{display time} + _{MsgRatingTime} + #{display time} $maybe points <- submissionRatingPoints $case sheetType $of Bonus{..}
_{MsgAchievedBonusPoints} - _{MsgAchievedOf points maxPoints} + _{MsgAchievedBonusPoints} + _{MsgAchievedOf points maxPoints} $of Normal{..}
_{MsgAchievedNormalPoints} - _{MsgAchievedOf points maxPoints} + _{MsgAchievedNormalPoints} + _{MsgAchievedOf points maxPoints} $of Pass{..}
_{MsgPassedResult} + _{MsgPassedResult} $if points >= passingPoints _{MsgPassed} $else _{MsgNotPassed}
_{MsgAchievedPassPoints} - _{MsgPassAchievedOf points passingPoints maxPoints} + _{MsgAchievedPassPoints} + _{MsgPassAchievedOf points passingPoints maxPoints} $of NotGraded $maybe comment <- ratingComment
_{MsgRatingComment} - #{comment} + _{MsgRatingComment} + #{comment}