Integrate statistics into correctionsR

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

templates/corrections.hamlet

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