Merge branch 'master' into 'live'

Kurslisten live schalten

See merge request !64

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

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}.
+SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}.

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)

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|<a href=@{CourseR tid csh CShowR}>#{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 $
+        $ \DBRow{ dbrOutput=(_, sheet, course, _, _) } ->
-          let tid = course ^. _3
+          let tid   = course ^. _3
-              csh = course ^. _2
+              csh   = course ^. _2
-              shn = sheetName $ entityVal sheet
+              shn   = sheetName $ entityVal sheet
-          in [whamlet|<a href=@{CSheetR tid csh shn SShowR}>#{display shn}|]
+          in anchorCell (CSheetR tid csh shn SShowR) [whamlet|#{display shn}|]
-          -- textCell $ sheetName $ entityVal sheet
 
 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)
+              mkCid = encrypt (entityKey submission :: SubmissionId) -- TODO: executed twice
-          [whamlet|<a href=@{CSubmissionR tid csh shn cid SubShowR}>#{display cid}|]
+              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

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
+type CourseTableData = DBRow (Entity Course, Int64, Bool)
-getCourseListR = redirect TermCurrentR
+
+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
-
+  muid <- maybeAuthId
-  let
+  let colonnade = widgetColonnade $ mconcat
-    tableData :: E.SqlExpr (Entity Course) -> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (E.Value Int64))
+        [ dbRow
-    tableData course = do
+        , colCShort
-      E.where_ $ course E.^. CourseTerm E.==. E.val tid
+        , colRegFrom
-      let
+        , colRegTo
-        participants = E.sub_select . E.from $ \courseParticipant -> do
+        , colParticipants
-          E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
+        , maybe mempty (const colRegistered) muid
-          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
         ]
-    , dbtProj = return . dbrOutput
+      whereClause = \(course, _, _) -> course E.^. CourseTerm E.==. E.val tid
-    , dbtSorting = Map.fromList
+      validator = def
-        [ ( "shorthand"
+        & defaultSorting [("cshort", SortAsc)]
-          , SortColumn $ \course -> course E.^. CourseShorthand
+  coursesTable <- makeCourseTable whereClause colonnade validator
-          )
-        , ( "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
-    }
-  
   defaultLayout $ do
     setTitleI . MsgTermCourseListTitle $ tid
     $(widgetFile "courses")

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 :: 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 = do
+    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
+          $ \(_, E.Value mEditTime, _) -> case mEditTime of
-          Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget
+            Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget
-          Nothing -> mempty
+            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

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
 

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}