From 3523549d0e5d07fad863a19488ec298d76800623 Mon Sep 17 00:00:00 2001 From: SJost Date: Tue, 11 Sep 2018 09:00:25 +0200 Subject: [PATCH] Sort submissions by time, show lecturers in course --- messages/uniworx/de.msg | 1 + src/Handler/Course.hs | 8 ++++++-- src/Handler/Profile.hs | 20 +++++++++++--------- templates/course.hamlet | 11 +++++++++++ 4 files changed, 29 insertions(+), 11 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index ab2333d6d..98b6e5592 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -250,6 +250,7 @@ NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter AdminFor: Administrator LecturerFor: Dozent +LecturersFor: Dozenten UserListTitle: Komprehensive Benutzerliste DateTimeFormat: Datums- und Uhrzeitformat diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 112f87361..e63a8f012 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -263,7 +263,7 @@ getTermCourseListR tid = do getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCShowR tid ssh csh = do mbAid <- maybeAuthId - (courseEnt,(schoolMB,participants,registered)) <- runDB $ do + (courseEnt,(schoolMB,participants,registered),lecturers) <- runDB $ do courseEnt@(Entity cid course) <- getBy404 $ TermSchoolCourseShort tid ssh csh dependent <- (,,) <$> get (courseSchool course) -- join -- just fetch full school name here @@ -273,7 +273,11 @@ getCShowR tid ssh csh = do (Just aid) -> do regL <- getBy (UniqueParticipant aid cid) return $ isJust regL) - return $ (courseEnt,dependent) + 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 + return $ user E.^. UserDisplayName + return $ (courseEnt,dependent,E.unValue <$> lecturers) let course = entityVal courseEnt (regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 4312f138c..b54490242 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -2,6 +2,7 @@ {-# LANGUAGE MultiWayIf, LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE QuasiQuotes #-} @@ -212,11 +213,11 @@ getProfileDataR = do ) , dbtColonnade = mconcat [ colsCourseLink' $ _dbrOutput --- [ colsCourseLink $ (over each _unValue) . _dbrOutput -- different types in Tupel prevents "over each" +-- [ colsCourseLink $ (over each _unValue) . _dbrOutput -- different types in Tuple prevents "over each" ] , dbtProj = return , dbtSorting = Map.fromList - [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseShorthand) + [ ( "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 ) ] @@ -284,6 +285,11 @@ getProfileDataR = do let 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") + 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 @@ -292,10 +298,6 @@ getProfileDataR = do 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 subEdit = 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 let crse = ( course E.^. CourseTerm , course E.^. CourseSchool , course E.^. CourseId @@ -303,7 +305,7 @@ getProfileDataR = do ) let sht = ( sheet E.^. SheetName ) - return (crse, sht, submission, subEdit) + return (crse, sht, submission, lastSubEdit submission) , dbtColonnade = mconcat [ colsCourseLink' $ _dbrOutput . _1 , sortable (Just "sheet") (i18nCell MsgSheet) $ do @@ -327,7 +329,7 @@ getProfileDataR = do cid <- mkCid return $ CSubmissionR tid ssh csh shn cid SubShowR return $ anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|]) - , sortable (const Nothing $ Just "edit") (i18nCell MsgSubmissionEditUser) $ do + , sortable (Just "edit") (i18nCell MsgSubmissionEditUser) $ do regTime <- view $ _dbrOutput . _4 . _unValue return $ maybe mempty timeCell regTime ] @@ -336,8 +338,8 @@ getProfileDataR = do [ ( "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 ) --- , ( "time" , error "Time Sorting not yet supported") -- TODO , ( "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) diff --git a/templates/course.hamlet b/templates/course.hamlet index f63629fee..76bd9ba2a 100644 --- a/templates/course.hamlet +++ b/templates/course.hamlet @@ -5,11 +5,22 @@
#{schoolName school} + $maybe descr <- courseDescription course
_{MsgCourseDescription}
#{descr} + + $with numlecs <- length lecturers + $if numlecs > 1 +
_{MsgLecturersFor} + $else +
_{MsgLecturerFor} +
+
+ #{T.intercalate ", " lecturers} + $maybe link <- courseLinkExternal course
Website