correctionsTable generalized for various purposes, but needs bigger query

messages/de.msg

@@ -59,6 +59,8 @@ SubmissionFile: Datei zur Abgabe
 SubmissionAlreadyExistsFor user@Text: #{user} hat bereits eine Abgabe zu diesem bÜbungsblatt.
 
 CorrectionsTitle: Zugewiesene Korrekturen
+CourseCorrectionsTitle: Korrekturen für diesen Kurs
+Corrector: Korrektor
 
 EMail: E-Mail
 EMailUnknown email@Text: E-Mail #{email} gehört zu keinem bekannten Benutzer.

routes

@@ -46,6 +46,7 @@
 /course/#TermId/#Text       CourseR                           !lecturer:
   /show                       CShowR          GET POST        !free
   /edit                       CEditR          GET POST
+  /corrections                CourseCorrectionsR   GET
   /ex                         SheetListR      GET             !registered !materials
   !/ex/new                    SheetNewR       GET POST
   /ex/#Text SheetR:
@@ -69,4 +70,4 @@
 -- TODO above
 
 !/#UUID CryptoUUIDDispatchR GET                               !free -- just redirect
-!/*{CI FilePath} CryptoFileNameDispatchR GET                  !free
+!/*{CI FilePath} CryptoFileNameDispatchR GET                  !free

src/Handler/Corrections.hs

@@ -8,6 +8,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TypeOperators #-}
@@ -42,17 +43,52 @@ import Control.Lens
 -- import Network.Mime
 
 
-ratedBy :: E.Esqueleto query expr backend =>
-            expr (Entity Submission) -> Key User -> expr (E.Value Bool)
-ratedBy submission uid = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
 
-courseIs :: E.Esqueleto query expr backend =>
+type CorrectionsWhere = forall query expr backend . (E.Esqueleto query expr backend) =>
-            expr (Entity Course) -> Key Course -> expr (E.Value Bool)
+            (expr (Entity Course), expr (Entity Sheet), expr (Entity Submission))
-courseIs course cid = course E.^. CourseId E.==. E.val cid
+            -> expr (E.Value Bool)
 
-getCorrectionsR :: Handler Html
+ratedBy :: Key User -> CorrectionsWhere
-getCorrectionsR = do
+ratedBy uid (_course,_sheet,submission) = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
-  uid <- requireAuthId
+
+courseIs :: Key Course -> CorrectionsWhere
+courseIs cid (course,_sheet,_submission) = course E.^. CourseId E.==. E.val cid
+
+
+type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (E.Value Text, E.Value Text, E.Value (Key Term), E.Value (Key School)))
+
+colTerm :: Colonnade Sortable CorrectionTableData (Cell UniWorX)
+colTerm = sortable (Just "term") (i18nCell MsgTerm)
+        $ \DBRow{ dbrOutput=(_, _, course) } ->
+          -- cell [whamlet| _{untermKey $ course ^. _3}|]   -- lange, internationale Semester
+          textCell $ termToText $ unTermKey $ E.unValue $ course ^. _3 -- kurze Semsterkürzel
+
+colCourse :: Colonnade Sortable CorrectionTableData (Cell UniWorX)
+colCourse = sortable (Just "course") (i18nCell MsgCourse)
+        $ \DBRow{ dbrOutput=(_, _, course) } ->
+          textCell $ E.unValue $ course ^. _2
+
+colSheet :: Colonnade Sortable CorrectionTableData (Cell UniWorX)
+colSheet = sortable (Just "sheet") (i18nCell MsgSheet)
+        $ \DBRow{ dbrOutput=(_, sheet, _) } ->
+          textCell $ sheetName $ entityVal sheet
+
+colCorrector :: Colonnade Sortable CorrectionTableData (Cell UniWorX)
+colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector)
+        $ \DBRow{ dbrOutput=(submission, _, _) } ->
+          textCell $ display $ submissionRatingBy $ entityVal submission
+
+colSubmissionLink :: Colonnade Sortable CorrectionTableData (Cell UniWorX)
+colSubmissionLink = sortable Nothing (i18nCell MsgSubmission)
+        $ \DBRow{ dbrOutput=(submission, sheet, course) } -> cell $ do
+          let tid = E.unValue $ course ^. _3
+              csh = E.unValue $ course ^. _2
+              shn = sheetName $ entityVal sheet
+          cid <- encrypt (entityKey submission :: SubmissionId)
+          [whamlet|<a href=@{CSheetR tid csh shn (SubmissionR cid)}>#{display cid}|]
+
+makeCorrectionsTable :: _ -> Colonnade Sortable CorrectionTableData (Cell UniWorX) -> _
+makeCorrectionsTable whereClause colChoices = do
   let tableData :: E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity Course))
                                             (E.SqlExpr (Entity Sheet )))
                                (E.SqlExpr (Entity Submission))
@@ -60,39 +96,16 @@ getCorrectionsR = do
       tableData (course `E.InnerJoin` sheet `E.InnerJoin` submission) = do
         E.on $ sheet  E.^. SheetId  E.==. submission E.^. SubmissionSheet
         E.on $ course E.^. CourseId E.==. sheet      E.^. SheetCourse
-        E.where_ $ submission `ratedBy` uid
+        E.where_ $ whereClause (course,sheet,submission)
         let crse =  ( course E.^. CourseName      :: E.SqlExpr (E.Value Text)
                     , course E.^. CourseShorthand
                     , course E.^. CourseTerm
                     , course E.^. CourseSchool    :: E.SqlExpr (E.Value SchoolId)
                     )
         return (submission, sheet, crse)
-      colonnade :: Colonnade Sortable (DBRow
+  dbTable def $ DBTable
-                      (Entity Submission, Entity Sheet,
-                        (E.Value Text, E.Value Text, E.Value (Key Term), E.Value (Key School)))
-
-                      ) (Cell UniWorX)
-      colonnade = mconcat
-        [ dbRow
-        , sortable (Just "term") (i18nCell MsgTerm) $ \DBRow{ dbrOutput=(_, _, course) } ->
-            -- cell [whamlet| _{untermKey $ course ^. _3}|]   -- lange, internationale Semester
-            textCell $ termToText $ unTermKey $ E.unValue $ course ^. _3 -- kurze Semsterkürzel
-        , sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(_, _, course) } ->
-            textCell $ E.unValue $ course ^. _2
-        , sortable (Just "sheet") (i18nCell MsgSheet) $ \DBRow{ dbrOutput=(_, sheet, _) } ->
-            textCell $ sheetName $ entityVal sheet
-        , sortable Nothing (i18nCell MsgSubmission) $ \DBRow{ dbrOutput=(submission, sheet, course) } ->
-            cell $ do
-              let tid = E.unValue $ course ^. _3
-                  csh = E.unValue $ course ^. _2
-                  shn = sheetName $ entityVal sheet
-              cid <- encrypt (entityKey submission :: SubmissionId)
-              [whamlet|<a href=@{CSheetR tid csh shn (SubmissionR cid)}>#{display cid}|]
-        ]
-        -- TODO continue here
-  table <- dbTable def $ DBTable
     { dbtSQLQuery  = tableData
-    , dbtColonnade = colonnade
+    , dbtColonnade = colChoices
     , dbtSorting   =  [ ( "term"
                         , SortColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) -> course E.^. CourseTerm
                         )
@@ -110,6 +123,35 @@ getCorrectionsR = do
     , dbtAttrs     = tableDefault
     , dbtIdent     = "corrections" :: Text
     }
+
+
+getCorrectionsR :: Handler Html
+getCorrectionsR = do
+  uid <- requireAuthId
+  let whereClause    = ratedBy uid
+      displayColumns = mconcat
+        [ dbRow
+        , colTerm
+        , colCourse
+        , colSheet
+        , colSubmissionLink
+        ] -- Continue here
+  table <- makeCorrectionsTable whereClause displayColumns
+  defaultLayout $ do
+    setTitleI MsgCourseCorrectionsTitle
+    $(widgetFile "corrections")
+
+getCourseCorrectionsR ::  TermId -> Text -> Handler Html
+getCourseCorrectionsR tid csh = do
+  cid <- runDB $ getBy404 $ CourseTermShort tid csh
+  let whereClause    = courseIs $ entityKey cid
+      displayColumns = mconcat
+        [ dbRow
+        , colSheet
+        , colCorrector
+        , colSubmissionLink
+        ] -- Continue here
+  table <- makeCorrectionsTable whereClause displayColumns
   defaultLayout $ do
     setTitleI MsgCorrectionsTitle
     $(widgetFile "corrections")