Corrector loads shown; BUG preview somehow missing now
This commit is contained in:
Steffen Jost
parent
8201aa84e5
commit
d5b094d6b4
@ -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
|
||||
|
||||
@ -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 "
|
||||
|
||||
@ -36,34 +36,29 @@
|
||||
<th .table__th>_{MsgNrSubmissionsNotCorrected}
|
||||
<th .table__th colspan=3>_{MsgCorrectionTime}
|
||||
$forall shn <- sheetNames
|
||||
<th .table__th colspan=4>#{shn}
|
||||
<th .table__th colspan=5>#{shn}
|
||||
$forall (CorrectionInfo{ciCorrector, ciSubmissions, ciCorrected, ciMin, ciTot, ciMax}) <- Map.elems corrMap
|
||||
<tr .table__row>
|
||||
<td .table__td>^{showCorrector ciCorrector}
|
||||
<td .table__td>#{ciSubmissions}
|
||||
<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}
|
||||
$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
|
||||
<td .table__td>#{ciAssigned}
|
||||
<td .table__td .alert-success>(+#{nrNew})
|
||||
<td .table__td .heated style="--hotness: #{heat ciSubmissions ciCorrected}">#{ciAssigned - ciCorrected}
|
||||
<td .table__td>#{showAvgsDays ciTot ciCorrected}
|
||||
$nothing
|
||||
<td .table__td colspan=2>#{ciAssigned}
|
||||
<td .table__td>#{ciAssigned - ciCorrected}
|
||||
<td .table__td>#{showAvgsDays ciTot ciCorrected}
|
||||
$with (nameW,loadM) <- getCorrector ciCorrector
|
||||
<tr .table__row>
|
||||
<td .table__td>^{nameW}
|
||||
<td .table__td>#{ciSubmissions}
|
||||
<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}
|
||||
$forall shn <- sheetNames
|
||||
$maybe SheetCorrector{sheetCorrectorLoad, sheetCorrectorState} <- Map.lookup shn loadM
|
||||
<td .table__td>#{showCompactCorrectorLoad sheetCorrectorLoad sheetCorrectorState}
|
||||
$nothing
|
||||
<td .table__td>
|
||||
$maybe CorrectionInfo{ciAssigned,ciCorrected,ciTot} <- getCorrSheetStatus ciCorrector shn
|
||||
$maybe nrNew <- getCorrNewAssignment ciCorrector shn
|
||||
<td .table__td>#{ciAssigned}
|
||||
<td .table__td .alert-success>(+#{nrNew})
|
||||
$nothing
|
||||
<td .table__td colspan=2>#{ciAssigned}
|
||||
<td .table__td>#{ciAssigned - ciCorrected}
|
||||
<td .table__td>#{showAvgsDays ciTot ciCorrected}
|
||||
<td .table__td .heated style="--hotness: #{heat ciSubmissions ciCorrected}">#{ciAssigned - ciCorrected}
|
||||
<td .table__td>#{showAvgsDays ciTot ciCorrected}
|
||||
$nothing
|
||||
<td .table__td colspan=4>
|
||||
$nothing
|
||||
<td .table__td colspan=4>
|
||||
<td .table__td colspan=5>
|
||||
^{btnWdgt}
|
||||
Loading…
Reference in New Issue
Block a user