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

Integrate statistics into correctionsR

Browse Source
This commit is contained in:
Gregor Kleen 2019-01-25 18:51:28 +01:00
parent c9ba51a0c9
commit b10dba427b
2 changed files with 27 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
src/Handler/Corrections.hs
View File

@ -131,8 +131,8 @@ colSubmissionLink = sortable Nothing (i18nCell MsgSubmission)
return $ CSubmissionR tid ssh csh shn cid SubShowR return $ CSubmissionR tid ssh csh shn cid SubShowR
in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|]) in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|])
colSelect :: forall act h. (Monoid act, Headedness h) => Colonnade h CorrectionTableData (DBCell _ (FormResult (act, DBFormResult CryptoFileNameSubmission Bool CorrectionTableData))) colSelect :: forall act h. (Monoid act, Headedness h) => Colonnade h CorrectionTableData (DBCell _ (FormResult (act, DBFormResult CryptoFileNameSubmission Bool CorrectionTableData), SheetTypeSummary))
colSelect = dbSelect (applying _2) id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId colSelect = dbSelect (_1 . applying _2) id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId
colSubmittors :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colSubmittors :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, users) } -> let colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, users) } -> let
@ -151,8 +151,8 @@ colSMatrikel = sortable Nothing (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_,
protoCell = listCell (Map.toList users) $ \(userId, (User{..}, _)) -> anchorCellM (AdminUserR <$> encrypt userId) (maybe mempty toWidget userMatrikelnummer) protoCell = listCell (Map.toList users) $ \(userId, (User{..}, _)) -> anchorCellM (AdminUserR <$> encrypt userId) (maybe mempty toWidget userMatrikelnummer)
in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")] in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
colRating :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colRating :: forall m a. IsDBTable m (a, SheetTypeSummary) => Colonnade Sortable CorrectionTableData (DBCell m (a, SheetTypeSummary))
colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId Submission{..}, Entity _ Sheet{..}, course, _, _) } -> colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId sub@Submission{..}, Entity _ Sheet{..}, course, _, _) } ->
let csh = course ^. _2 let csh = course ^. _2
tid = course ^. _3 tid = course ^. _3
ssh = course ^. _4 ssh = course ^. _4
@ -161,7 +161,14 @@ colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(
mkRoute = do mkRoute = do
cid <- encrypt subId cid <- encrypt subId
return $ CSubmissionR tid ssh csh sheetName cid CorrectionR return $ CSubmissionR tid ssh csh sheetName cid CorrectionR
in anchorCellM mkRoute $(widgetFile "widgets/rating") in mconcat
[ anchorCellM mkRoute $(widgetFile "widgets/rating")
, writerCell $ do
let
summary :: SheetTypeSummary
summary = sheetTypeSum sheetType $ submissionRatingPoints <* guard (submissionRatingDone sub)
scribe (_2 :: Lens' (a, SheetTypeSummary) SheetTypeSummary) summary
]
colAssigned :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colAssigned :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _) } -> colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _) } ->
@ -324,7 +331,7 @@ data ActionCorrectionsData = CorrDownloadData
| CorrDeleteData | CorrDeleteData
correctionsR :: _ -> _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerT UniWorX IO) ActionCorrectionsData) -> Handler TypedContent correctionsR :: _ -> _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerT UniWorX IO) ActionCorrectionsData) -> Handler TypedContent
correctionsR whereClause (formColonnade -> displayColumns) dbtFilterUI psValidator actions = do correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
Just currentRoute <- getCurrentRoute -- This should never be called from a 404 handler Just currentRoute <- getCurrentRoute -- This should never be called from a 404 handler
postDeleteR $ \drRecords -> (submissionDeleteRoute drRecords) postDeleteR $ \drRecords -> (submissionDeleteRoute drRecords)
@ -332,9 +339,8 @@ correctionsR whereClause (formColonnade -> displayColumns) dbtFilterUI psValidat
, drSuccess = SomeRoute currentRoute , drSuccess = SomeRoute currentRoute
} }
((actionRes', table), statistics) <- runDB $ do ((actionRes', statistics), table) <- runDB $
-- Query for Table makeCorrectionsTable whereClause displayColumns dbtFilterUI psValidator return DBParamsForm
tableRes <- makeCorrectionsTable whereClause displayColumns dbtFilterUI psValidator return DBParamsForm
{ dbParamsFormMethod = POST { dbParamsFormMethod = POST
, dbParamsFormAction = Just $ SomeRoute currentRoute , dbParamsFormAction = Just $ SomeRoute currentRoute
, dbParamsFormAttrs = [] , dbParamsFormAttrs = []
@ -343,16 +349,16 @@ correctionsR whereClause (formColonnade -> displayColumns) dbtFilterUI psValidat
(actionRes, action) <- multiAction actions Nothing (actionRes, action) <- multiAction actions Nothing
return ((, mempty) . Last . Just <$> actionRes, toWidget frag <> action) return ((, mempty) . Last . Just <$> actionRes, toWidget frag <> action)
, dbParamsFormEvaluate = liftHandlerT . runFormPost , dbParamsFormEvaluate = liftHandlerT . runFormPost
, dbParamsFormResult = id , dbParamsFormResult = _1
} }
-- Similar Query for Statistics over alle possible Table elements (not just the ones shown) -- -- Similar Query for Statistics over alle possible Table elements (not just the ones shown)
gradingSummary <- do -- gradingSummary <- do
let getTypePoints ((_course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` _corrector) = (sheet E.^. SheetType, submission E.^. SubmissionRatingPoints, submission E.^. SubmissionRatingTime) -- let getTypePoints ((_course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` _corrector) = (sheet E.^. SheetType, submission E.^. SubmissionRatingPoints, submission E.^. SubmissionRatingTime)
points <- E.select . E.from $ correctionsTableQuery whereClause getTypePoints -- points <- E.select . E.from $ correctionsTableQuery whereClause getTypePoints
-- points <- E.select . E.from $ t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) -> (correctionsTableQuery whereClause getTypePoints t) <* E.distinctOn [] -- -- points <- E.select . E.from $ t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) -> (correctionsTableQuery whereClause getTypePoints t) <* E.distinctOn []
return $ foldMap (\(E.Value stype, E.Value srpoints, E.Value srtime) -> sheetTypeSum stype (srpoints <* srtime)) points -- return $ foldMap (\(E.Value stype, E.Value srpoints, E.Value srtime) -> sheetTypeSum stype (srpoints <* srtime)) points
let statistics = gradeSummaryWidget MsgSubmissionGradingSummaryTitle gradingSummary -- let statistics = gradeSummaryWidget MsgSubmissionGradingSummaryTitle gradingSummary
return (tableRes, statistics) -- return (tableRes, statistics)
let actionRes = actionRes' & mapped._2 %~ Map.keysSet . Map.filter id . getDBFormResult (const False) let actionRes = actionRes' & mapped._2 %~ Map.keysSet . Map.filter id . getDBFormResult (const False)
& mapped._1 %~ fromMaybe (error "By consctruction the form should always return an action") . getLast & mapped._1 %~ fromMaybe (error "By consctruction the form should always return an action") . getLast

5
templates/corrections.hamlet
View File

@ -1,4 +1,5 @@
<section> <section>
^{table} ^{table}
<section> $if statistics /= mempty
^{statistics} <section>
^{gradeSummaryWidget MsgSubmissionGradingSummaryTitle statistics}