diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 4b18d9908..5b8cd35c7 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -131,8 +131,8 @@ colSubmissionLink = sortable Nothing (i18nCell MsgSubmission) return $ CSubmissionR tid ssh csh shn cid SubShowR 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 = dbSelect (applying _2) id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId +colSelect :: forall act h. (Monoid act, Headedness h) => Colonnade h CorrectionTableData (DBCell _ (FormResult (act, DBFormResult CryptoFileNameSubmission Bool CorrectionTableData), SheetTypeSummary)) +colSelect = dbSelect (_1 . applying _2) id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId colSubmittors :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) 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) in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")] -colRating :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) -colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId Submission{..}, Entity _ Sheet{..}, course, _, _) } -> +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 sub@Submission{..}, Entity _ Sheet{..}, course, _, _) } -> let csh = course ^. _2 tid = course ^. _3 ssh = course ^. _4 @@ -161,7 +161,14 @@ colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=( mkRoute = do cid <- encrypt subId 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 = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _) } -> @@ -324,7 +331,7 @@ data ActionCorrectionsData = CorrDownloadData | CorrDeleteData 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 postDeleteR $ \drRecords -> (submissionDeleteRoute drRecords) @@ -332,9 +339,8 @@ correctionsR whereClause (formColonnade -> displayColumns) dbtFilterUI psValidat , drSuccess = SomeRoute currentRoute } - ((actionRes', table), statistics) <- runDB $ do - -- Query for Table - tableRes <- makeCorrectionsTable whereClause displayColumns dbtFilterUI psValidator return DBParamsForm + ((actionRes', statistics), table) <- runDB $ + makeCorrectionsTable whereClause displayColumns dbtFilterUI psValidator return DBParamsForm { dbParamsFormMethod = POST , dbParamsFormAction = Just $ SomeRoute currentRoute , dbParamsFormAttrs = [] @@ -343,16 +349,16 @@ correctionsR whereClause (formColonnade -> displayColumns) dbtFilterUI psValidat (actionRes, action) <- multiAction actions Nothing return ((, mempty) . Last . Just <$> actionRes, toWidget frag <> action) , dbParamsFormEvaluate = liftHandlerT . runFormPost - , dbParamsFormResult = id + , dbParamsFormResult = _1 } - -- Similar Query for Statistics over alle possible Table elements (not just the ones shown) - gradingSummary <- do - 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 $ 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 - let statistics = gradeSummaryWidget MsgSubmissionGradingSummaryTitle gradingSummary - return (tableRes, statistics) + -- -- Similar Query for Statistics over alle possible Table elements (not just the ones shown) + -- gradingSummary <- do + -- 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 $ 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 + -- let statistics = gradeSummaryWidget MsgSubmissionGradingSummaryTitle gradingSummary + -- return (tableRes, statistics) 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 diff --git a/templates/corrections.hamlet b/templates/corrections.hamlet index 148fc7956..e8e84e217 100644 --- a/templates/corrections.hamlet +++ b/templates/corrections.hamlet @@ -1,4 +1,5 @@
^{table} -
- ^{statistics} +$if statistics /= mempty +
+ ^{gradeSummaryWidget MsgSubmissionGradingSummaryTitle statistics}