diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 757d54da7..50e5f7aa6 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -127,8 +127,8 @@ SubmissionArchive: Zip-Archiv der Abgabedatei(en) 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 + +SubmissionGroupName: Gruppenname CorrectionsTitle: Zugewiesene Korrekturen CourseCorrectionsTitle: Korrekturen für diesen Kurs @@ -269,6 +269,8 @@ IllDefinedUTCTime: Der angegebene Zeitpunkt lässt sich nicht zu UTC konvertiere LastEdits: Letzte Änderungen EditedBy name@Text time@Text: Durch #{name} um #{time} LastEdit: Letzte Änderung +LastEditByUser: Ihre letzte Bearbeitung +NoEditByUser: Nicht von Ihnen bearbeitet SubmissionFilesIgnored: Es wurden Dateien in der hochgeladenen Abgabe ignoriert: SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}. diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 3eb20376e..90d0274ca 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -38,7 +38,7 @@ import qualified Database.Esqueleto as E import qualified Data.UUID.Cryptographic as UUID - +-- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method. type CourseTableData = DBRow (Entity Course, Int64, Bool, Entity School) colCourse :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 987f472ce..dd0228899 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -24,7 +24,7 @@ import Utils.Lens -- import Yesod.Colonnade import Data.Monoid (Any(..)) import qualified Data.Map as Map -import qualified Data.Set as Set +-- import qualified Data.Set as Set import qualified Database.Esqueleto as E -- import Database.Esqueleto ((^.)) @@ -149,23 +149,6 @@ postProfileR = do -- TODO getProfileR ----------------------------------------- --- TODO: Are these really a good idea? --- If yes: Move to appropriate Place: Utils.Lens and Utils.Table.Cells --- --- Or Maybe make Course an instance of Data.Data and use biplate instead? --- λ> ("a",7,"b",["c","d"],(9,"e",8),"f",True) ^.. biplate :: [String] --- ["a","b","c","d","e","f"] --- it :: [String] --- *Main Control.Lens Data.Data.Lens --- λ> ("a",7,"b",["c","d"],(9,"e",8),"f",True) ^.. biplate :: [Int] --- [] --- it :: [Int] --- *Main Control.Lens Data.Data.Lens --- λ> ("a",7,"b",["c","d"],(9,"e",8),"f",True) ^.. biplate :: [Integer] --- [7,9,8] --- it :: [Integer] - getProfileDataR :: Handler Html @@ -174,166 +157,13 @@ getProfileDataR = do -- mr <- getMessageRender -- Tabelle mit eigenen Kursen - (Any hasRows, ownCourseTable) <- do - let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a) - -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a) - withType = id - - validator = def & defaultSorting [("term",SortDesc),("school",SortAsc),("course",SortAsc)] - - dbTableWidget validator $ DBTable - { dbtIdent = "courseOwnership" :: Text - , dbtStyle = def - , dbtSQLQuery = \(course `E.InnerJoin` lecturer) -> do - E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse - E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid - return ( course E.^. CourseTerm - , course E.^. CourseSchool - , course E.^. CourseShorthand - ) - , dbtProj = \x -> return $ x & _dbrOutput %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh)) - , dbtColonnade = mconcat - [ dbRow - , sortable (Just "term") (i18nCell MsgTerm & cellAttrs .~ [("priority","0")]) $ do - tid <- view (_dbrOutput . _1) - return $ indicatorCell `mappend` termCell tid - , sortable (Just "school") (i18nCell MsgCourseSchool) $ - schoolCell <$> view (_dbrOutput . _1 . re _Just) - <*> view (_dbrOutput . _2 ) - , sortable (Just "course") (i18nCell MsgCourse) $ - courseLinkCell <$> view (_dbrOutput) - ] - , dbtSorting = Map.fromList - [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseShorthand) -- consider PatternSynonyms. Drawback: not enclosed with table, since they must be at Top-Level. Maybe make Lenses for InnerJoins then? - , ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm ) - , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool ) - ] - , dbtFilter = Map.fromList - [ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand) - , ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm ) - , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool ) - ] - } - + (hasRows, ownedCoursesTable) <- mkOwnedCoursesTable uid -- Tabelle mit allen Teilnehmer: Kurs (link), Datum - courseTable <- do - let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a) - -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a) - withType = id - - validator = def - & defaultSorting [("time",SortDesc)] - - courseData = \(course `E.InnerJoin` participant) -> do - E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse - E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid - return (course, participant E.^. CourseParticipantRegistration) - dbTableWidget' validator $ DBTable - { dbtIdent = "courseMembership" :: Text - , dbtSQLQuery = courseData - , dbtProj = \x -> return $ x & _dbrOutput . _2 %~ E.unValue - , dbtColonnade = mconcat - [ dbRow - , sortable (Just "term") (i18nCell MsgTerm) $ - termCell <$> view (_dbrOutput . _1 . _entityVal . _courseTerm) - , sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 . _entityVal) $ - schoolCell <$> view ( _courseTerm . re _Just) - <*> view ( _courseSchool ) - , sortable (Just "course") (i18nCell MsgCourse) $ - courseCell <$> view (_dbrOutput . _1 . _entityVal) - , sortable (Just "time") (i18nCell MsgRegistered) $ do - regTime <- view $ _dbrOutput . _2 - return $ timeCell regTime - ] - , dbtSorting = Map.fromList - [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseName ) - , ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm ) - , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool) - , ( "time" , SortColumn $ \(_ `E.InnerJoin` participant) -> participant E.^. CourseParticipantRegistration) - ] - , dbtFilter = Map.fromList - [ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseName ) - , ( "term" , FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm ) - , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool) --- , ( "time" , FilterColumn $ \(_ `E.InnerJoin` part :: CourseTableData) -> emptyOrIn $ part E.^. CourseParticipantRegistration ) - ] - , dbtStyle = def - } - + enrolledCoursesTable <- mkEnrolledCoursesTable uid -- Tabelle mit allen Abgaben und Abgabe-Gruppen - submissionTable <- do - let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a) - -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a) - withType = id - - 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)] - - lastSubEdit submission = -- latest Edit-Time of this user for submission - E.sub_select . E.from $ \subEdit -> do - E.where_ $ subEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId - E.&&. subEdit E.^. SubmissionEditUser E.==. E.val uid - return . E.max_ $ subEdit E.^. SubmissionEditTime - - dbTableWidget' validator $ DBTable - { dbtIdent = "submissions" :: Text - , dbtStyle = def - , dbtSQLQuery = \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` subUser) -> do - E.on $ submission E.^. SubmissionId E.==. subUser E.^. SubmissionUserSubmission - E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet - E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse - E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid - let crse = ( course E.^. CourseTerm - , course E.^. CourseSchool - , course E.^. CourseShorthand - ) - let sht = ( sheet E.^. SheetName - ) - return (crse, sht, submission, lastSubEdit submission) - , dbtProj = \x -> return $ x - & _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh)) - & _dbrOutput . _2 %~ E.unValue - & _dbrOutput . _4 %~ 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 "sheet") (i18nCell MsgSheet) . magnify _dbrOutput $ - sheetCell <$> view _1 - <*> view _2 - , sortable (toNothing "submission") (i18nCell MsgSubmission) . magnify _dbrOutput $ - submissionCell <$> view _1 - <*> view _2 - <*> view (_3 . _entityKey) --- , sortable (Just "edit") (i18nCell MsgSubmissionEditUser) $ do --- regTime <- view $ _dbrOutput . _4 --- return $ maybe mempty timeCell regTime - , sortable (Just "edit") (i18nCell MsgSubmissionEditUser) $ - maybe mempty timeCell <$> view (_dbrOutput . _4) - ] - , dbtSorting = Map.fromList - [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseShorthand) - , ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseTerm ) - , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseSchool ) - , ( "sheet" , SortColumn $ withType $ \(_ `E.InnerJoin` sheet `E.InnerJoin` _ `E.InnerJoin` _) -> sheet E.^. SheetName ) - , ( "edit" , SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.InnerJoin` submission `E.InnerJoin` _) -> lastSubEdit submission ) - ] - , dbtFilter = Map.fromList - [ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand) - , ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm ) - , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool ) - ] - } - + submissionTable <- mkSubmissionTable uid -- Tabelle mit allen Abgabegruppen - --TODO + submissionGroupTable <- mkSubmissionGroupTable uid -- Tabelle mit allen Tutorials tutorialTable <- return [whamlet| TOOD: Tutorials anzeigen |] -- TODO -- Tabelle mit allen Korrektor-Aufgaben @@ -343,3 +173,246 @@ getProfileDataR = do defaultLayout $ do $(widgetFile "profileData") $(widgetFile "dsgvDisclaimer") + + + +mkOwnedCoursesTable :: UserId -> Handler (Bool, Widget) +-- Table listing all courses that the given user is a lecturer for +mkOwnedCoursesTable = + let dbtIdent = "courseOwnership" :: Text + dbtStyle = def + + withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a) + -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a) + withType = id + + dbtSQLQuery' uid = \(course `E.InnerJoin` lecturer) -> do + E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse + E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid + return ( course E.^. CourseTerm + , course E.^. CourseSchool + , course E.^. CourseShorthand + ) + dbtProj = \x -> return $ x & _dbrOutput %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh)) + + dbtColonnade = mconcat + [ dbRow + , sortable (Just "term") (i18nCell MsgTerm & cellAttrs .~ [("priority","0")]) $ do + tid <- view (_dbrOutput . _1) + return $ indicatorCell -- return True if one cell is produced here + `mappend` termCell tid + , sortable (Just "school") (i18nCell MsgCourseSchool) $ + schoolCell <$> view (_dbrOutput . _1 . re _Just) + <*> view (_dbrOutput . _2 ) + , sortable (Just "course") (i18nCell MsgCourse) $ + courseLinkCell <$> view (_dbrOutput) + ] + + validator = def & defaultSorting [("term",SortDesc),("school",SortAsc),("course",SortAsc)] + dbtSorting = Map.fromList + [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseShorthand) + , ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm ) + , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool ) + ] + dbtFilter = Map.fromList + [ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand) + , ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm ) + , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool ) + ] + in \uid -> let dbtSQLQuery = dbtSQLQuery' uid in (_1 %~ getAny) <$> (dbTableWidget validator DBTable{..}) + + + +mkEnrolledCoursesTable :: UserId -> Handler Widget +-- Table listing all courses that the given user is enrolled in +mkEnrolledCoursesTable = + let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a) + -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a) + withType = id + + validator = def & defaultSorting [("time",SortDesc)] + + in \uid -> dbTableWidget' validator + DBTable + { dbtIdent = "courseMembership" :: Text + , dbtSQLQuery = \(course `E.InnerJoin` participant) -> do + E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse + E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid + return (course, participant E.^. CourseParticipantRegistration) + , dbtProj = \x -> return $ x & _dbrOutput . _2 %~ E.unValue + , dbtColonnade = mconcat + [ dbRow + , sortable (Just "term") (i18nCell MsgTerm) $ + termCell <$> view (_dbrOutput . _1 . _entityVal . _courseTerm) + , sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 . _entityVal) $ + schoolCell <$> view ( _courseTerm . re _Just) + <*> view ( _courseSchool ) + , sortable (Just "course") (i18nCell MsgCourse) $ + courseCell <$> view (_dbrOutput . _1 . _entityVal) + , sortable (Just "time") (i18nCell MsgRegistered) $ do + regTime <- view $ _dbrOutput . _2 + return $ timeCell regTime + ] + , dbtSorting = Map.fromList + [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseName ) + , ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm ) + , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool) + , ( "time" , SortColumn $ \(_ `E.InnerJoin` participant) -> participant E.^. CourseParticipantRegistration) + ] + , dbtFilter = Map.fromList + [ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseName ) + , ( "term" , FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm ) + , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool) +-- , ( "time" , FilterColumn $ \(_ `E.InnerJoin` part :: CourseTableData) -> emptyOrIn $ part E.^. CourseParticipantRegistration ) + ] + , dbtStyle = def + } + + + +mkSubmissionTable :: UserId -> Handler Widget +-- Table listing all submissions for the given user +mkSubmissionTable = + let dbtIdent = "submissions" :: Text + dbtStyle = def + + withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a) + -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a) + withType = id + + dbtSQLQuery' uid = \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` subUser) -> do + E.on $ submission E.^. SubmissionId E.==. subUser E.^. SubmissionUserSubmission + E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet + E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse + E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid + let crse = ( course E.^. CourseTerm + , course E.^. CourseSchool + , course E.^. CourseShorthand + ) + let sht = ( sheet E.^. SheetName + ) + return (crse, sht, submission, lastSubEdit uid submission) + + lastSubEdit uid submission = -- latest Edit-Time of this user for submission + E.sub_select . E.from $ \subEdit -> do + E.where_ $ subEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId + E.&&. subEdit E.^. SubmissionEditUser E.==. E.val uid + return . E.max_ $ subEdit E.^. SubmissionEditTime + + dbtProj = \x -> return $ x + & _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh)) + & _dbrOutput . _2 %~ E.unValue + & _dbrOutput . _4 %~ 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 "sheet") (i18nCell MsgSheet) . magnify _dbrOutput $ + sheetCell <$> view _1 + <*> view _2 + , sortable (toNothingS "submission") (i18nCell MsgSubmission) . magnify _dbrOutput $ + submissionCell <$> view _1 + <*> view _2 + <*> view (_3 . _entityKey) +-- , sortable (Just "edit") (i18nCell MsgSubmissionEditUser) $ do +-- regTime <- view $ _dbrOutput . _4 +-- return $ maybe mempty timeCell regTime + , sortable (Just "edit") (i18nCell MsgLastEditByUser) $ + maybe mempty timeCell <$> view (_dbrOutput . _4) + ] + + 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' uid = Map.fromList + [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseShorthand) + , ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseTerm ) + , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseSchool ) + , ( "sheet" , SortColumn $ withType $ \(_ `E.InnerJoin` sheet `E.InnerJoin` _ `E.InnerJoin` _) -> sheet E.^. SheetName ) + , ( "edit" , SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.InnerJoin` submission `E.InnerJoin` _) -> lastSubEdit uid submission ) + ] + dbtFilter = Map.fromList + [ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand) + , ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm ) + , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool ) + ] + in \uid -> let dbtSQLQuery = dbtSQLQuery' uid + dbtSorting = dbtSorting' uid + in dbTableWidget' validator $ DBTable {..} + + +mkSubmissionGroupTable :: UserId -> Handler Widget +-- Table listing all submissions for the given user +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 + + 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 {..} +-- in do dbtSQLQuery <- dbtSQLQuery' +-- dbtSorting <- dbtSorting' +-- return $ dbTableWidget' validator $ DBTable {..} + + diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index e0cee175b..506932c46 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -57,9 +57,9 @@ import Colonnade hiding (bool, fromMaybe) import qualified Yesod.Colonnade as Yesod import qualified Text.Blaze.Html5.Attributes as HA - -numberOfSubmissionEditDates :: Int64 -numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production. +-- DEPRECATED: We always show all edits! +-- numberOfSubmissionEditDates :: Int64 +-- numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production. makeSubmissionForm :: Maybe SubmissionId -> Bool -> SheetGroup -> [UserEmail] -> Form (Maybe (Source Handler File), [UserEmail]) @@ -157,14 +157,14 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = 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 + -- 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 numberOfSubmissionEditDates + E.limit 1 return $ submissionEdit E.^. SubmissionEditTime lastEditsUser <- forM lastEditUserValues $ \(E.Value time) -> formatTime SelFormatDateTime time return (sheet,buddies,lastEdits,lastEditsUser) diff --git a/src/Utils.hs b/src/Utils.hs index d1beb0f31..950756cbd 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -234,6 +234,9 @@ toMaybe False = const Nothing toNothing :: a -> Maybe b toNothing = const Nothing +toNothingS :: String -> Maybe b +toNothingS = const Nothing + maybeAdd :: Num a => Maybe a -> Maybe a -> Maybe a -- treats Nothing as neutral/zero, unlike fmap maybeAdd (Just x) (Just y) = Just (x + y) maybeAdd Nothing y = y diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index 888453072..55f8d406c 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -9,16 +9,25 @@ import Import.NoFoundation import Control.Lens as Utils.Lens import Utils.Lens.TH -import qualified Database.Esqueleto as E (Value(..)) +import qualified Database.Esqueleto as E (Value(..),InnerJoin(..)) _unValue :: Lens' (E.Value a) a _unValue f (E.Value a) = E.Value <$> f a +_InnerJoinLeft :: Lens' (E.InnerJoin l r) l -- forall f. Functor f => (a -> f a) -> s -> f s +_InnerJoinLeft f (E.InnerJoin l r) = (`E.InnerJoin` r) <$> f l + +_InnerJoinRight :: Lens' (E.InnerJoin l r) r +_InnerJoinRight f (E.InnerJoin l r) = (l `E.InnerJoin`) <$> f r + + makeLenses_ ''Entity +makeLenses_ ''Course + makeLenses_ ''SheetCorrector -makeLenses_ ''Course +makeLenses_ ''SubmissionGroup -- makeClassy_ ''Load diff --git a/templates/profileData.hamlet b/templates/profileData.hamlet index 2b8f4246c..eabff2fac 100644 --- a/templates/profileData.hamlet +++ b/templates/profileData.hamlet @@ -12,18 +12,23 @@

Eigene Kurse
- ^{ownCourseTable} + ^{ownedCoursesTable}

Kursanmeldungen
- ^{courseTable} + ^{enrolledCoursesTable}

Übungsgruppen
^{tutorialTable} +
+

Abgabegruppen +
+ ^{submissionGroupTable} +

Abgaben
diff --git a/templates/submission.hamlet b/templates/submission.hamlet index 5c62e7f8a..2f70d98a0 100644 --- a/templates/submission.hamlet +++ b/templates/submission.hamlet @@ -3,22 +3,24 @@ $maybe cID <- mcid

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

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

_{MsgLastEdits}
    $forall (name,time) <- lastEdits
  • _{MsgEditedBy name time} - _{MsgSubmissionEditUser}: # + _{MsgLastEditByUser}: # $if null lastEditsUser - _{MsgSubmissionNoEditUser} + _{MsgNoEditByUser} $else $forall time <- lastEditsUser #{display time} - $maybe fileTable <- mFileTable -

    _{MsgSubmissionFiles} - ^{fileTable} $if maySubmit