fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Compiles and works, but still needs some minor fixes

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Handler/Corrections.hs
View File

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

4
templates/corrections-overview.hamlet
View File

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