feat(corrector-assignment): show load/submission percentages

messages/uniworx/de.msg

@@ -322,7 +322,7 @@ Correctors: Korrektoren
 CorState: Status
 CorByTut: Zuteilung nach Tutorium
 CorProportion: Anteil
-CorDeficit: Defizit
+CorDeficitProportion: Defizit Anteile
 CorByProportionOnly proportion@Rational: #{display proportion} Anteile
 CorByProportionIncludingTutorial proportion@Rational: #{display proportion} Anteile - Tutorium
 CorByProportionExcludingTutorial proportion@Rational: #{display proportion} Anteile + Tutorium

src/Handler/Corrections.hs

@@ -1214,6 +1214,9 @@ assignHandler tid ssh csh cid assignSids = do
 
   let -- infoMap  :: Map SheetName (Map (Maybe UserId) CorrectionInfo) -- repeated here for easier reference
       -- create aggregate maps
+      sheetNames :: [SheetName]
+      sheetNames = Map.keys infoMap
+
       sheetMap :: Map SheetName CorrectionInfo
       sheetMap = Map.map fold infoMap
 
@@ -1230,7 +1233,10 @@ assignHandler tid ssh csh cid assignSids = do
 
       corrMap  :: Map (Maybe UserId) CorrectionInfo
       corrMap  = Map.unionsWith (<>) $ Map.elems infoMap
-      sheetNames = Map.keys infoMap
+
+      corrMapSum :: CorrectionInfo
+      corrMapSum = fold corrMap
+
   let -- whamlet convenience functions
       -- avoid nestes hamlet $maybe with duplicated $nothing
       getCorrector :: Maybe UserId -> (Widget,Map SheetName SheetCorrector)
@@ -1256,10 +1262,9 @@ assignHandler tid ssh csh cid assignSids = do
       getCorrDeficit _          = Nothing
 
       getLoadSum :: SheetName -> Text
-      getLoadSum shn
+      getLoadSum shn | (Just load) <- Map.lookup shn sheetLoad
-        | (Just load) <- Map.lookup shn sheetLoad
+                     = showCompactCorrectorLoad load CorrectorNormal
-        = "Σ" <> showCompactCorrectorLoad load CorrectorNormal
+      getLoadSum  _  = mempty
-      getLoadSum _ = mempty
 
       showDiffDays :: Maybe NominalDiffTime -> Text
       showDiffDays = foldMap formatDiffDays

src/Handler/Health.hs

@@ -63,7 +63,7 @@ getHealthR = do
                     <dd .deflist__dd>#{boolSymbol passed}
                   $of HealthLDAPAdmins (Just found)
                     <dt .deflist__dt>_{MsgHealthLDAPAdmins}
-                    <dd .deflist__dd>#{textPercent found}
+                    <dd .deflist__dd>#{textPercent found 1}
                   $of HealthSMTPConnect (Just passed)
                     <dt .deflist__dt>_{MsgHealthSMTPConnect}
                     <dd .deflist__dd>#{boolSymbol passed}
@@ -80,7 +80,7 @@ getInstanceR = do
   instanceInfo@(clusterId, instanceId) <- getsYesod $ (,) <$> appClusterID <*> appInstanceID
 
   setWeakEtagHashable (clusterId, instanceId)
-  
+
   selectRep $ do
     provideRep $
       siteLayoutMsg MsgInstanceIdentification $ do

src/Handler/Sheet.hs

@@ -257,9 +257,7 @@ getSheetListR tid ssh csh = do
               (Just (Entity _ Submission{submissionRatingPoints=Just sPoints})) ->
                 case preview (_grading . _maxPoints) sType of
                   Just maxPoints
-                    | maxPoints /= 0 ->
+                    | maxPoints /= 0 -> textCell $ textPercent sPoints maxPoints
-                        let percent = sPoints / maxPoints
-                        in textCell $ textPercent $ realToFrac percent
                   _other -> mempty
               _other -> mempty
       ]

src/Utils.hs

@@ -2,12 +2,13 @@ module Utils
   ( module Utils
   ) where
 
-import ClassyPrelude.Yesod hiding (foldlM)
+import ClassyPrelude.Yesod hiding (foldlM, Proxy)
 
 -- import Data.Double.Conversion.Text -- faster implementation for textPercent?
 import qualified Data.Foldable as Fold
 import Data.Foldable as Utils (foldlM, foldrM)
 import Data.Monoid (Sum(..))
+import Data.Proxy
 
 import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
@@ -67,7 +68,7 @@ import qualified Crypto.Saltine.Class as Saltine
 import qualified Crypto.Data.PKCS7 as PKCS7
 
 import Data.Fixed
-import Data.Ratio ((%))
+-- import Data.Ratio ((%))
 
 import Data.Binary (Binary)
 import qualified Data.Binary as Binary
@@ -293,15 +294,28 @@ instance {-# OVERLAPPABLE #-} Show a => DisplayAble a where -- The easy way out
   display = pack . show
 -}
 
-textPercent :: Real a => a -> Text -- slow, maybe use Data.Double.Conversion.Text.toFixed instead?
+-- | Convert `part` and `whole` into percentage including symbol
-textPercent x = lz <> pack (show rx) <> "%"
+--   showing trailing zeroes and to decimal digits
- where
+textPercent :: Real a => a -> a -> Text
-   rx :: Centi
+textPercent = textPercent' False 2
-   rx = realToFrac (x * 100)
+
-   lz = if rx < 10.0 then "0" else ""
+-- | Convert `part` and `whole` into percentage including symbol
+--   `trailZero` shows trailing Zeros, `precision` is number of decimal digits
+textPercent' :: Real a => Bool -> Int -> a -> a -> Text
+textPercent' trailZero precision part whole
+    | precision == 0 = showPercent (frac :: Uni)
+    | precision == 1 = showPercent (frac :: Deci)
+    | precision == 2 = showPercent (frac :: Centi)
+    | precision == 3 = showPercent (frac :: Milli)
+    | precision == 4 = showPercent (frac :: Micro)
+    | otherwise      = showPercent (frac :: Pico)
+  where
+    frac :: forall a . HasResolution a => Fixed a
+    frac = MkFixed $ round $ (* (fromInteger $ resolution (Proxy :: Proxy a)))  $ (100*) $ toRational part / toRational whole
+
+    showPercent :: HasResolution a => Fixed a -> Text
+    showPercent f = pack $ showFixed trailZero f <> "%"
 
-textPercentInt :: Integral a => a -> a -> Text -- slow, maybe use Data.Double.Conversion.Text.toFixed instead?
-textPercentInt part whole = textPercent $ fromIntegral part % fromIntegral whole
 
 -- | Convert number of bytes to human readable format
 textBytes :: Integral a => a -> Text

templates/corrections-overview.hamlet

@@ -45,7 +45,7 @@
     <tr .table__row .table__row--head>
       <th .table__th rowspan=2>_{MsgCorrector}
       <th .table__th colspan=2>_{MsgGenericAll}
-      <th .table__th>_{MsgCorProportion}
+      <th .table__th rowspan=2>_{MsgCorDeficitProportion}
       <th .table__th colspan=3>_{MsgCorrectionTime}
       $forall shn <- sheetNames
         <th .table__th colspan=5>#{shn}
@@ -53,7 +53,6 @@
     <tr .table__row .table__row--head>
       <th .table__th>_{MsgNrSubmissionsTotal}
       <th .table__th>_{MsgNrSubmissionsNotCorrected}
-      <th .table__th>_{MsgCorDeficit}
       <th .table__th>_{MsgGenericMin}
       <th .table__th>_{MsgGenericAvg}
       <th .table__th>_{MsgGenericMax}
@@ -63,24 +62,33 @@
         <th .table__th>_{MsgGenericNumChange}
         <th .table__th>_{MsgNrSubmissionsNotCorrectedShort}
         <th .table__th>_{MsgGenericAvg}
-    $forall (CorrectionInfo{ciCorrector, ciSubmissions, ciCorrected, ciMin, ciTot, ciMax}) <- Map.elems corrMap
+    $forall (CorrectionInfo{ciCorrector, ciSubmissions=ciSubmissionsNr, ciCorrected, ciMin, ciTot, ciMax}) <- Map.elems corrMap
       $with (nameW,loadM) <- getCorrector ciCorrector
         <tr .table__row>
           <td .table__td>^{nameW}
-          <td .table__td>#{ciSubmissions}
+          <td .table__td>#{ciSubmissionsNr}
-          <td .table__td .heated style="--hotness: #{heat ciSubmissions ciCorrected}">#{ciSubmissions - ciCorrected}
+            $with total <- ciSubmissions corrMapSum
+              $if total > 0
+                \ (#{textPercent' True 0 ciSubmissionsNr total})
+          <td .table__td .heated style="--hotness: #{heat ciSubmissionsNr ciCorrected}">#{ciSubmissionsNr - ciCorrected}
           <td .table__td>
               $maybe deficit <- getCorrDeficit ciCorrector
                 #{display deficit}
           <td .table__td>#{showDiffDays ciMin}
           <td .table__td>#{showAvgsDays ciTot ciCorrected}
           <td .table__td>#{showDiffDays ciMax}
-          $forall shn <- sheetNames
+          $forall (shn, CorrectionInfo{ciSubmissions=sheetSubmissionsNr}) <- Map.toList sheetMap
             <td .table__td>
               $maybe SheetCorrector{sheetCorrectorLoad, sheetCorrectorState} <- Map.lookup shn loadM
                 #{showCompactCorrectorLoad sheetCorrectorLoad sheetCorrectorState}
+                $if sheetCorrectorState == CorrectorNormal
+                  $maybe Load{byProportion=total} <- Map.lookup shn sheetLoad
+                    $if total > 0
+                      \ (#{textPercent' True 0 (byProportion sheetCorrectorLoad) total})
             $maybe CorrectionInfo{ciSubmissions,ciCorrected,ciTot} <- getCorrSheetStatus ciCorrector shn
               <td .table__td>#{ciSubmissions}
+                $if sheetSubmissionsNr > 0
+                  \ (#{textPercent' True 0 ciSubmissions sheetSubmissionsNr})
               $maybe nrNew <- getCorrNewAssignment ciCorrector shn
                 $# <td .table__td>#{ciAssigned} `ciSubmissions` is here always identical to `ciAssigned` and also works for `ciCorrector == Nothing`. ciAssigned only useful in aggregate maps like `sheetMap`
                 <td .table__td .alert-info>(+#{nrNew})
@@ -95,10 +103,16 @@
               <td .table__td>
     $if 0 < length sheetNames
       <tr .table__row>
-        <td colspan=6>
+        <td .table__th>Σ
+        <td .table__th>#{ciSubmissions corrMapSum}
+        <td .table__th>#{ciCorrected   corrMapSum}
+        <td .table__th>
+        <td .table__th>#{showDiffDays (ciMin corrMapSum)}
+        <td .table__th>#{showAvgsDays (ciTot corrMapSum) (ciCorrected corrMapSum)}
+        <td .table__th>#{showDiffDays (ciMax corrMapSum)}
         $forall shn <- sheetNames
-          <td .table__td>#{getLoadSum shn}
+          <td .table__th>#{getLoadSum shn}
-          <td .table__td colspan=4>^{simpleLinkI (SomeMessage MsgMenuCorrectorsChange) (CSheetR tid ssh csh shn SCorrR)}
+          <td .table__th colspan=4>^{simpleLinkI (SomeMessage MsgMenuCorrectorsChange) (CSheetR tid ssh csh shn SCorrR)}
   ^{btnWdgt}
  <div>
   <p>_{MsgAssignSubmissionsRandomWarning}

templates/widgets/grading-summary/grading-summary-row.hamlet

@@ -19,7 +19,7 @@ $#
             $with Sum pacv <- summary ^. _achievedPasses
               <td .table__td>
                 $if pmax > 0
-                  #{textPercentInt pacv pmax}
+                  #{textPercent pacv pmax}
               <td .table__td>
                 #{display pacv} / #{display pmax}
           $else
@@ -35,7 +35,7 @@ $#
           $with Sum pacv <- summary ^. _achievedPoints
             <td .table__td>
               $if pmax > 0
-                #{textPercent $ realToFrac $ pacv / pmax}
+                #{textPercent pacv pmax}
             <td .table__td>
               #{display pacv} / #{display pmax}
               $if ((summary ^. _numMarkedPoints) /= (summary ^. _numSheets))