From ee8990f2442e592730019e38196d22b0dc6b975f Mon Sep 17 00:00:00 2001 From: SJost Date: Tue, 11 Sep 2018 10:51:51 +0200 Subject: [PATCH] Discuss: Convenience.submissionCell --- messages/uniworx/de.msg | 5 ++++- src/Handler/Course.hs | 5 ++--- src/Handler/Profile.hs | 8 +++----- src/Handler/Submission.hs | 20 ++++++++++++++------ src/Handler/Utils/Table/Convenience.hs | 17 +++++++++++++++++ src/Handler/Utils/Table/Pagination.hs | 19 ++++++++++++------- templates/submission.hamlet | 8 ++++++++ 7 files changed, 60 insertions(+), 22 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 98b6e5592..757d54da7 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -128,6 +128,7 @@ SubmissionFile: Datei zur Abgabe SubmissionFiles: Abgegebene Dateien SubmissionAlreadyExistsFor email@UserEmail: #{email} hat bereits eine Abgabe zu diesem bÜbungsblatt. SubmissionEditUser: Ihre letzte Bearbeitung +SubmissionNoEditUser: Nicht von Ihnen bearbeitet CorrectionsTitle: Zugewiesene Korrekturen CourseCorrectionsTitle: Korrekturen für diesen Kurs @@ -239,7 +240,9 @@ RatingPointsDone: Abgabe zählt als korrigiert, gdw. Punktezahl gesetzt ist FileTitle: Dateiname FileModified: Letzte Änderung -FileCorrected: Korrigiert + +Corrected: Korrigiert +FileCorrected: Korrigiert (Dateien) FileCorrectedDeleted: Korrigiert (gelöscht) RatingUpdated: Korrektur gespeichert RatingDeleted: Korrektur zurückgesetzt diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index e63a8f012..287266462 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -270,9 +270,8 @@ getCShowR tid ssh csh = do <*> count [CourseParticipantCourse ==. cid] -- join <*> (case mbAid of -- TODO: Someone please refactor this late-night mess here! Nothing -> return False - (Just aid) -> do - regL <- getBy (UniqueParticipant aid cid) - return $ isJust regL) + (Just aid) -> do regL <- getBy (UniqueParticipant aid cid) + return $ isJust regL) lecturers <- E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index b54490242..106c35c54 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -317,7 +317,7 @@ getProfileDataR = do link= CSheetR tid ssh csh shn SShowR return $ anchorCell link $ display2widget shn - , sortable (toNothing "submission") (i18nCell MsgSubmission) $ do + , sortable (toNothing "submission") (i18nCell MsgSubmission) $ do -- TODO: use submissionCell?! shn <- view $ _dbrOutput . _2 . _unValue sid <- view $ _dbrOutput . _3 . _entityKey crse <- view $ _dbrOutput . _1 @@ -325,10 +325,8 @@ getProfileDataR = do ssh = crse ^. _2 . _unValue csh = crse ^. _4 . _unValue mkCid = encrypt (sid :: SubmissionId) -- TODO: executed twice - mkRoute = do - cid <- mkCid - return $ CSubmissionR tid ssh csh shn cid SubShowR - return $ anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|]) + mkRoute cid = CSubmissionR tid ssh csh shn cid SubShowR + return $ anchorCellM' mkCid mkRoute display2widget , sortable (Just "edit") (i18nCell MsgSubmissionEditUser) $ do regTime <- view $ _dbrOutput . _4 . _unValue return $ maybe mempty timeCell regTime diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index e55a8a25f..c45c061da 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -23,6 +23,7 @@ import Import hiding (joinPath) -- import Yesod.Form.Bootstrap3 import Handler.Utils +import Handler.Utils.Table.Convenience import Network.Mime @@ -107,7 +108,7 @@ submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Submis submissionHelper tid ssh csh shn (SubmissionMode mcid) = do uid <- requireAuthId msmid <- traverse decrypt mcid - (Entity shid Sheet{..}, buddies, lastEdits) <- runDB $ do + (Entity shid Sheet{..}, buddies, lastEdits, lastEditsUser) <- runDB $ do sheet@(Entity shid Sheet{..}) <- fetchSheet tid ssh csh shn case msmid of Nothing -> do @@ -135,7 +136,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid E.orderBy [E.asc $ user E.^. UserEmail] return $ user E.^. UserEmail - return (sheet,buddies,[]) + return (sheet,buddies,[],[]) (E.Value smid:_) -> do cID <- encrypt smid addMessageI "info" $ MsgSubmissionAlreadyExists @@ -159,7 +160,14 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do E.limit numberOfSubmissionEditDates return $ (user E.^. UserDisplayName, submissionEdit E.^. SubmissionEditTime) lastEdits <- forM lastEditValues $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time - return (sheet,buddies,lastEdits) + lastEditUserValues <- E.select . E.from $ \(submissionEdit) -> do + E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid + E.&&. submissionEdit E.^. SubmissionEditUser E.==. E.val uid + E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime] + E.limit numberOfSubmissionEditDates + return $ submissionEdit E.^. SubmissionEditTime + lastEditsUser <- forM lastEditUserValues $ \(E.Value time) -> formatTime SelFormatDateTime time + return (sheet,buddies,lastEdits,lastEditsUser) let unpackZips = True -- undefined -- TODO ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid unpackZips sheetGrouping $ map E.unValue buddies mCID <- runDB $ do @@ -257,17 +265,17 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do | Just True <- origIsFile -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionOriginal fileTitle') ([whamlet|#{fileTitle'}|]) | otherwise -> textCell $ bool (<> "/") id isFile fileTitle' - , sortable Nothing (cell mempty) $ \(coalesce -> (_, mCorr)) -> case mCorr of + , sortable (toNothing "state") (i18nCell MsgCorState) $ \(coalesce -> (_, mCorr)) -> case mCorr of Nothing -> cell mempty Just (_, Entity _ File{..}) | isJust fileContent -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionCorrected fileTitle) ([whamlet|_{MsgFileCorrected}|]) - | otherwise -> textCell MsgFileCorrected + | otherwise -> textCell MsgCorrected , sortable (Just "time") (textCell MsgFileModified) $ \(coalesce -> (mOrig, mCorr)) -> let origTime = fileModified . entityVal . snd <$> mOrig corrTime = fileModified . entityVal . snd <$> mCorr Just fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime - in textCell $ display fileTime + in timeCell fileTime ] coalesce :: ((Maybe (Entity SubmissionFile), Maybe (Entity File)), (Maybe (Entity SubmissionFile), Maybe (Entity File))) -> (Maybe (Entity SubmissionFile, Entity File), Maybe (Entity SubmissionFile, Entity File)) coalesce ((ma, mb), (mc, md)) = ((,) <$> ma <*> mb, (,) <$> mc <*> md) diff --git a/src/Handler/Utils/Table/Convenience.hs b/src/Handler/Utils/Table/Convenience.hs index f3c6627d5..5ff8b12a4 100644 --- a/src/Handler/Utils/Table/Convenience.hs +++ b/src/Handler/Utils/Table/Convenience.hs @@ -68,6 +68,23 @@ courseCell (Course {..}) = anchorCell link name `mappend` desc Nothing -> mempty (Just descr) -> cell [whamlet| ^{modalStatic descr} |] +sheetCell :: IsDBTable m a => (CourseLink', E.Value SheetName) -> DBCell m a +sheetCell (crse, E.Value shn) = + let tid = crse ^. _1 . _unValue + ssh = crse ^. _2 . _unValue + csh = crse ^. _4 . _unValue + link= CSheetR tid ssh csh shn SShowR + in anchorCell link $ display2widget shn + +submissionCell :: IsDBTable m a => (CourseLink', E.Value SheetName, SubmissionId) -> DBCell m a +submissionCell (crse, E.Value shn, sid) = + let tid = crse ^. _1 . _unValue + ssh = crse ^. _2 . _unValue + csh = crse ^. _4 . _unValue + mkCid = encrypt (sid :: SubmissionId) -- TODO: executed twice -- FIXED! + mkRoute cid = CSubmissionR tid ssh csh shn cid SubShowR + mkText cid = display2widget cid + in anchorCellM' mkCid mkRoute mkText -- Generic Columns diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index c550356d1..a4bd71657 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -34,7 +34,7 @@ module Handler.Utils.Table.Pagination , dbTableWidget, dbTableWidget' , widgetColonnade, formColonnade, dbColonnade , cell, textCell, stringCell, i18nCell - , anchorCell, anchorCell', anchorCellM + , anchorCell, anchorCell', anchorCellM, anchorCellM' , tickmarkCell , listCell , formCell, DBFormResult, getDBFormResult @@ -505,13 +505,18 @@ anchorCell' :: IsDBTable m a anchorCell' mkRoute mkWidget val = anchorCell (mkRoute val) (mkWidget val) anchorCellM :: IsDBTable m a => (WidgetT UniWorX IO (Route UniWorX)) -> Widget -> DBCell m a -anchorCellM routeM widget = cell $ do - route <- routeM - authResult <- liftHandlerT $ isAuthorized route False +anchorCellM routeM widget = anchorCellM' routeM id (const widget) + +anchorCellM' :: IsDBTable m a => (WidgetT UniWorX IO x) -> (x -> Route UniWorX) -> (x -> Widget) -> DBCell m a +anchorCellM' xM x2route x2widget = cell $ do + x <- xM + let route = x2route x + widget = x2widget x + authResult <- liftHandlerT $ isAuthorized route False + case authResult of + Authorized -> $(widgetFile "table/cell/link") -- show allowed link + _otherwise -> widget -- don't show prohibited link - if - | Authorized <- authResult -> $(widgetFile "table/cell/link") - | otherwise -> widget listCell :: (IsDBTable m a, Traversable f) => f r' -> (r' -> DBCell m a) -> DBCell m a listCell xs mkCell = review dbCell . ([], ) $ do diff --git a/templates/submission.hamlet b/templates/submission.hamlet index d22ae8ec0..5c62e7f8a 100644 --- a/templates/submission.hamlet +++ b/templates/submission.hamlet @@ -8,6 +8,14 @@ $maybe cID <- mcid