fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixes #253

Browse Source
This commit is contained in:
SJost 2018-12-07 14:16:03 +01:00
parent 5728d413cf
commit 0407d10654
1 changed files with 18 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/Handler/Sheet.hs
View File

@ -146,12 +146,17 @@ getSheetListR tid ssh csh = do
lastSheetEdit sheet = E.sub_select . E.from $ \sheetEdit -> do
E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId
return . E.max_ $ sheetEdit E.^. SheetEditTime
sheetData :: E.SqlExpr (Entity Sheet) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity Submission)) `E.InnerJoin` (E.SqlExpr (Maybe (Entity SubmissionUser)))) -> E.SqlQuery ()
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
E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
sheetFilter :: SheetName -> DB Bool
sheetFilter sheetName = (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh sheetName SShowR) False
sheetCol = widgetColonnade . mconcat $
[ dbRow
, sortable (Just "name") (i18nCell MsgSheet)
@ -194,15 +199,17 @@ getSheetListR tid ssh csh = do
_other -> mempty
_other -> mempty
]
psValidator = def
& defaultSorting [("submission-since", SortAsc)]
(table,statistics) <- runDB $ liftA2 (,)
(table,raw_statistics) <- runDB $ liftA2 (,)
(dbTableWidget' psValidator DBTable
{ dbtColonnade = sheetCol
, dbtSQLQuery = \dt@(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser))
-> sheetData dt *> return (sheet, lastSheetEdit sheet, submission)
, dbtProj = \dbr@DBRow{ dbrOutput=(Entity _ Sheet{..}, _, _) }
-> dbr <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh sheetName SShowR) False)
-> dbr <$ guardM (lift $ sheetFilter sheetName)
, dbtSorting = Map.fromList
[ ( "name"
, SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName
@ -233,13 +240,16 @@ getSheetListR tid ssh csh = do
}
) (
-- Collect summary over all Sheets, not just the ones shown due to pagination:
gradeSummaryWidget MsgSheetGradingSummaryTitle .
foldMap (\(E.Value sheetType, E.Value mbPts) -> sheetTypeSum sheetType (join mbPts))
<$> (
E.select $ E.from $ \dt@(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) ->
sheetData dt *> return (sheet E.^. SheetType, submission E.?. SubmissionRatingPoints)
)
do
rows <- E.select $ E.from $ \dt@(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) ->
sheetData dt *> return (sheet E.^. SheetName, sheet E.^. SheetType, submission E.?. SubmissionRatingPoints)
flip filterM rows (\(E.Value sheetName, _, _) -> sheetFilter sheetName)
)
let statistics =
gradeSummaryWidget MsgSheetGradingSummaryTitle $
foldMap (\(_, E.Value sheetType, E.Value mbPts) -> sheetTypeSum sheetType (join mbPts))
raw_statistics
defaultLayout $ do
$(widgetFile "sheetList")