Compiles and works, but still needs some minor fixes

This commit is contained in:
Steffen Jost 2019-06-16 16:38:28 +02:00
parent 4f1b2886cd
commit af00b06130
2 changed files with 5 additions and 7 deletions

View File

@ -1134,6 +1134,7 @@ assignHandler tid ssh csh cid assignSids = do
return (corrector, user)
let correctorMap :: Map UserId (SheetCorrector,User)
correctorMap = foldl (\m (Entity _ corr, Entity uid user)-> Map.insert uid (corr,user) m) Map.empty correctors
-- TODO: CorrectorMap should contain Map SheetId SheetCorrector
submissions <- E.select . E.from $ \submission -> do
E.where_ $ submission E.^. SubmissionSheet `E.in_` E.valList sheetIds
@ -1187,11 +1188,8 @@ assignHandler tid ssh csh cid assignSids = do
(Just BtnSubmissionsAssign) -> writeSubmissionPlan plan
return $ Map.insert shn (status, countMapElems plan) acc
assignment <- foldM buildA Map.empty assignSids
return (nrParticipants, groupsPossible, infoMap, correctorMap, assignment)
let -- create aggregate maps
sheetMap :: Map SheetName CorrectionInfo
sheetMap = Map.map fold infoMap
@ -1209,8 +1207,8 @@ assignHandler tid ssh csh cid assignSids = do
showAvgsDays :: Maybe NominalDiffTime -> Integer -> Text
showAvgsDays Nothing _ = mempty
showAvgsDays (Just dt) n = formatDiffDays $ dt / fromIntegral n
heat :: Double -> Double -> Double
heat achieved full = roundToDigits 3 $ cutOffPercent 0.4 full achieved
heat :: Integer -> Integer -> Double
heat full achieved = roundToDigits 3 $ cutOffPercent 0.4 (fromIntegral full) (fromIntegral achieved)
let headingShort = MsgMenuCorrectionsAssign
headingLong = prependCourseTitle tid ssh csh MsgMenuCorrectionsAssign
siteLayoutMsg headingShort $ do

View File

@ -41,7 +41,7 @@
<tr .table__row>
<td .table__td>^{showCorrector ciCorrector}
<td .table__td>#{ciSubmissions}
<td .table__td>#{ciSubmissions - ciCorrected}
<td .table__td .heated style="--hotness: #{heat ciSubmissions ciCorrected}">#{ciSubmissions - ciCorrected}
<td .table__td>#{showDiffDays ciMin}
<td .table__td>#{showAvgsDays ciTot ciCorrected}
<td .table__td>#{showDiffDays ciMax}
@ -52,7 +52,7 @@
$maybe nrNew <- Map.lookup ciCorrector cass
<td .table__td>#{ciAssigned}
<td .table__td .alert-success>(+#{nrNew})
<td .table__td>#{ciAssigned - ciCorrected}
<td .table__td .heated style="--hotness: #{heat ciSubmissions ciCorrected}">#{ciAssigned - ciCorrected}
<td .table__td>#{showAvgsDays ciTot ciCorrected}
$nothing
<td .table__td colspan=2>#{ciAssigned}