diff --git a/ChangeLog.md b/ChangeLog.md index fbe1b5009..240b51546 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,4 +1,11 @@ + * Version 31.07.2018 + + Viele Verbesserung zur Anzeige von Korrekturen + + Kursliste über alle Semester hinweg (Top-Level-Navigation "Kurse"), wird in Zukunft Filter/Suchfunktion erhalten + * Version 10.07.2018 + Bugfixes, wählbares Format für Datum * Version 04.07.2018 diff --git a/messages/de.msg b/messages/de.msg index 8b271d82e..ae6d17cb8 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -5,6 +5,7 @@ BtnRegister: Anmelden BtnDeregister: Abmelden BtnHijack: Sitzung übernehmen +Registered: Angemeldet RegisterFrom: Anmeldungen von RegisterTo: Anmeldungen bis DeRegUntil: Abmeldungen bis @@ -29,6 +30,7 @@ TermPlaceholder: W/S + vierstellige Jahreszahl LectureStart: Beginn Vorlesungen Course: Kurs +CourseShort: Kürzel CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei. CourseRegisterOk: Sie wurden angemeldet CourseDeregisterOk: Sie wurden abgemeldet @@ -40,6 +42,7 @@ CourseNewDupShort tid@TermId courseShortHand@CourseShorthand: Kurs #{display ti CourseEditDupShort tid@TermId courseShortHand@CourseShorthand: Kurs #{display tid}-#{courseShortHand} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester. FFSheetName: Name TermCourseListHeading tid@TermId: Kursübersicht #{display tid} +CourseListTitle: Alle Kurse TermCourseListTitle tid@TermId: Kurse #{display tid} CourseNewHeading: Neuen Kurs anlegen CourseEditHeading tid@TermId courseShortHand@CourseShorthand: Kurs #{display tid}-#{courseShortHand} editieren @@ -190,6 +193,7 @@ NotPassed: Nicht bestanden RatingTime: Korrigiert RatingComment: Kommentar SubmissionUsers: Studenten +Rating: Korrektur RatingPoints: Punkte RatingFiles: Korrigierte Dateien @@ -227,4 +231,4 @@ EditedBy name@Text time@Text: Durch #{name} um #{time} LastEdit: Letzte Änderung SubmissionFilesIgnored: Es wurden Dateien in der hochgeladenen Abgabe ignoriert: -SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}. \ No newline at end of file +SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}. diff --git a/src/Foundation.hs b/src/Foundation.hs index b8f8fe169..131ed25bd 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -668,7 +668,7 @@ instance YesodBreadcrumbs UniWorX where breadcrumb (TermEditExistR tid) = return ("Editieren" , Just $ TermCourseListR tid) breadcrumb (TermCourseListR (unTermKey -> tid)) = getMessageRender <&> \mr -> (mr $ ShortTermIdentifier tid, Just TermShowR) - breadcrumb CourseListR = return ("Kurs" , Just HomeR) + breadcrumb CourseListR = return ("Kurse" , Just HomeR) breadcrumb CourseNewR = return ("Neu" , Just CourseListR) breadcrumb (CourseR tid csh CShowR) = return (CI.original csh, Just $ TermCourseListR tid) -- (CourseR tid csh CRegisterR) -- is POST only @@ -744,7 +744,7 @@ defaultLinks = -- Define the menu items of the header. , NavbarAside $ MenuItem { menuItemLabel = "Kurse" , menuItemIcon = Just "calendar-alt" - , menuItemRoute = TermCurrentR -- should be CourseListActiveR or similar in the future + , menuItemRoute = CourseListR , menuItemAccessCallback' = return True } , NavbarAside $ MenuItem @@ -964,7 +964,8 @@ pageHeading (TermEditExistR tid) pageHeading (TermCourseListR tid) = Just . i18nHeading . MsgTermCourseListHeading $ tid --- CourseListR -- just a redirect to TermCurrentR +pageHeading (CourseListR) + = Just $ i18nHeading $ MsgCourseListTitle pageHeading CourseNewR = Just $ i18nHeading MsgCourseNewHeading pageHeading (CourseR tid csh CShowR) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 3d2a61116..c2792c48d 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -85,19 +85,18 @@ colTerm = sortable (Just "term") (i18nCell MsgTerm) colCourse :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colCourse = sortable (Just "course") (i18nCell MsgCourse) - $ \DBRow{ dbrOutput=(_, _, course, _, _) } -> cell $ + $ \DBRow{ dbrOutput=(_, _, course, _, _) } -> let tid = course ^. _3 csh = course ^. _2 - in [whamlet|#{display csh}|] + in anchorCell (CourseR tid csh CShowR) [whamlet|#{display csh}|] colSheet :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colSheet = sortable (Just "sheet") (i18nCell MsgSheet) - $ \DBRow{ dbrOutput=(_, sheet, course, _, _) } -> cell $ - let tid = course ^. _3 - csh = course ^. _2 - shn = sheetName $ entityVal sheet - in [whamlet|#{display shn}|] - -- textCell $ sheetName $ entityVal sheet + $ \DBRow{ dbrOutput=(_, sheet, course, _, _) } -> + let tid = course ^. _3 + csh = course ^. _2 + shn = sheetName $ entityVal sheet + in anchorCell (CSheetR tid csh shn SShowR) [whamlet|#{display shn}|] colCorrector :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case @@ -106,12 +105,15 @@ colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case colSubmissionLink :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colSubmissionLink = sortable Nothing (i18nCell MsgSubmission) - $ \DBRow{ dbrOutput=(submission, sheet, course, _, _) } -> cell $ do + $ \DBRow{ dbrOutput=(submission, sheet, course, _, _) } -> let tid = course ^. _3 csh = course ^. _2 shn = sheetName $ entityVal sheet - cid <- encrypt (entityKey submission :: SubmissionId) - [whamlet|#{display cid}|] + mkCid = encrypt (entityKey submission :: SubmissionId) -- TODO: executed twice + mkRoute = do + cid <- mkCid + return $ CSubmissionR tid csh shn cid SubShowR + in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|]) colSelect :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData CryptoFileNameSubmission Bool))) colSelect = dbSelect id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId @@ -121,6 +123,15 @@ colSubmittors = sortable Nothing (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutp cell = listCell (Map.toList users) $ \(userId, User{..}) -> anchorCellM (AdminUserR <$> encrypt userId) (toWidget userDisplayName) in cell & cellAttrs <>~ [("class", "list--inline list--comma-separated")] +colRating :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) +colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId Submission{..}, Entity _ Sheet{..}, course, _, _) } -> + let tid = course ^. _3 + csh = course ^. _2 + -- shn = sheetName + mkRoute = do + cid <- encrypt subId + return $ CSubmissionR tid csh sheetName cid CorrectionR + in anchorCellM mkRoute $(widgetFile "widgets/rating") 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)) @@ -165,6 +176,9 @@ makeCorrectionsTable whereClause colChoices psValidator = do , ( "corrector" , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector) -> corrector E.?. UserDisplayName ) + , ( "rating" + , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingPoints + ) ] , dbtFilter = [ ( "term" , FilterColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) tids -> if @@ -317,6 +331,7 @@ postCorrectionsR = do , colCourse , colSheet , colSubmissionLink + , colRating ] -- Continue here psValidator = def & restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information @@ -337,6 +352,7 @@ postCCorrectionsR tid csh = do , colCorrector , colSubmittors , colSubmissionLink + , colRating ] -- Continue here psValidator = def correctionsR whereClause colonnade psValidator $ Map.fromList @@ -355,6 +371,7 @@ postSSubsR tid csh shn = do , colCorrector , colSubmittors , colSubmissionLink + , colRating ] psValidator = def correctionsR whereClause colonnade psValidator $ Map.fromList diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 38cfbe239..080e444ec 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -1,7 +1,11 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -18,6 +22,7 @@ import qualified Data.Text as T import Data.Function ((&)) -- import Yesod.Form.Bootstrap3 +import qualified Data.Set as Set import qualified Data.Map as Map import Colonnade hiding (fromMaybe,bool) @@ -28,8 +33,117 @@ import qualified Database.Esqueleto as E import qualified Data.UUID.Cryptographic as UUID -getCourseListR :: Handler TypedContent -getCourseListR = redirect TermCurrentR +type CourseTableData = DBRow (Entity Course, Int64, Bool) + +colCourse :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) +colCourse = sortable (Just "course") (i18nCell MsgCourse) + $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } -> + anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseName}|] + +colCShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) +colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort) + $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } -> + anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseShorthand}|] + +colTerm :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) +colTerm = sortable (Just "term") (i18nCell MsgTerm) + $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } -> + anchorCell (TermCourseListR courseTerm) [whamlet|#{display courseTerm}|] + +colRegFrom :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) +colRegFrom = sortable (Just "register-from") (i18nCell MsgRegisterFrom) + $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } -> + cell $ traverse (formatTime SelFormatDateTime) courseRegisterFrom >>= maybe mempty toWidget + +colRegTo :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) +colRegTo = sortable (Just "register-to") (i18nCell MsgRegisterTo) + $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } -> + cell $ traverse (formatTime SelFormatDateTime) courseRegisterTo >>= maybe mempty toWidget + +colParticipants :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) +colParticipants = sortable (Just "participants") (i18nCell MsgCourseMembers) + $ \DBRow{ dbrOutput=(Entity cid Course{..}, currentParticipants, _) } -> textCell $ case courseCapacity of + Nothing -> MsgCourseMembersCount currentParticipants + Just max -> MsgCourseMembersCountLimited currentParticipants max + +colRegistered :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) +colRegistered = sortable (Just "registered") (i18nCell MsgRegistered) + $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, registered) } -> tickmarkCell registered + +type CourseTableExpr = E.SqlExpr (Entity Course) + +course2Participants :: CourseTableExpr -> E.SqlExpr (E.Value Int64) +course2Participants course = E.sub_select . E.from $ \courseParticipant -> do + E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId + return (E.countRows :: E.SqlExpr (E.Value Int64)) + +course2Registered :: Maybe UserId -> CourseTableExpr -> E.SqlExpr (E.Value Bool) +course2Registered muid course = E.exists . E.from $ \courseParticipant -> do + E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId + E.&&. E.just (courseParticipant E.^. CourseParticipantUser) E.==. E.val muid + +makeCourseTable :: ( IsDBTable m x, ToSortable h, Functor h ) + => _ -> Colonnade h CourseTableData (DBCell m x) -> PSValidator m x -> Handler (DBResult m x) +makeCourseTable whereClause colChoices psValidator = do + muid <- maybeAuthId + let dbtSQLQuery :: CourseTableExpr -> E.SqlQuery _ + dbtSQLQuery course = do + let participants = course2Participants course + let registered = course2Registered muid course + E.where_ $ whereClause (course, participants, registered) + return (course, participants, registered) + dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData + dbtProj = traverse $ \(course, E.Value participants, E.Value registered) -> return (course, participants, registered) + dbTable psValidator $ DBTable + { dbtSQLQuery + , dbtColonnade = colChoices + , dbtProj + , dbtSorting = Map.fromList -- OverloadedLists does not work with the templates here + [ ( "course", SortColumn $ \course -> course E.^. CourseName) + , ( "cshort", SortColumn $ \course -> course E.^. CourseShorthand) + , ( "term" , SortColumn $ \course -> course E.^. CourseTerm) + , ( "register-from", SortColumn $ \course -> course E.^. CourseRegisterFrom) + , ( "register-to", SortColumn $ \course -> course E.^. CourseRegisterTo) + , ( "participants", SortColumn $ course2Participants + ) + , ( "registered", SortColumn $ course2Registered muid + ) + ] + , dbtFilter = Map.fromList -- OverloadedLists does not work with the templates here + [ ( "course", FilterColumn $ \(course :: CourseTableExpr) criterias -> if + | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool) + | otherwise -> course E.^. CourseName `E.in_` E.valList (Set.toList criterias) + ) + , ( "cshort", FilterColumn $ \(course :: CourseTableExpr) criterias -> if + | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool) + | otherwise -> course E.^. CourseShorthand `E.in_` E.valList (Set.toList criterias) + ) + , ( "term" , FilterColumn $ \(course :: CourseTableExpr) criterias -> if + | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool) + | otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList criterias) + ) + ] + , dbtStyle = def + , dbtIdent = "courses" :: Text + } + +getCourseListR :: Handler Html +getCourseListR = do -- TODO: Suchfunktion für Kurse und Kürzel!!! + muid <- maybeAuthId + let colonnade = widgetColonnade $ mconcat + [ colCourse + , colCShort + , colTerm + , maybe mempty (const colRegistered) muid + ] + whereClause = const $ E.val True + validator = def + & defaultSorting [("course", SortAsc), ("term", SortDesc)] + coursesTable <- makeCourseTable whereClause colonnade validator + defaultLayout $ do + setTitleI MsgCourseListTitle + [whamlet|TODO: Such-/Filterfunktion hier einbauen|] -- TODO + $(widgetFile "courses") getTermCurrentR :: Handler Html getTermCurrentR = do @@ -37,59 +151,24 @@ getTermCurrentR = do case fromNullable termIds of Nothing -> notFound (Just (maximum -> tid)) -> -- getTermCourseListR tid - redirect $ TermCourseListR tid -- redirect avids problematic breadcrumbs, headings, etc. - + redirect $ TermCourseListR tid -- redirect avoids problematic breadcrumbs, headings, etc. getTermCourseListR :: TermId -> Handler Html getTermCourseListR tid = do void . runDB $ get404 tid -- Just ensure the term exists - - let - tableData :: E.SqlExpr (Entity Course) -> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (E.Value Int64)) - tableData course = do - E.where_ $ course E.^. CourseTerm E.==. E.val tid - let - participants = E.sub_select . E.from $ \courseParticipant -> do - E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId - return (E.countRows :: E.SqlExpr (E.Value Int64)) - return (course, participants) - psValidator = def - & defaultSorting [("shorthand", SortAsc)] - - coursesTable <- dbTable psValidator $ DBTable - { dbtSQLQuery = tableData - , dbtColonnade = widgetColonnade $ mconcat - [ sortable (Just "shorthand") (textCell MsgCourse) $ anchorCell' - (\(Entity _ Course{..}, _) -> CourseR courseTerm courseShorthand CShowR) - (\(Entity _ Course{..}, _) -> toWidget courseShorthand) - , sortable (Just "register-from") (textCell MsgRegisterFrom) $ \(Entity _ Course{..}, _) -> cell $ traverse (formatTime SelFormatDateTime) courseRegisterFrom >>= maybe mempty toWidget - , sortable (Just "register-to") (textCell MsgRegisterTo) $ \(Entity _ Course{..}, _) -> cell $ traverse (formatTime SelFormatDateTime) courseRegisterTo >>= maybe mempty toWidget - , sortable (Just "members") (textCell MsgCourseMembers) $ \(Entity _ Course{..}, E.Value num) -> textCell $ case courseCapacity of - Nothing -> MsgCourseMembersCount num - Just max -> MsgCourseMembersCountLimited num max + muid <- maybeAuthId + let colonnade = widgetColonnade $ mconcat + [ dbRow + , colCShort + , colRegFrom + , colRegTo + , colParticipants + , maybe mempty (const colRegistered) muid ] - , dbtProj = return . dbrOutput - , dbtSorting = Map.fromList - [ ( "shorthand" - , SortColumn $ \course -> course E.^. CourseShorthand - ) - , ( "register-from" - , SortColumn $ \course -> course E.^. CourseRegisterFrom - ) - , ( "register-to" - , SortColumn $ \course -> course E.^. CourseRegisterTo - ) - , ( "members" - , SortColumn $ \course -> E.sub_select . E.from $ \courseParticipant -> do - E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId - return (E.countRows :: E.SqlExpr (E.Value Int64)) - ) - ] - , dbtFilter = mempty - , dbtStyle = def - , dbtIdent = "courses" :: Text - } - + whereClause = \(course, _, _) -> course E.^. CourseTerm E.==. E.val tid + validator = def + & defaultSorting [("cshort", SortAsc)] + coursesTable <- makeCourseTable whereClause colonnade validator defaultLayout $ do setTitleI . MsgTermCourseListTitle $ tid $(widgetFile "courses") diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 64cc2a6b2..8319760f2 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -156,49 +156,74 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do getSheetListR :: TermId -> CourseShorthand -> Handler Html getSheetListR tid csh = do + muid <- maybeAuthId Entity cid _ <- runDB . getBy404 $ CourseTermShort tid csh let - sheetData :: E.SqlExpr (E.Entity Sheet) -> E.SqlQuery (E.SqlExpr (Entity Sheet), E.SqlExpr (E.Value (Maybe UTCTime))) - sheetData sheet = do + sheetData :: E.SqlExpr (Entity Sheet) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity Submission)) `E.InnerJoin` (E.SqlExpr (Maybe (Entity SubmissionUser)))) -> E.SqlQuery (E.SqlExpr (Entity Sheet), E.SqlExpr (E.Value (Maybe UTCTime)),E.SqlExpr (Maybe (Entity Submission))) + sheetData (sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) = do + E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission + E.on $ (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet + E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid let sheetEdit = E.sub_select . E.from $ \sheetEdit -> do E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId return . E.max_ $ sheetEdit E.^. SheetEditTime E.where_ $ sheet E.^. SheetCourse E.==. E.val cid - return (sheet, sheetEdit) + return (sheet, sheetEdit, submission) sheetCol = widgetColonnade . mconcat $ [ sortable (Just "name") (i18nCell MsgSheet) - $ \(Entity _ Sheet{..}, _) -> anchorCell (CSheetR tid csh sheetName SShowR) (toWidget sheetName) + $ \(Entity _ Sheet{..}, _, _) -> anchorCell (CSheetR tid csh sheetName SShowR) (toWidget sheetName) , sortable (Just "last-edit") (i18nCell MsgLastEdit) - $ \(_, E.Value mEditTime) -> case mEditTime of - Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget - Nothing -> mempty + $ \(_, E.Value mEditTime, _) -> case mEditTime of + Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget + Nothing -> mempty , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom) - $ \(Entity _ Sheet{..}, _) -> cell $ formatTime SelFormatDateTime sheetActiveFrom >>= toWidget + $ \(Entity _ Sheet{..}, _, _) -> cell $ formatTime SelFormatDateTime sheetActiveFrom >>= toWidget , sortable (Just "submission-until") (i18nCell MsgSheetActiveTo) - $ \(Entity _ Sheet{..}, _) -> cell $ formatTime SelFormatDateTime sheetActiveTo >>= toWidget + $ \(Entity _ Sheet{..}, _, _) -> cell $ formatTime SelFormatDateTime sheetActiveTo >>= toWidget , sortable Nothing (i18nCell MsgSheetType) - $ \(Entity _ Sheet{..}, _) -> textCell $ display sheetType + $ \(Entity _ Sheet{..}, _, _) -> textCell $ display sheetType + , sortable Nothing (i18nCell MsgSubmission) + $ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of + Nothing -> mempty + (Just (Entity sid Submission{..})) -> + let mkCid = encrypt sid -- TODO: executed twice + mkRoute = do + cid <- mkCid + return $ CSubmissionR tid csh sheetName cid SubShowR + in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|]) + , sortable (Just "rating") (i18nCell MsgRating) + $ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of + Nothing -> mempty + (Just (Entity sid Submission{..})) -> + let mkCid = encrypt sid + mkRoute = do + cid <- mkCid + return $ CSubmissionR tid csh sheetName cid CorrectionR + in anchorCellM mkRoute $(widgetFile "widgets/rating") ] psValidator = def & defaultSorting [("submission-since", SortAsc)] table <- dbTable psValidator $ DBTable { dbtSQLQuery = sheetData , dbtColonnade = sheetCol - , dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _) } + , dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _, _) } -> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid csh sheetName SShowR) False) , dbtSorting = Map.fromList [ ( "name" - , SortColumn $ \sheet -> sheet E.^. SheetName + , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName ) , ( "last-edit" - , SortColumn $ \sheet -> E.sub_select . E.from $ \sheetEdit -> E.distinctOnOrderBy [E.desc $ sheetEdit E.?. SheetEditTime] $ do + , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> E.sub_select . E.from $ \sheetEdit -> E.distinctOnOrderBy [E.desc $ sheetEdit E.?. SheetEditTime] $ do return $ sheetEdit E.?. SheetEditTime ) , ( "submission-since" - , SortColumn $ \sheet -> sheet E.^. SheetActiveFrom + , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveFrom ) , ( "submission-until" - , SortColumn $ \sheet -> sheet E.^. SheetActiveTo + , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveTo + ) + , ( "rating" + , SortColumn $ \(_ `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) -> submission E.?. SubmissionRatingPoints ) ] , dbtFilter = Map.fromList diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index a7bda4a73..cc2b06fe6 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -34,6 +34,7 @@ module Handler.Utils.Table.Pagination , widgetColonnade, formColonnade, dbColonnade , cell, textCell, stringCell, i18nCell , anchorCell, anchorCell', anchorCellM + , tickmarkCell , listCell , formCell, DBFormResult, getDBFormResult , dbRow, dbSelect @@ -472,6 +473,11 @@ stringCell = textCell i18nCell = textCell textCell msg = cell [whamlet|_{msg}|] +tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a +tickmarkCell True = textCell (tickmark :: Text) +tickmarkCell False = mempty + + anchorCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a anchorCell = anchorCellM . return diff --git a/templates/widgets/rating.hamlet b/templates/widgets/rating.hamlet new file mode 100644 index 000000000..f1c321bfd --- /dev/null +++ b/templates/widgets/rating.hamlet @@ -0,0 +1,16 @@ +$# Display Rating, expects +$# submissionRatingPoints :: Maybe points + +$maybe points <- submissionRatingPoints + $case sheetType + $of Bonus{..} + _{MsgAchievedOf points maxPoints} + $of Normal{..} + _{MsgAchievedOf points maxPoints} + $of Pass{..} + $if points >= passingPoints + _{MsgPassed} + $else + _{MsgNotPassed} + $of NotGraded + #{show tickmark}