diff --git a/messages/de.msg b/messages/de.msg
index 9ec04885d..c8f50be26 100644
--- a/messages/de.msg
+++ b/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.
diff --git a/routes b/routes
index fe3059a9d..e52904522 100644
--- a/routes
+++ b/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
\ No newline at end of file
+!/*{CI FilePath} CryptoFileNameDispatchR GET !free
diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index f902b90f2..458954156 100644
--- a/src/Handler/Corrections.hs
+++ b/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 =>
- expr (Entity Course) -> Key Course -> expr (E.Value Bool)
-courseIs course cid = course E.^. CourseId E.==. E.val cid
+type CorrectionsWhere = forall query expr backend . (E.Esqueleto query expr backend) =>
+ (expr (Entity Course), expr (Entity Sheet), expr (Entity Submission))
+ -> expr (E.Value Bool)
-getCorrectionsR :: Handler Html
-getCorrectionsR = do
- uid <- requireAuthId
+ratedBy :: Key User -> CorrectionsWhere
+ratedBy uid (_course,_sheet,submission) = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
+
+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|#{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
- (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|#{display cid}|]
- ]
- -- TODO continue here
- table <- dbTable def $ DBTable
+ 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")