From cc4c8a897e2796868dd6bbd21ac732d0a7873531 Mon Sep 17 00:00:00 2001 From: SJost Date: Fri, 14 Sep 2018 17:54:13 +0200 Subject: [PATCH] Fixes #179 --- messages/uniworx/de.msg | 2 +- src/Handler/Profile.hs | 82 ++++++++++++++++++++++++++++++++---- src/Handler/Submission.hs | 64 +++++++++++++++------------- templates/profileData.hamlet | 12 +++--- templates/submission.hamlet | 18 +++----- 5 files changed, 122 insertions(+), 56 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 50e5f7aa6..be5c435f5 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -267,7 +267,7 @@ AmbiguousUTCTime: Der angegebene Zeitpunkt lässt sich nicht eindeutig zu UTC ko IllDefinedUTCTime: Der angegebene Zeitpunkt lässt sich nicht zu UTC konvertieren LastEdits: Letzte Änderungen -EditedBy name@Text time@Text: Durch #{name} um #{time} +EditedBy name@Text time@Text: #{time} durch #{name} LastEdit: Letzte Änderung LastEditByUser: Ihre letzte Bearbeitung NoEditByUser: Nicht von Ihnen bearbeitet diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index dd0228899..a86509bf0 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -160,16 +160,16 @@ getProfileDataR = do (hasRows, ownedCoursesTable) <- mkOwnedCoursesTable uid -- Tabelle mit allen Teilnehmer: Kurs (link), Datum enrolledCoursesTable <- mkEnrolledCoursesTable uid + -- Tabelle mit allen Klausuren und Noten + examTable <- return [whamlet| TOOD: Klausuranmeldungen anzeigen |] -- TODO -- Tabelle mit allen Abgaben und Abgabe-Gruppen submissionTable <- mkSubmissionTable uid -- Tabelle mit allen Abgabegruppen submissionGroupTable <- mkSubmissionGroupTable uid + -- Tabelle mit allen Korrektor-Aufgaben + correctionsTable <- mkCorrectionsTable uid -- Tabelle mit allen Tutorials tutorialTable <- return [whamlet| TOOD: Tutorials anzeigen |] -- TODO - -- Tabelle mit allen Korrektor-Aufgaben - correctorTable <- return [whamlet| TOOD: Korrekturen anzeigen |] -- TODO - -- Tabelle mit allen Klausuren und Noten - examTable <- return [whamlet| TOOD: Klausuranmeldungen anzeigen |] -- TODO defaultLayout $ do $(widgetFile "profileData") $(widgetFile "dsgvDisclaimer") @@ -346,6 +346,10 @@ mkSubmissionTable = in \uid -> let dbtSQLQuery = dbtSQLQuery' uid dbtSorting = dbtSorting' uid in dbTableWidget' validator $ DBTable {..} +-- in do dbtSQLQuery <- dbtSQLQuery' +-- dbtSorting <- dbtSorting' +-- return $ dbTableWidget' validator $ DBTable {..} + mkSubmissionGroupTable :: UserId -> Handler Widget @@ -353,7 +357,6 @@ mkSubmissionGroupTable :: UserId -> Handler Widget mkSubmissionGroupTable = let dbtIdent = "subGroups" :: Text dbtStyle = def - 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 = id @@ -411,8 +414,71 @@ mkSubmissionGroupTable = ] in \uid -> let dbtSQLQuery = dbtSQLQuery' uid in dbTableWidget' validator $ DBTable {..} --- in do dbtSQLQuery <- dbtSQLQuery' --- dbtSorting <- dbtSorting' --- return $ dbTableWidget' validator $ DBTable {..} + + + +mkCorrectionsTable :: UserId -> Handler Widget +-- Table listing all corrections made by the given user +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 = 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 + 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 + + dbtProj = \x -> return $ x + & _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh)) + & _dbrOutput . _3 %~ 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 ) + , 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) + ] + + 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)] + 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) + ] + 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 ) + , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool ) + ] + in \uid -> let dbtSQLQuery = dbtSQLQuery' uid + in dbTableWidget' validator $ DBTable {..} diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 506932c46..4b9ccd9f2 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -31,6 +31,7 @@ import Control.Monad.Trans.Maybe import Control.Monad.State.Class import Control.Monad.Trans.State.Strict (StateT) +import Data.Monoid (Any(..)) import Data.Maybe (fromJust) import qualified Data.Maybe import qualified Data.Text as Text @@ -106,9 +107,12 @@ getSubmissionOwnR tid ssh csh shn = do submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SubmissionMode -> Handler Html submissionHelper tid ssh csh shn (SubmissionMode mcid) = do - uid <- requireAuthId - msmid <- traverse decrypt mcid - (Entity shid Sheet{..}, buddies, lastEdits, lastEditsUser) <- runDB $ do + uid <- requireAuthId + msmid <- traverse decrypt mcid + actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute + maySubmit <- (== Authorized) <$> isAuthorized actionUrl True -- affects visibility of Edit-Dates, Submission-Button, etc. + + (Entity shid Sheet{..}, buddies, lastEdits) <- runDB $ do sheet@(Entity shid Sheet{..}) <- fetchSheet tid ssh csh shn case msmid of Nothing -> do @@ -136,7 +140,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, map E.unValue buddies, []) (E.Value smid:_) -> do cID <- encrypt smid addMessageI "info" $ MsgSubmissionAlreadyExists @@ -146,30 +150,31 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do shid' <- submissionSheet <$> get404 smid -- fetch buddies from current submission - buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do - E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId) - E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val smid - E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid - E.orderBy [E.asc $ user E.^. UserEmail] - return $ user E.^. UserEmail - -- mLastEdit <- selectFirst [SubmissionEditSubmission ==. smid] [Desc SubmissionEditTime] - lastEditValues <- E.select . E.from $ \(user `E.InnerJoin` submissionEdit) -> do - E.on (user E.^. UserId E.==. submissionEdit E.^. SubmissionEditUser) - E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid - E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime] - -- E.limit numberOfSubmissionEditDates -- DEPRECATED we shall show all edits - return $ (user E.^. UserDisplayName, submissionEdit E.^. SubmissionEditTime) - lastEdits <- forM lastEditValues $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time - 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 1 - return $ submissionEdit E.^. SubmissionEditTime - lastEditsUser <- forM lastEditUserValues $ \(E.Value time) -> formatTime SelFormatDateTime time - return (sheet,buddies,lastEdits,lastEditsUser) + (Any isOwner, buddies) <- do + submittors <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do + E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId) + E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val smid + 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]) + return $ foldMap breakUserFromBuddies submittors + + lastEdits <- do + raw <- E.select . E.from $ \(user `E.InnerJoin` submissionEdit) -> do + E.on (user E.^. UserId E.==. submissionEdit E.^. SubmissionEditUser) + 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 + then E.just $ user E.^. UserDisplayName + else E.nothing + return $ (userName, submissionEdit E.^. SubmissionEditTime) + forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time + return (sheet,buddies,lastEdits) let unpackZips = True -- undefined -- TODO - ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid unpackZips sheetGrouping $ map E.unValue buddies + ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid unpackZips sheetGrouping buddies mCID <- runDB $ do res' <- case res of (FormMissing ) -> return $ FormMissing @@ -250,9 +255,6 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do Just cID -> redirect $ CSubmissionR tid ssh csh shn cID SubShowR Nothing -> return () - actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute - maySubmit <- (== Authorized) <$> isAuthorized actionUrl True - -- Maybe construct a table to display uploaded archive files let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (HandlerT UniWorX IO) ()) colonnadeFiles cid = mconcat @@ -311,6 +313,8 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do defaultLayout $ do setTitleI $ MsgSubmissionEditHead tid ssh csh shn + let urlArchive cID = CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionCorrected)) + urlOriginal cID = CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionOriginal)) $(widgetFile "submission") diff --git a/templates/profileData.hamlet b/templates/profileData.hamlet index eabff2fac..d50327a83 100644 --- a/templates/profileData.hamlet +++ b/templates/profileData.hamlet @@ -19,6 +19,11 @@
^{enrolledCoursesTable} +
+

Noten +
+ ^{examTable} +

Übungsgruppen
@@ -40,12 +45,7 @@

_{MsgCorrector}
- ^{correctorTable} - -
-

Klausuren -
- ^{examTable} + ^{correctionsTable}

TODO: Knopf zum Löschen aller Daten erstellen diff --git a/templates/submission.hamlet b/templates/submission.hamlet index 2f70d98a0..d5044150b 100644 --- a/templates/submission.hamlet +++ b/templates/submission.hamlet @@ -1,8 +1,8 @@ $maybe cID <- mcid

- Archiv - (Original) + Archiv + (Original) $maybe fileTable <- mFileTable

_{MsgSubmissionFiles} @@ -11,15 +11,11 @@ $maybe cID <- mcid $if not (null lastEdits)

_{MsgLastEdits}
    - $forall (name,time) <- lastEdits -
  • _{MsgEditedBy name time} - - _{MsgLastEditByUser}: # - $if null lastEditsUser - _{MsgNoEditByUser} - $else - $forall time <- lastEditsUser - #{display time} + $forall (mbName,time) <- lastEdits + $maybe name <- mbName +
  • _{MsgEditedBy name time} + $nothing +
  • #{display time} $if maySubmit