diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index cd7300b09..012b6b587 100644 --- a/messages/uniworx/de.msg +++ b/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 diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 81335f4ac..f62fc6487 100644 --- a/src/Handler/Corrections.hs +++ b/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 - | (Just load) <- Map.lookup shn sheetLoad - = "Σ" <> showCompactCorrectorLoad load CorrectorNormal - getLoadSum _ = mempty + getLoadSum shn | (Just load) <- Map.lookup shn sheetLoad + = showCompactCorrectorLoad load CorrectorNormal + getLoadSum _ = mempty showDiffDays :: Maybe NominalDiffTime -> Text showDiffDays = foldMap formatDiffDays diff --git a/src/Handler/Health.hs b/src/Handler/Health.hs index 046c16aff..7b29e2bbd 100644 --- a/src/Handler/Health.hs +++ b/src/Handler/Health.hs @@ -63,7 +63,7 @@ getHealthR = do
#{boolSymbol passed} $of HealthLDAPAdmins (Just found)
_{MsgHealthLDAPAdmins} -
#{textPercent found} +
#{textPercent found 1} $of HealthSMTPConnect (Just passed)
_{MsgHealthSMTPConnect}
#{boolSymbol passed} @@ -80,7 +80,7 @@ getInstanceR = do instanceInfo@(clusterId, instanceId) <- getsYesod $ (,) <$> appClusterID <*> appInstanceID setWeakEtagHashable (clusterId, instanceId) - + selectRep $ do provideRep $ siteLayoutMsg MsgInstanceIdentification $ do diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index c14424251..791bce180 100644 --- a/src/Handler/Sheet.hs +++ b/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 -> - let percent = sPoints / maxPoints - in textCell $ textPercent $ realToFrac percent + | maxPoints /= 0 -> textCell $ textPercent sPoints maxPoints _other -> mempty _other -> mempty ] diff --git a/src/Utils.hs b/src/Utils.hs index 4f565befe..e02a8b9b2 100644 --- a/src/Utils.hs +++ b/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? -textPercent x = lz <> pack (show rx) <> "%" - where - rx :: Centi - rx = realToFrac (x * 100) - lz = if rx < 10.0 then "0" else "" +-- | Convert `part` and `whole` into percentage including symbol +-- showing trailing zeroes and to decimal digits +textPercent :: Real a => a -> a -> Text +textPercent = textPercent' False 2 + +-- | 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 diff --git a/templates/corrections-overview.hamlet b/templates/corrections-overview.hamlet index 5d3f6ba8b..c4d4c0f3c 100644 --- a/templates/corrections-overview.hamlet +++ b/templates/corrections-overview.hamlet @@ -45,7 +45,7 @@ _{MsgCorrector} _{MsgGenericAll} - _{MsgCorProportion} + _{MsgCorDeficitProportion} _{MsgCorrectionTime} $forall shn <- sheetNames #{shn} @@ -53,7 +53,6 @@ _{MsgNrSubmissionsTotal} _{MsgNrSubmissionsNotCorrected} - _{MsgCorDeficit} _{MsgGenericMin} _{MsgGenericAvg} _{MsgGenericMax} @@ -63,24 +62,33 @@ _{MsgGenericNumChange} _{MsgNrSubmissionsNotCorrectedShort} _{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 ^{nameW} - #{ciSubmissions} - #{ciSubmissions - ciCorrected} + #{ciSubmissionsNr} + $with total <- ciSubmissions corrMapSum + $if total > 0 + \ (#{textPercent' True 0 ciSubmissionsNr total}) + #{ciSubmissionsNr - ciCorrected} $maybe deficit <- getCorrDeficit ciCorrector #{display deficit} #{showDiffDays ciMin} #{showAvgsDays ciTot ciCorrected} #{showDiffDays ciMax} - $forall shn <- sheetNames + $forall (shn, CorrectionInfo{ciSubmissions=sheetSubmissionsNr}) <- Map.toList sheetMap $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 #{ciSubmissions} + $if sheetSubmissionsNr > 0 + \ (#{textPercent' True 0 ciSubmissions sheetSubmissionsNr}) $maybe nrNew <- getCorrNewAssignment ciCorrector shn $# #{ciAssigned} `ciSubmissions` is here always identical to `ciAssigned` and also works for `ciCorrector == Nothing`. ciAssigned only useful in aggregate maps like `sheetMap` (+#{nrNew}) @@ -95,10 +103,16 @@ $if 0 < length sheetNames - + Σ + #{ciSubmissions corrMapSum} + #{ciCorrected corrMapSum} + + #{showDiffDays (ciMin corrMapSum)} + #{showAvgsDays (ciTot corrMapSum) (ciCorrected corrMapSum)} + #{showDiffDays (ciMax corrMapSum)} $forall shn <- sheetNames - #{getLoadSum shn} - ^{simpleLinkI (SomeMessage MsgMenuCorrectorsChange) (CSheetR tid ssh csh shn SCorrR)} + #{getLoadSum shn} + ^{simpleLinkI (SomeMessage MsgMenuCorrectorsChange) (CSheetR tid ssh csh shn SCorrR)} ^{btnWdgt}

_{MsgAssignSubmissionsRandomWarning} \ No newline at end of file diff --git a/templates/widgets/grading-summary/grading-summary-row.hamlet b/templates/widgets/grading-summary/grading-summary-row.hamlet index 261b98e1a..0e64a515b 100644 --- a/templates/widgets/grading-summary/grading-summary-row.hamlet +++ b/templates/widgets/grading-summary/grading-summary-row.hamlet @@ -19,7 +19,7 @@ $# $with Sum pacv <- summary ^. _achievedPasses $if pmax > 0 - #{textPercentInt pacv pmax} + #{textPercent pacv pmax} #{display pacv} / #{display pmax} $else @@ -35,7 +35,7 @@ $# $with Sum pacv <- summary ^. _achievedPoints $if pmax > 0 - #{textPercent $ realToFrac $ pacv / pmax} + #{textPercent pacv pmax} #{display pacv} / #{display pmax} $if ((summary ^. _numMarkedPoints) /= (summary ^. _numSheets))