diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 58e775dea..547dd8447 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -1082,7 +1082,7 @@ assignHandler' tid ssh csh _cid rawSids = do \acc sid -> flip (Map.insert sid) acc <$> assignSubmissions sid Nothing -- Too much important information for an alert message. Display proper info page instead let btnForm = wrapForm btnWdgt def - { formAction = SomeRoute <$> currentRoute -- TODO: should be a modal route + { formAction = SomeRoute <$> currentRoute , formEncoding = btnEnctype , formSubmit = FormNoSubmit } @@ -1132,9 +1132,11 @@ assignHandler tid ssh csh cid assignSids = do E.on $ corrector E.^. SheetCorrectorUser E.==. user E.^. UserId E.where_ $ corrector E.^. SheetCorrectorSheet `E.in_` E.valList sheetIds 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 + let correctorMap :: Map UserId (User, Map SheetName SheetCorrector) + correctorMap = (\f -> foldl f Map.empty correctors) (\acc (Entity _ sheetcorr@SheetCorrector{sheetCorrectorSheet}, Entity uid user) -> + let shn = sheetName $ sheets ! sheetCorrectorSheet + in Map.insertWith (\(usr, ma) (_, mb) -> (usr, Map.union ma mb)) uid (user, Map.singleton shn sheetcorr) acc + ) submissions <- E.select . E.from $ \submission -> do E.where_ $ submission E.^. SubmissionSheet `E.in_` E.valList sheetIds @@ -1191,18 +1193,33 @@ assignHandler tid ssh csh cid assignSids = do assignment <- foldM buildA Map.empty assignSids return (nrParticipants, groupsPossible, infoMap, correctorMap, assignment) - let -- create aggregate maps + let -- infoMap :: Map SheetName (Map (Maybe UserId) CorrectionInfo) -- repeated here for easier reference + -- create aggregate maps sheetMap :: Map SheetName CorrectionInfo sheetMap = Map.map fold infoMap corrMap :: Map (Maybe UserId) CorrectionInfo corrMap = Map.unionsWith (<>) $ Map.elems infoMap sheetNames = Map.keys infoMap let -- whamlet convenience functions - showCorrector :: Maybe UserId -> Widget - showCorrector (Just uid) - | Just (_,User{..}) <- Map.lookup uid correctorMap - = nameEmailWidget userEmail userDisplayName userSurname - showCorrector _ = [whamlet|_{MsgNoCorrectorAssigned}|] + -- avoid nestes hamelt $maybe with duplicated $nothing + getCorrector :: Maybe UserId -> (Widget,Map SheetName SheetCorrector) + getCorrector (Just uid) + | Just (User{..},loadMap) <- Map.lookup uid correctorMap + = (nameEmailWidget userEmail userDisplayName userSurname, loadMap) + getCorrector _ = ([whamlet|_{MsgNoCorrectorAssigned}|], mempty) + -- avoid nestes hamelt $maybe with duplicated $nothing + getCorrSheetStatus :: Maybe UserId -> SheetName -> Maybe CorrectionInfo + getCorrSheetStatus corr shn + | (Just smap) <- Map.lookup shn infoMap + = Map.lookup corr smap + getCorrSheetStatus _ _ = Nothing + -- avoid nestes hamelt $maybe with duplicated $nothing + getCorrNewAssignment :: Maybe UserId -> SheetName -> Maybe Int + getCorrNewAssignment corr shn + | (Just (_,cass)) <- Map.lookup shn assignment + = Map.lookup corr cass + getCorrNewAssignment _ _ = Nothing + showDiffDays :: Maybe NominalDiffTime -> Text showDiffDays = foldMap formatDiffDays showAvgsDays :: Maybe NominalDiffTime -> Integer -> Text diff --git a/src/Model/Types/Sheet.hs b/src/Model/Types/Sheet.hs index 74fb91dc1..5e971fb1d 100644 --- a/src/Model/Types/Sheet.hs +++ b/src/Model/Types/Sheet.hs @@ -305,3 +305,15 @@ instance Hashable CorrectorState nullaryPathPiece ''CorrectorState (camelToPathPiece' 1) derivePersistField "CorrectorState" + +showCompactCorrectorLoad :: Load -> CorrectorState -> Text +showCompactCorrectorLoad load CorrectorMissing = "[" <> showCompactCorrectorLoad load CorrectorNormal <> "]" +showCompactCorrectorLoad load CorrectorExcused = "{" <> showCompactCorrectorLoad load CorrectorNormal <> "}" +showCompactCorrectorLoad Load{..} CorrectorNormal = proportionText <> tutorialText + where + proportionText = let propDbl :: Double + propDbl = fromRational byProportion + in tshow $ roundToDigits 2 propDbl + tutorialText = case byTutorial of Nothing -> mempty + Just True -> " (T)" + Just False -> " +T " diff --git a/templates/corrections-overview.hamlet b/templates/corrections-overview.hamlet index 88deec48a..76ac17905 100644 --- a/templates/corrections-overview.hamlet +++ b/templates/corrections-overview.hamlet @@ -36,34 +36,29 @@ _{MsgNrSubmissionsNotCorrected} _{MsgCorrectionTime} $forall shn <- sheetNames - #{shn} + #{shn} $forall (CorrectionInfo{ciCorrector, ciSubmissions, ciCorrected, ciMin, ciTot, ciMax}) <- Map.elems corrMap - - ^{showCorrector ciCorrector} - #{ciSubmissions} - #{ciSubmissions - ciCorrected} - #{showDiffDays ciMin} - #{showAvgsDays ciTot ciCorrected} - #{showDiffDays ciMax} - $forall shn <- sheetNames - $maybe smap <- Map.lookup shn infoMap - $maybe CorrectionInfo{ciAssigned,ciCorrected,ciTot} <- Map.lookup ciCorrector smap - $maybe (_,cass) <- Map.lookup shn assignment - $maybe nrNew <- Map.lookup ciCorrector cass - #{ciAssigned} - (+#{nrNew}) - #{ciAssigned - ciCorrected} - #{showAvgsDays ciTot ciCorrected} - $nothing - #{ciAssigned} - #{ciAssigned - ciCorrected} - #{showAvgsDays ciTot ciCorrected} + $with (nameW,loadM) <- getCorrector ciCorrector + + ^{nameW} + #{ciSubmissions} + #{ciSubmissions - ciCorrected} + #{showDiffDays ciMin} + #{showAvgsDays ciTot ciCorrected} + #{showDiffDays ciMax} + $forall shn <- sheetNames + $maybe SheetCorrector{sheetCorrectorLoad, sheetCorrectorState} <- Map.lookup shn loadM + #{showCompactCorrectorLoad sheetCorrectorLoad sheetCorrectorState} + $nothing + + $maybe CorrectionInfo{ciAssigned,ciCorrected,ciTot} <- getCorrSheetStatus ciCorrector shn + $maybe nrNew <- getCorrNewAssignment ciCorrector shn + #{ciAssigned} + (+#{nrNew}) $nothing #{ciAssigned} - #{ciAssigned - ciCorrected} - #{showAvgsDays ciTot ciCorrected} + #{ciAssigned - ciCorrected} + #{showAvgsDays ciTot ciCorrected} $nothing - - $nothing - + ^{btnWdgt} \ No newline at end of file