correctionsTable generalized for various purposes, but needs bigger query
This commit is contained in:
SJost
parent
c6784a0b13
commit
b2a97d926d
@ -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.
|
||||
|
||||
3
routes
3
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
|
||||
|
||||
@ -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|<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
|
||||
(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
|
||||
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")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user