From e676be8f3f19403b8ca73d7ce454343bcc29d96f Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Fri, 17 May 2019 18:51:55 +0200 Subject: [PATCH] Fixes #374 --- src/Handler/Corrections.hs | 108 ++++++++++++++++--------------------- 1 file changed, 47 insertions(+), 61 deletions(-) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 536ebb35a..33bcb4992 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -36,6 +36,7 @@ import Data.Monoid (All(..)) -- import qualified Data.Conduit.List as C import qualified Database.Esqueleto as E +import qualified Database.Esqueleto.Internal.Language (From) -- import qualified Database.Esqueleto.Internal.Sql as E -- import Control.Monad.Writer (MonadWriter(..), execWriterT) @@ -60,7 +61,7 @@ import Data.Foldable (foldrM) 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)) type CorrectionTableWhere = CorrectionTableExpr -> E.SqlExpr (E.Value Bool) -type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Map UserId (User, Maybe Pseudonym)) +type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Maybe UTCTime, Map UserId (User, Maybe Pseudonym)) correctionsTableQuery :: CorrectionTableWhere -> (CorrectionTableExpr -> v) -> CorrectionTableExpr -> E.SqlQuery v correctionsTableQuery whereClause returnStatement t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) = do @@ -70,6 +71,12 @@ correctionsTableQuery whereClause returnStatement t@((course `E.InnerJoin` sheet E.where_ $ whereClause t return $ returnStatement t +lastEditQuery :: Database.Esqueleto.Internal.Language.From query expr backend (expr (Entity SubmissionEdit)) + => expr (Entity Submission) -> expr (E.Value (Maybe UTCTime)) +lastEditQuery submission = E.sub_select $ E.from $ \edit -> do + E.where_ $ edit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId + return $ E.max_ $ edit E.^. SubmissionEditTime + -- Where Clauses ratedBy :: UserId -> CorrectionTableWhere ratedBy uid ((_course `E.InnerJoin` _sheet `E.InnerJoin` submission) `E.LeftOuterJoin` _corrector) = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid) @@ -84,40 +91,41 @@ sheetIs shid ((_course `E.InnerJoin` sheet `E.InnerJoin` _submission) `E.LeftO -- Columns colTerm :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) colTerm = sortable (Just "term") (i18nCell MsgTerm) - $ \DBRow{ dbrOutput=(_, _, course, _, _) } -> - -- cell [whamlet| _{untermKey $ course ^. _3}|] -- lange, internationale Semester - textCell $ termToText $ unTermKey $ course ^. _3 -- kurze Semsterkürzel + $ \DBRow{ dbrOutput } -> + textCell $ termToText $ unTermKey $ dbrOutput ^. _3 . _3 -- kurze Semsterkürzel colSchool :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) colSchool = sortable (Just "school") (i18nCell MsgCourseSchool) - $ \DBRow{ dbrOutput=(_, _, course, _, _) } -> + $ \DBRow{ dbrOutput } -> let course = dbrOutput ^. _3 in anchorCell (TermSchoolCourseListR (course ^. _3) (course ^. _4)) [whamlet|#{unSchoolKey (course ^. _4)}|] colCourse :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) colCourse = sortable (Just "course") (i18nCell MsgCourse) - $ \DBRow{ dbrOutput=(_, _, (_,csh,tid,sid), _, _) } -> courseCellCL (tid,sid,csh) + $ \DBRow{ dbrOutput=(_, _, (_,csh,tid,sid),_ , _, _) } -> courseCellCL (tid,sid,csh) colSheet :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) -colSheet = sortable (Just "sheet") (i18nCell MsgSheet) - $ \DBRow{ dbrOutput=(_, sheet, course, _, _) } -> - let tid = course ^. _3 +colSheet = sortable (Just "sheet") (i18nCell MsgSheet) $ \row -> + let sheet = row ^. _dbrOutput . _2 + course= row ^. _dbrOutput . _3 + tid = course ^. _3 ssh = course ^. _4 csh = course ^. _2 shn = sheetName $ entityVal sheet in anchorCell (CSheetR tid ssh csh shn SShowR) [whamlet|#{display shn}|] colSheetType :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) -colSheetType = sortable (toNothing "sheetType") (i18nCell MsgSheetType) - $ \DBRow{ dbrOutput=(_, sheet, _, _, _) } -> i18nCell . sheetType $ entityVal sheet +colSheetType = sortable (toNothing "sheetType") (i18nCell MsgSheetType) $ + i18nCell . sheetType <$> view (_dbrOutput . _2 . _entityVal) + -- $ \DBRow{ dbrOutput=(_, sheet, _, _, _, _) } -> i18nCell . sheetType $ entityVal sheet colCorrector :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case - DBRow{ dbrOutput = (_, _, _, Nothing , _) } -> cell mempty - DBRow{ dbrOutput = (_, _, _, Just (Entity _ User{..}), _) } -> userCell userDisplayName userSurname + DBRow{ dbrOutput = (_, _, _, Nothing , _, _) } -> cell mempty + DBRow{ dbrOutput = (_, _, _, Just (Entity _ User{..}), _, _) } -> userCell userDisplayName userSurname colSubmissionLink :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) colSubmissionLink = sortable Nothing (i18nCell MsgSubmission) - $ \DBRow{ dbrOutput=(submission, sheet, course, _, _) } -> + $ \DBRow{ dbrOutput=(submission, sheet, course, _, _,_) } -> let csh = course ^. _2 tid = course ^. _3 ssh = course ^. _4 @@ -129,10 +137,10 @@ colSubmissionLink = sortable Nothing (i18nCell MsgSubmission) in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|]) colSelect :: forall act h. (Semigroup act, Monoid act, Headedness h) => Colonnade h CorrectionTableData (DBCell _ (FormResult (act, DBFormResult CryptoFileNameSubmission Bool CorrectionTableData), SheetTypeSummary)) -colSelect = dbSelect (_1 . applying _2) id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId +colSelect = dbSelect (_1 . applying _2) id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> encrypt subId colSubmittors :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) -colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, users) } -> let +colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, _, users) } -> let csh = course ^. _2 tid = course ^. _3 ssh = course ^. _4 @@ -144,12 +152,12 @@ colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DB in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")] colSMatrikel :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) -colSMatrikel = sortable Nothing (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, _, _, _, users) } -> let +colSMatrikel = sortable Nothing (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, _, _, _, _, users) } -> let protoCell = listCell (Map.toList users) $ \(userId, (User{..}, _)) -> anchorCellM (AdminUserR <$> encrypt userId) (maybe mempty toWidget userMatrikelnummer) in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")] colRating :: forall m a. IsDBTable m (a, SheetTypeSummary) => Colonnade Sortable CorrectionTableData (DBCell m (a, SheetTypeSummary)) -colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId sub@Submission{..}, Entity _ Sheet{..}, course, _, _) } -> +colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId sub@Submission{..}, Entity _ Sheet{..}, course, _, _, _) } -> let csh = course ^. _2 tid = course ^. _3 ssh = course ^. _4 @@ -169,65 +177,40 @@ colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(E ] colAssigned :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) -colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _) } -> +colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _) } -> maybe mempty dateTimeCell submissionRatingAssigned colRated :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) -colRated = sortable (Just "ratingtime") (i18nCell MsgRatingTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _) } -> +colRated = sortable (Just "ratingtime") (i18nCell MsgRatingTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _) } -> maybe mempty dateTimeCell submissionRatingTime colPseudonyms :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) -colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_, _, _, _, users) } -> let +colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_, _, _, _, _, users) } -> let lCell = listCell (catMaybes $ snd . snd <$> Map.toList users) $ \pseudo -> cell [whamlet|#{review _PseudonymText pseudo}|] in lCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")] colRatedField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (Bool, a, b) CorrectionTableData))) colRatedField = sortable Nothing (i18nCell MsgRatingDone) $ formCell id - (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId) - (\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _) } mkUnique -> over (_1.mapped) (_1 .~) . over _2 fvInput <$> mreq checkBoxField (fsUniq mkUnique "rated") (Just done)) + (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId) + (\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _, _) } mkUnique -> over (_1.mapped) (_1 .~) . over _2 fvInput <$> mreq checkBoxField (fsUniq mkUnique "rated") (Just done)) colPointsField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, Maybe Points, b) CorrectionTableData))) colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ formCell id - (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId) - (\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _) } mkUnique -> case sheetType of + (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId) + (\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _, _) } mkUnique -> case sheetType of NotGraded -> over (_1.mapped) (_2 .~) <$> pure (FormSuccess Nothing, mempty) _other -> over (_1.mapped) (_2 .~) . over _2 fvInput <$> mopt pointsField (fsUniq mkUnique "points") (Just submissionRatingPoints) ) colCommentField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, b, Maybe Text) CorrectionTableData))) colCommentField = sortable (Just "comment") (i18nCell MsgRatingComment) $ formCell id - (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId) - (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment)) + (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId) + (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment)) -colLastEdit :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, b, Maybe Text) CorrectionTableData))) +colLastEdit :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) colLastEdit = sortable (Just "last-edit") (i18nCell MsgLastEdit) $ - \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> sqlCell $ do - edits <- E.select $ E.from $ \edit -> do - E.where_ $ edit E.^. SubmissionEditSubmission E.==. E.val subId - return $ E.max_ $ edit E.^. SubmissionEditTime - return [whamlet| - $newline never - DATES - $forall ed <- edits - #{show ed} - |] - --- colLastEdit' :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, b, Maybe Text) CorrectionTableData))) --- colLastEdit' = sortable (Just "last-edit") (i18nCell MsgLastEdit) $ (formCell id --- (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId) --- (const mempty)) --- -- \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> sqlCell $ do --- -- edits <- E.select $ E.from $ \edit -> do --- -- E.where_ $ edit E.^. SubmissionEditSubmission E.==. E.val subId --- -- return $ E.max_ $ edit E.^. SubmissionEditTime --- -- return [whamlet| --- -- $newline never --- -- DATES --- -- $forall ed <- edits --- -- #{show ed} --- -- |] - + \DBRow{ dbrOutput=(_, _, _, _, mbLastEdit, _) } -> maybe mempty dateTimeCell mbLastEdit makeCorrectionsTable :: ( IsDBTable m x, ToSortable h, Functor h ) @@ -241,10 +224,10 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d , course E.^. CourseTerm , course E.^. CourseSchool :: E.SqlExpr (E.Value SchoolId) ) - in (submission, sheet, crse, corrector) + in (submission, sheet, crse, corrector, lastEditQuery submission) ) dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CorrectionTableData - dbtProj = traverse $ \(submission@(Entity sId _), sheet@(Entity shId _), (E.Value courseName, E.Value courseShorthand, E.Value courseTerm, E.Value courseSchool), mCorrector) -> do + dbtProj = traverse $ \(submission@(Entity sId _), sheet@(Entity shId _), (E.Value courseName, E.Value courseShorthand, E.Value courseTerm, E.Value courseSchool), mCorrector, E.Value mbLastEdit) -> do submittors <- lift . E.select . E.from $ \((submissionUser `E.InnerJoin` user) `E.LeftOuterJoin` pseudonym) -> do E.on $ pseudonym E.?. SheetPseudonymUser E.==. E.just (user E.^. UserId) E.&&. pseudonym E.?. SheetPseudonymSheet E.==. E.just (E.val shId) @@ -254,7 +237,7 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d return (user, pseudonym E.?. SheetPseudonymPseudonym) let submittorMap = foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors - dbtProj' (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, submittorMap) + dbtProj' (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, mbLastEdit, submittorMap) dbTable psValidator DBTable { dbtSQLQuery , dbtRowKey = \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) -> submission E.^. SubmissionId @@ -300,6 +283,9 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d , ( "comment" -- sorting by comment specifically requested by correctors to easily see submissions to be done , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingComment ) + , ( "last-edit" + , SortColumn $ \((_course `E.InnerJoin` _sheet `E.InnerJoin` submission) `E.LeftOuterJoin` _corrector) -> lastEditQuery submission + ) ] , dbtFilter = Map.fromList [ ( "term" @@ -580,8 +566,7 @@ postCCorrectionsR tid ssh csh = do , colSMatrikel , colSubmittors , colSubmissionLink - -- , colLastEdit -- this does not type - -- , colLastEdit' + , colLastEdit , colRating , colRated , colCorrector @@ -605,6 +590,7 @@ postSSubsR tid ssh csh shn = do , colSMatrikel , colSubmittors , colSubmissionLink + , colLastEdit , colRating , colRated , colCorrector @@ -928,8 +914,8 @@ postCorrectionsGradeR = do ] -- Continue here psValidator = def & defaultSorting [SortDescBy "ratingtime"] :: PSValidator (MForm (HandlerT UniWorX IO)) (FormResult (DBFormResult SubmissionId (Bool, Maybe Points, Maybe Text) CorrectionTableData)) - unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment) - dbtProj' i@(Entity subId _, Entity _ Sheet{ sheetName = shn }, (_, csh, tid, ssh), _, _) = do + unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment) + dbtProj' i@(Entity subId _, Entity _ Sheet{ sheetName = shn }, (_, csh, tid, ssh), _, _, _) = do cID <- encrypt subId void . assertM (== Authorized) . lift $ evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) True return i