diff --git a/frontend/src/app.sass b/frontend/src/app.sass index 51a6a00cd..5d25396bc 100644 --- a/frontend/src/app.sass +++ b/frontend/src/app.sass @@ -343,11 +343,21 @@ input[type="button"].btn-info:not(.btn-link):hover, .table__td background-color: rgba(0, 0, 0, 0.03) + &.table--vertical + .table__row:not(.no-stripe):not(.table__row--sum):nth-child(even) + .table__th + background-color: rgba(0, 0, 0, 0.03) + .table--hover .table__row:not(.no-hover):not(.table__row--sum):not(.table__row--head):not(.table__row--foot):hover .table__td background-color: rgba(0, 0, 0, 0.07) + &.table--vertical + .table__row:not(.no-hover):not(.table__row--sum):not(.table__row--head):not(.table__row--foot):hover + .table__th + background-color: rgba(0, 0, 0, 0.07) + .table__row--sum td.table__td::before content: 'Σ' font-weight: bold diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index ed70fa1f2..63df0d449 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -856,8 +856,7 @@ postCorrectionR tid ssh csh shn cid = do addMessageI Success MsgRatingFilesUpdated redirect $ CSubmissionR tid ssh csh shn cid CorrectionR - let sheetTypeDesc = mr sheetType - heading = MsgCorrectionHead tid ssh csh shn cid + let heading = MsgCorrectionHead tid ssh csh shn cid headingWgt = [whamlet| $newline never _{heading} @@ -877,12 +876,9 @@ getCorrectionUserR tid ssh csh shn cid = do results <- runDB $ correctionData tid ssh csh shn sub case results of - [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, corrector@(Just _))] -> do - mr <- getMessageRender + [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, corrector@(Just _))] -> let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c)) - sheetTypeDesc = mr sheetType - defaultLayout $ - $(widgetFile "correction-user") + in defaultLayout $(widgetFile "correction-user") _ -> notFound diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 75bbcdd13..2ea973441 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -1,6 +1,16 @@ {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-incomplete-uni-patterns #-} -module Handler.Submission where +module Handler.Submission + ( getSubmissionNewR, postSubmissionNewR + , getSubShowR, postSubShowR + , getSubmissionOwnR + , getSInviteR, postSInviteR + , getSubDownloadR + , getSubArchiveR + , getSubDelR, postSubDelR + , getCorrectionsDownloadR + , getSubAssignR, postSubAssignR + ) where import Import @@ -32,6 +42,7 @@ import qualified Data.Set as Set import Data.Map ((!), (!?)) import qualified Data.Map as Map -- import Data.Bifunctor +import qualified Data.Text as Text import Text.Blaze (Markup) import Data.Aeson hiding (Result(..)) @@ -320,7 +331,7 @@ submissionHelper tid ssh csh shn mcid = do msmid <- traverse decrypt mcid actionUrl <- fromMaybe (error "submissionHelper called from 404-handler") <$> getCurrentRoute - (Entity shid Sheet{..}, buddies, lastEdits, maySubmit, isLecturer, isOwner) <- runDB $ do + (Entity shid Sheet{..}, buddies, lastEdits, maySubmit, isLecturer, isOwner, msubmission, corrector) <- runDB $ do csheet@(Entity shid Sheet{..}) <- fetchSheet tid ssh csh shn maySubmit <- (== Authorized) <$> evalAccessDB actionUrl True isLecturer <- (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn SSubsR) True @@ -365,6 +376,7 @@ submissionHelper tid ssh csh shn mcid = do , maySubmit , isLecturer , not isLecturer + , Nothing, Nothing ) (Nothing, RegisteredGroups) -> do buddies <- E.select . E.from $ \(submissionGroup `E.InnerJoin` user) -> do @@ -393,12 +405,14 @@ submissionHelper tid ssh csh shn mcid = do , maySubmit , isLecturer , not isLecturer + , Nothing, Nothing ) - (Nothing, _) -> return (csheet, Set.empty, [], maySubmit, isLecturer, not isLecturer) + (Nothing, _) -> return (csheet, Set.empty, [], maySubmit, isLecturer, not isLecturer, Nothing, Nothing) (Just smid, _) -> do void $ submissionMatchesSheet tid ssh csh shn (fromJust mcid) - shid' <- submissionSheet <$> get404 smid + sub@Submission{..} <- get404 smid + let shid' = submissionSheet unless (shid == shid') $ invalidArgsI [MsgSubmissionWrongSheet] -- fetch buddies from current submission @@ -427,7 +441,10 @@ submissionHelper tid ssh csh shn mcid = do else E.nothing return (userName, submissionEdit E.^. SubmissionEditTime) forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time - return (csheet,buddies,lastEdits,maySubmit,isLecturer,isOwner) + + corrector <- fmap join $ traverse getEntity submissionRatingBy + + return (csheet,buddies,lastEdits,maySubmit,isLecturer,isOwner,Just sub,corrector) -- @submissionModeUser == Nothing@ below iff we are currently serving a user with elevated rights (lecturer, admin, ...) -- Therefore we do not restrict upload behaviour in any way in that case ((res,formWidget'), formEnctype) <- runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (UploadAny True Nothing) . submissionModeUser $ sheetSubmissionMode) sheetGrouping isLecturer $ bool id (Set.insert $ Right uid) isOwner buddies @@ -643,6 +660,14 @@ submissionHelper tid ssh csh shn mcid = do } mFileTable <- traverse (runDB . dbTableWidget' def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid + + showCorrection <- fmap (fromMaybe False) . for mcid $ \cid -> hasReadAccessTo $ CSubmissionR tid ssh csh shn cid CorrectionR + + let correctionWdgt = guardOnM (showCorrection && maybe False submissionRatingDone msubmission) ((,) <$> msubmission <*> mcid) <&> \(Submission{..}, cid) -> + let ratingComment = assertM (not . null) $ Text.strip <$> submissionRatingComment + in $(widgetFile "correction-user") + + defaultLayout $ do setTitleI $ MsgSubmissionEditHead tid ssh csh shn let urlArchive cID = CSubmissionR tid ssh csh shn cID $ SubArchiveR SubmissionCorrected diff --git a/templates/correction-user.hamlet b/templates/correction-user.hamlet index 252b9d046..88f443a8b 100644 --- a/templates/correction-user.hamlet +++ b/templates/correction-user.hamlet @@ -1,5 +1,5 @@
- +
- - -
_{MsgSubmission} #{cid} @@ -17,11 +17,11 @@ $case grading $of Points{..}
#{sheetTypeDesc} + _{sheetType} _{MsgAchievedOf points maxPoints} $of PassPoints{..}
#{sheetTypeDesc} + _{sheetType} $if fromMaybe False (gradingPassed grading points) _{MsgPassed} @@ -32,7 +32,7 @@ _{MsgPassAchievedOf points passingPoints maxPoints} $of PassBinary
#{sheetTypeDesc} + _{sheetType} $if fromMaybe False (gradingPassed grading points) _{MsgPassed} diff --git a/templates/submission.hamlet b/templates/submission.hamlet index 1a91970af..69f2e5cf9 100644 --- a/templates/submission.hamlet +++ b/templates/submission.hamlet @@ -1,5 +1,10 @@ $newline never $maybe cID <- mcid + $maybe wdgt <- correctionWdgt +
+

_{MsgRating} + ^{wdgt} +
$case sheetSubmissionMode $of SubmissionMode False Nothing @@ -15,7 +20,6 @@ $maybe cID <- mcid ) $maybe fileTable <- mFileTable -

_{MsgSubmissionFiles} ^{fileTable} $if maySubmit && not (null lastEdits)