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

refactored as suggested by Gregor in #253

Browse Source
This commit is contained in:
SJost 2018-12-07 12:58:13 +01:00
parent 59714bd3c7
commit 5728d413cf
1 changed files with 45 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
src/Handler/Sheet.hs
View File

@ -146,13 +146,12 @@ getSheetListR tid ssh csh = do
lastSheetEdit sheet = E.sub_select . E.from $ \sheetEdit -> do lastSheetEdit sheet = E.sub_select . E.from $ \sheetEdit -> do
E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId
return . E.max_ $ sheetEdit E.^. SheetEditTime 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 (E.SqlExpr (Entity Sheet), E.SqlExpr (E.Value (Maybe UTCTime)),E.SqlExpr (Maybe (Entity Submission))) 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 sheetData (sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) = do
E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission
E.on $ (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet E.on $ (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet
E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid
E.where_ $ sheet E.^. SheetCourse E.==. E.val cid E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
return (sheet, lastSheetEdit sheet, submission)
sheetCol = widgetColonnade . mconcat $ sheetCol = widgetColonnade . mconcat $
[ dbRow [ dbRow
, sortable (Just "name") (i18nCell MsgSheet) , sortable (Just "name") (i18nCell MsgSheet)
@ -197,48 +196,50 @@ getSheetListR tid ssh csh = do
] ]
psValidator = def psValidator = def
& defaultSorting [("submission-since", SortAsc)] & defaultSorting [("submission-since", SortAsc)]
table <- runDB $ dbTableWidget' psValidator DBTable (table,statistics) <- runDB $ liftA2 (,)
{ dbtSQLQuery = sheetData (dbTableWidget' psValidator DBTable
, dbtColonnade = sheetCol { dbtColonnade = sheetCol
, dbtProj = \dbr@DBRow{ dbrOutput=(Entity _ Sheet{..}, _, _) } , dbtSQLQuery = \dt@(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser))
-> dbr <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh sheetName SShowR) False) -> sheetData dt *> return (sheet, lastSheetEdit sheet, submission)
, dbtSorting = Map.fromList , dbtProj = \dbr@DBRow{ dbrOutput=(Entity _ Sheet{..}, _, _) }
[ ( "name" -> dbr <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh sheetName SShowR) False)
, SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName , dbtSorting = Map.fromList
) [ ( "name"
, ( "last-edit" , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName
, SortColumn $ \(sheet `E.LeftOuterJoin` _) -> lastSheetEdit sheet )
) , ( "last-edit"
, ( "submission-since" , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> lastSheetEdit sheet
, SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveFrom )
) , ( "submission-since"
, ( "submission-until" , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveFrom
, SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveTo )
) , ( "submission-until"
, ( "rating" , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveTo
, SortColumn $ \(_sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) -> submission E.?. SubmissionRatingPoints )
) , ( "rating"
-- GitLab Issue $143: HOW TO SORT? , SortColumn $ \(_sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) -> submission E.?. SubmissionRatingPoints
-- , ( "percent" )
-- , SortColumn $ \(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) -> -- GitLab Issue $143: HOW TO SORT?
-- case sheetType of -- no Haskell inside Esqueleto, right? -- , ( "percent"
-- (submission E.?. SubmissionRatingPoints) E./. (sheet E.^. SheetType) -- , SortColumn $ \(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) ->
-- ) -- case sheetType of -- no Haskell inside Esqueleto, right?
] -- (submission E.?. SubmissionRatingPoints) E./. (sheet E.^. SheetType)
, dbtFilter = mempty -- )
, dbtFilterUI = mempty ]
, dbtStyle = def , dbtFilter = mempty
, dbtIdent = "sheets" :: Text , dbtFilterUI = mempty
} , dbtStyle = def
-- Collect summary over all Sheets, not just the ones shown due to pagination: , dbtIdent = "sheets" :: Text
statistics <- gradeSummaryWidget MsgSheetGradingSummaryTitle <$> do }
rows <- runDB $ E.select $ E.from $ \(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) -> do ) (
E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission -- Collect summary over all Sheets, not just the ones shown due to pagination:
E.on $ (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet gradeSummaryWidget MsgSheetGradingSummaryTitle .
E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid foldMap (\(E.Value sheetType, E.Value mbPts) -> sheetTypeSum sheetType (join mbPts))
E.where_ $ sheet E.^. SheetCourse E.==. E.val cid <$> (
return (sheet E.^. SheetType, submission E.?. SubmissionRatingPoints) E.select $ E.from $ \dt@(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) ->
return $ foldMap (\(E.Value sheetType, E.Value mbPts) -> sheetTypeSum sheetType (join mbPts)) rows sheetData dt *> return (sheet E.^. SheetType, submission E.?. SubmissionRatingPoints)
)
)
defaultLayout $ do defaultLayout $ do
$(widgetFile "sheetList") $(widgetFile "sheetList")