diff --git a/ChangeLog.md b/ChangeLog.md index fbe1b5009..2ffc74b71 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,4 +1,9 @@ + * Version 31.07.2018 + + Viele Verbesserung zur Anzeige von Korrekturen + * Version 10.07.2018 + Bugfixes, wählbares Format für Datum * Version 04.07.2018 diff --git a/messages/de.msg b/messages/de.msg index 8b271d82e..f9d9408a1 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -190,6 +190,7 @@ NotPassed: Nicht bestanden RatingTime: Korrigiert RatingComment: Kommentar SubmissionUsers: Studenten +Rating: Korrektur RatingPoints: Punkte RatingFiles: Korrigierte Dateien @@ -227,4 +228,4 @@ EditedBy name@Text time@Text: Durch #{name} um #{time} LastEdit: Letzte Änderung SubmissionFilesIgnored: Es wurden Dateien in der hochgeladenen Abgabe ignoriert: -SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}. \ No newline at end of file +SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}. diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 3d2a61116..c2792c48d 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -85,19 +85,18 @@ colTerm = sortable (Just "term") (i18nCell MsgTerm) colCourse :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colCourse = sortable (Just "course") (i18nCell MsgCourse) - $ \DBRow{ dbrOutput=(_, _, course, _, _) } -> cell $ + $ \DBRow{ dbrOutput=(_, _, course, _, _) } -> let tid = course ^. _3 csh = course ^. _2 - in [whamlet|#{display csh}|] + in anchorCell (CourseR tid csh CShowR) [whamlet|#{display csh}|] colSheet :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colSheet = sortable (Just "sheet") (i18nCell MsgSheet) - $ \DBRow{ dbrOutput=(_, sheet, course, _, _) } -> cell $ - let tid = course ^. _3 - csh = course ^. _2 - shn = sheetName $ entityVal sheet - in [whamlet|#{display shn}|] - -- textCell $ sheetName $ entityVal sheet + $ \DBRow{ dbrOutput=(_, sheet, course, _, _) } -> + let tid = course ^. _3 + csh = course ^. _2 + shn = sheetName $ entityVal sheet + in anchorCell (CSheetR tid csh shn SShowR) [whamlet|#{display shn}|] colCorrector :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case @@ -106,12 +105,15 @@ colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case colSubmissionLink :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colSubmissionLink = sortable Nothing (i18nCell MsgSubmission) - $ \DBRow{ dbrOutput=(submission, sheet, course, _, _) } -> cell $ do + $ \DBRow{ dbrOutput=(submission, sheet, course, _, _) } -> let tid = course ^. _3 csh = course ^. _2 shn = sheetName $ entityVal sheet - cid <- encrypt (entityKey submission :: SubmissionId) - [whamlet|#{display cid}|] + mkCid = encrypt (entityKey submission :: SubmissionId) -- TODO: executed twice + mkRoute = do + cid <- mkCid + return $ CSubmissionR tid csh shn cid SubShowR + in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|]) colSelect :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData CryptoFileNameSubmission Bool))) colSelect = dbSelect id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId @@ -121,6 +123,15 @@ colSubmittors = sortable Nothing (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutp cell = listCell (Map.toList users) $ \(userId, User{..}) -> anchorCellM (AdminUserR <$> encrypt userId) (toWidget userDisplayName) in cell & cellAttrs <>~ [("class", "list--inline list--comma-separated")] +colRating :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) +colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId Submission{..}, Entity _ Sheet{..}, course, _, _) } -> + let tid = course ^. _3 + csh = course ^. _2 + -- shn = sheetName + mkRoute = do + cid <- encrypt subId + return $ CSubmissionR tid csh sheetName cid CorrectionR + in anchorCellM mkRoute $(widgetFile "widgets/rating") type CorrectionTableExpr = (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User)) @@ -165,6 +176,9 @@ makeCorrectionsTable whereClause colChoices psValidator = do , ( "corrector" , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector) -> corrector E.?. UserDisplayName ) + , ( "rating" + , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingPoints + ) ] , dbtFilter = [ ( "term" , FilterColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) tids -> if @@ -317,6 +331,7 @@ postCorrectionsR = do , colCourse , colSheet , colSubmissionLink + , colRating ] -- Continue here psValidator = def & restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information @@ -337,6 +352,7 @@ postCCorrectionsR tid csh = do , colCorrector , colSubmittors , colSubmissionLink + , colRating ] -- Continue here psValidator = def correctionsR whereClause colonnade psValidator $ Map.fromList @@ -355,6 +371,7 @@ postSSubsR tid csh shn = do , colCorrector , colSubmittors , colSubmissionLink + , colRating ] psValidator = def correctionsR whereClause colonnade psValidator $ Map.fromList diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 64cc2a6b2..150efc3d3 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -156,49 +156,71 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do getSheetListR :: TermId -> CourseShorthand -> Handler Html getSheetListR tid csh = do + muid <- maybeAuthId Entity cid _ <- runDB . getBy404 $ CourseTermShort tid csh let - sheetData :: E.SqlExpr (E.Entity Sheet) -> E.SqlQuery (E.SqlExpr (Entity Sheet), E.SqlExpr (E.Value (Maybe UTCTime))) - sheetData sheet = do + sheetData :: E.SqlExpr (Entity Sheet) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity Submission)) `E.InnerJoin` (E.SqlExpr (Maybe (Entity SubmissionUser)))) -> E.SqlQuery (E.SqlExpr (Entity Sheet), E.SqlExpr (E.Value (Maybe UTCTime)),E.SqlExpr (Maybe (Entity Submission))) + sheetData (sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) = do + E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission + E.on $ (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet + E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid let sheetEdit = E.sub_select . E.from $ \sheetEdit -> do E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId return . E.max_ $ sheetEdit E.^. SheetEditTime E.where_ $ sheet E.^. SheetCourse E.==. E.val cid - return (sheet, sheetEdit) + return (sheet, sheetEdit, submission) sheetCol = widgetColonnade . mconcat $ [ sortable (Just "name") (i18nCell MsgSheet) - $ \(Entity _ Sheet{..}, _) -> anchorCell (CSheetR tid csh sheetName SShowR) (toWidget sheetName) + $ \(Entity _ Sheet{..}, _, _) -> anchorCell (CSheetR tid csh sheetName SShowR) (toWidget sheetName) , sortable (Just "last-edit") (i18nCell MsgLastEdit) - $ \(_, E.Value mEditTime) -> case mEditTime of - Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget - Nothing -> mempty + $ \(_, E.Value mEditTime, _) -> case mEditTime of + Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget + Nothing -> mempty , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom) - $ \(Entity _ Sheet{..}, _) -> cell $ formatTime SelFormatDateTime sheetActiveFrom >>= toWidget + $ \(Entity _ Sheet{..}, _, _) -> cell $ formatTime SelFormatDateTime sheetActiveFrom >>= toWidget , sortable (Just "submission-until") (i18nCell MsgSheetActiveTo) - $ \(Entity _ Sheet{..}, _) -> cell $ formatTime SelFormatDateTime sheetActiveTo >>= toWidget + $ \(Entity _ Sheet{..}, _, _) -> cell $ formatTime SelFormatDateTime sheetActiveTo >>= toWidget , sortable Nothing (i18nCell MsgSheetType) - $ \(Entity _ Sheet{..}, _) -> textCell $ display sheetType + $ \(Entity _ Sheet{..}, _, _) -> textCell $ display sheetType + , sortable (Just "submitted") (i18nCell MsgSubmission) + $ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of + Nothing -> mempty + (Just (Entity sid Submission{..})) -> + let mkCid = encrypt sid -- TODO: executed twice + mkRoute = do + cid <- mkCid + return $ CSubmissionR tid csh sheetName cid SubShowR + in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|]) + , sortable (Just "rating") (i18nCell MsgRating) + $ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of + Nothing -> mempty + (Just (Entity sid Submission{..})) -> + let mkCid = encrypt sid + mkRoute = do + cid <- mkCid + return $ CSubmissionR tid csh sheetName cid CorrectionR + in anchorCellM mkRoute $(widgetFile "widgets/rating") ] psValidator = def & defaultSorting [("submission-since", SortAsc)] table <- dbTable psValidator $ DBTable { dbtSQLQuery = sheetData , dbtColonnade = sheetCol - , dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _) } + , dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _, _) } -> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid csh sheetName SShowR) False) , dbtSorting = Map.fromList [ ( "name" - , SortColumn $ \sheet -> sheet E.^. SheetName + , SortColumn $ \(sheet `E.LeftOuterJoin` submission) -> sheet E.^. SheetName ) , ( "last-edit" - , SortColumn $ \sheet -> E.sub_select . E.from $ \sheetEdit -> E.distinctOnOrderBy [E.desc $ sheetEdit E.?. SheetEditTime] $ do + , SortColumn $ \(sheet `E.LeftOuterJoin` submission) -> E.sub_select . E.from $ \sheetEdit -> E.distinctOnOrderBy [E.desc $ sheetEdit E.?. SheetEditTime] $ do return $ sheetEdit E.?. SheetEditTime ) , ( "submission-since" - , SortColumn $ \sheet -> sheet E.^. SheetActiveFrom + , SortColumn $ \(sheet `E.LeftOuterJoin` submission) -> sheet E.^. SheetActiveFrom ) , ( "submission-until" - , SortColumn $ \sheet -> sheet E.^. SheetActiveTo + , SortColumn $ \(sheet `E.LeftOuterJoin` submission) -> sheet E.^. SheetActiveTo ) ] , dbtFilter = Map.fromList diff --git a/templates/widgets/rating.hamlet b/templates/widgets/rating.hamlet new file mode 100644 index 000000000..f1c321bfd --- /dev/null +++ b/templates/widgets/rating.hamlet @@ -0,0 +1,16 @@ +$# Display Rating, expects +$# submissionRatingPoints :: Maybe points + +$maybe points <- submissionRatingPoints + $case sheetType + $of Bonus{..} + _{MsgAchievedOf points maxPoints} + $of Normal{..} + _{MsgAchievedOf points maxPoints} + $of Pass{..} + $if points >= passingPoints + _{MsgPassed} + $else + _{MsgNotPassed} + $of NotGraded + #{show tickmark}