diff --git a/.vscode/tasks.json b/.vscode/tasks.json index 27205f38c..a2b36e1b4 100644 --- a/.vscode/tasks.json +++ b/.vscode/tasks.json @@ -53,6 +53,11 @@ "type": "npm", "script": "yesod:start", "problemMatcher": [] + }, + { + "type": "npm", + "script": "start", + "problemMatcher": [] } ] } \ No newline at end of file diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 8513fc2db..e0a5882a3 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -17,7 +17,7 @@ BtnLecInvAccept: Annehmen BtnLecInvDecline: Ablehnen BtnCorrInvAccept: Annehmen BtnCorrInvDecline: Ablehnen - +BtnSubmissionsAssign: Abgaben automatisch zuteilen Aborted: Abgebrochen @@ -33,6 +33,7 @@ GenericKey: Schlüssel GenericShort: Kürzel GenericIsNew: Neu GenericHasConflict: Konflikt +GenericBack: Zurück SummerTerm year@Integer: Sommersemester #{display year} WinterTerm year@Integer: Wintersemester #{display year}/#{display $ succ year} @@ -378,6 +379,7 @@ CorrDownload: Herunterladen CorrUploadField: Korrekturen CorrUpload: Korrekturen hochladen CorrSetCorrector: Korrektor zuweisen +CorrSetCorrectorTooltip: Bereits verteilte Abgaben müssen zuerst Korrektor zugewiesen werden, bevor diese neu verteilt werden. CorrAutoSetCorrector: Korrekturen verteilen CorrDelete: Abgaben löschen NatField name@Text: #{name} muss eine natürliche Zahl sein! @@ -396,7 +398,11 @@ SelfCorrectors num@Int64: #{display num} Abgaben wurden Abgebenden als eigenem K AssignSubmissionExceptionNoCorrectors: Es sind keine Korrektoren eingestellt AssignSubmissionExceptionNoCorrectorsByProportion: Es sind keine Korrektoren mit Anteil ungleich Null eingestellt AssignSubmissionExceptionSubmissionsNotFound n@Int: #{tshow n} Abgaben konnten nicht gefunden werden - +NrSubmissionsTotal: Abgaben +NrSubmissionsUnassigned: Ohne Korrektor +NrCorrectors: Korrektoren +NrSubmissionsNewlyAssigned: Neu zugeteilt +NrSubmissionsNotAssigned: Nicht zugeteilt CorrectionsUploaded num@Int64: #{display num} Korrekturen wurden gespeichert: NoCorrectionsUploaded: In der hochgeladenen Datei wurden keine Korrekturen gefunden. @@ -822,6 +828,7 @@ MenuCorrectionsUpload: Korrekturen hochladen MenuCorrectionsDownload: Offene Abgaben herunterladen MenuCorrectionsCreate: Abgaben registrieren MenuCorrectionsGrade: Abgaben online korrigieren +MenuCorrectionsAssign: Abgaben automatisch zuteilen MenuAuthPreds: Authorisierungseinstellungen MenuTutorialDelete: Tutorium löschen MenuTutorialEdit: Tutorium editieren diff --git a/routes b/routes index b1a1214bc..31885f668 100644 --- a/routes +++ b/routes @@ -92,6 +92,7 @@ /communication CCommR GET POST /notes CNotesR GET POST !corrector -- THIS route is used to check for overall course corrector access! /subs CCorrectionsR GET POST + /subs/assigned CAssignR GET POST /ex SheetListR GET !course-registered !materials !corrector /ex/new SheetNewR GET POST /ex/current SheetCurrentR GET !course-registered !materials !corrector @@ -103,10 +104,11 @@ /subs SSubsR GET POST -- for lecturer only !/subs/new SubmissionNewR GET POST !timeANDcourse-registeredANDuser-submissions !/subs/own SubmissionOwnR GET !free -- just redirect + !/subs/assign SAssignR GET POST !lecturerANDtime /subs/#CryptoFileNameSubmission SubmissionR: / SubShowR GET POST !ownerANDtimeANDuser-submissions !ownerANDread !correctorANDread /delete SubDelR GET POST !ownerANDtimeANDuser-submissions - /assign SAssignR GET POST !lecturerANDtime + /assign SubAssignR GET POST !lecturerANDtime /correction CorrectionR GET POST !corrector !ownerANDreadANDrated /invite SInviteR GET POST !ownerANDtimeANDuser-submissions !/#SubmissionFileType SubArchiveR GET !owner !corrector diff --git a/src/Foundation.hs b/src/Foundation.hs index 6b5c9f508..4567440f8 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -676,10 +676,11 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of SZipR SheetSolution -> guard $ maybe False (<= cTime) sheetSolutionFrom SZipR _ -> mzero -- Submissions - SubmissionNewR -> guard active - SubmissionR _ SAssignR -> guard marking -- Correctors can only be assigned when the Sheet is inactive, since submissions are subject to change - SubmissionR _ _ -> guard active - _ -> return () + SubmissionNewR -> guard active + SAssignR -> guard marking -- Correctors can only be assigned when the Sheet is inactive, since submissions are subject to change; this is assumed in Corrections.assignHandler + SubmissionR _ SubAssignR -> guard marking -- Correctors can only be assigned when the Sheet is inactive, since submissions are subject to change + SubmissionR _ _ -> guard active + _ -> return () return Authorized @@ -966,7 +967,7 @@ evalAuthTags AuthTagActive{..} (map (Set.toList . toNullable) . Set.toList . dnf let authVarSpecificity = authTagSpecificity `on` plVar authDNF = sortBy (authVarSpecificity `on` maximumBy authVarSpecificity . impureNonNull) $ map (sortBy authVarSpecificity) authDNF' - + authTagIsInactive = not . authTagIsActive evalAuthTag :: AuthTag -> WriterT (Set AuthTag) m AuthResult @@ -1426,6 +1427,7 @@ instance YesodBreadcrumbs UniWorX where breadcrumb (CourseR tid ssh csh CInviteR) = return ("Einladung", Just $ CourseR tid ssh csh CShowR) breadcrumb (CourseR tid ssh csh (CUserR _)) = return ("Teilnehmer" , Just $ CourseR tid ssh csh CUsersR) breadcrumb (CourseR tid ssh csh CCorrectionsR) = return ("Abgaben" , Just $ CourseR tid ssh csh CShowR) + breadcrumb (CourseR tid ssh csh CAssignR) = return ("Zuteilen" , Just $ CourseR tid ssh csh CCorrectionsR) breadcrumb (CourseR tid ssh csh SheetListR) = return ("Übungen" , Just $ CourseR tid ssh csh CShowR) breadcrumb (CourseR tid ssh csh SheetNewR ) = return ("Neu", Just $ CourseR tid ssh csh SheetListR) breadcrumb (CourseR tid ssh csh SheetCurrentR) = return ("Aktuelles Blatt", Just $ CourseR tid ssh csh SheetListR) @@ -1439,10 +1441,11 @@ instance YesodBreadcrumbs UniWorX where breadcrumb (CTutorialR tid ssh csh tutn TDeleteR) = return ("Löschen", Just $ CTutorialR tid ssh csh tutn TUsersR) breadcrumb (CTutorialR tid ssh csh tutn TCommR) = return ("Mitteilung", Just $ CTutorialR tid ssh csh tutn TUsersR) - breadcrumb (CSheetR tid ssh csh shn SShowR) = return (CI.original shn, Just $ CourseR tid ssh csh SheetListR) - breadcrumb (CSheetR tid ssh csh shn SEditR) = return ("Bearbeiten", Just $ CSheetR tid ssh csh shn SShowR) - breadcrumb (CSheetR tid ssh csh shn SDelR ) = return ("Löschen", Just $ CSheetR tid ssh csh shn SShowR) - breadcrumb (CSheetR tid ssh csh shn SSubsR) = return ("Abgaben", Just $ CSheetR tid ssh csh shn SShowR) + breadcrumb (CSheetR tid ssh csh shn SShowR) = return (CI.original shn, Just $ CourseR tid ssh csh SheetListR) + breadcrumb (CSheetR tid ssh csh shn SEditR) = return ("Bearbeiten" , Just $ CSheetR tid ssh csh shn SShowR) + breadcrumb (CSheetR tid ssh csh shn SDelR ) = return ("Löschen" , Just $ CSheetR tid ssh csh shn SShowR) + breadcrumb (CSheetR tid ssh csh shn SSubsR) = return ("Abgaben" , Just $ CSheetR tid ssh csh shn SShowR) + breadcrumb (CSheetR tid ssh csh shn SAssignR) = return ("Zuteilen" , Just $ CSheetR tid ssh csh shn SSubsR) breadcrumb (CSheetR tid ssh csh shn SubmissionNewR) = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR) breadcrumb (CSheetR tid ssh csh shn SubmissionOwnR) = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR) breadcrumb (CSubmissionR tid ssh csh shn _ SubShowR) = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR) @@ -1607,7 +1610,7 @@ pageActions :: Route UniWorX -> [MenuItem] pageActions (HomeR) = [ MenuItem - { menuItemType = PageActionPrime + { menuItemType = PageActionPrime , menuItemLabel = MsgInfoLecturerTitle , menuItemIcon = Nothing , menuItemRoute = SomeRoute InfoLecturerR @@ -1914,6 +1917,16 @@ pageActions (CourseR tid ssh csh CShowR) = , menuItemAccessCallback' = return True } ] +pageActions (CourseR tid ssh csh CCorrectionsR) = + [ MenuItem + { menuItemType = PageActionPrime + , menuItemLabel = MsgMenuCorrectionsAssign + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute $ CourseR tid ssh csh CAssignR + , menuItemModal = True + , menuItemAccessCallback' = return True + } + ] pageActions (CourseR tid ssh csh SheetListR) = [ MenuItem { menuItemType = PageActionPrime @@ -1943,6 +1956,14 @@ pageActions (CourseR tid ssh csh SheetListR) = , menuItemModal = False , menuItemAccessCallback' = return True } + , MenuItem + { menuItemType = PageActionPrime + , menuItemLabel = MsgMenuCorrectionsAssign + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute $ CourseR tid ssh csh CAssignR + , menuItemModal = True + , menuItemAccessCallback' = return True + } , MenuItem { menuItemType = PageActionPrime , menuItemLabel = MsgMenuCorrectionsOwn @@ -2112,6 +2133,14 @@ pageActions (CSheetR tid ssh csh shn SShowR) = , menuItemModal = False , menuItemAccessCallback' = return True } + , MenuItem + { menuItemType = PageActionPrime + , menuItemLabel = MsgMenuCorrectionsAssign + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SAssignR + , menuItemModal = True + , menuItemAccessCallback' = return True + } , MenuItem { menuItemType = PageActionPrime , menuItemLabel = MsgMenuSheetEdit @@ -2139,6 +2168,14 @@ pageActions (CSheetR tid ssh csh shn SShowR) = ] pageActions (CSheetR tid ssh csh shn SSubsR) = [ MenuItem + { menuItemType = PageActionPrime + , menuItemLabel = MsgMenuSubmissionNew + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SubmissionNewR + , menuItemModal = True + , menuItemAccessCallback' = return True + } + , MenuItem { menuItemType = PageActionPrime , menuItemLabel = MsgMenuCorrectors , menuItemIcon = Nothing @@ -2146,11 +2183,11 @@ pageActions (CSheetR tid ssh csh shn SSubsR) = , menuItemModal = False , menuItemAccessCallback' = return True } - , MenuItem + , MenuItem { menuItemType = PageActionPrime - , menuItemLabel = MsgMenuSubmissionNew - , menuItemIcon = Nothing - , menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SubmissionNewR + , menuItemLabel = MsgMenuCorrectionsAssign + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SAssignR , menuItemModal = True , menuItemAccessCallback' = return True } @@ -2168,7 +2205,7 @@ pageActions (CSubmissionR tid ssh csh shn cid SubShowR) = { menuItemType = PageActionPrime , menuItemLabel = MsgCorrectorAssignTitle , menuItemIcon = Nothing - , menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid SAssignR + , menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid SubAssignR , menuItemModal = True , menuItemAccessCallback' = return True } diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index aef00e033..20182e398 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -528,7 +528,7 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do E.where_ $ submission E.^. SubmissionId E.==. E.val sId return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand, sheet E.^. SheetName) cID <- encrypt sId - let route = CSubmissionR tid ssh csh shn cID SAssignR + let route = CSubmissionR tid ssh csh shn cID SubAssignR (== Authorized) <$> evalAccessDB route True type ActionCorrections' = (ActionCorrections, AForm (HandlerT UniWorX IO) ActionCorrectionsData) @@ -555,7 +555,7 @@ assignAction selId = ( CorrSetCorrector correctors' <- forM correctors $ \Entity{ entityKey, entityVal = User{..} } -> (SomeMessage userDisplayName, ) <$> encrypt entityKey - cId <- wopt (selectFieldList correctors' :: Field (HandlerT UniWorX IO) CryptoUUIDUser) (fslI MsgCorrector) Nothing + cId <- wopt (selectFieldList correctors' :: Field (HandlerT UniWorX IO) CryptoUUIDUser) (fslI MsgCorrector & setTooltip MsgCorrSetCorrectorTooltip) Nothing fmap CorrSetCorrectorData <$> (traverse.traverse) decrypt cId ) @@ -1015,38 +1015,73 @@ postCorrectionsGradeR = do $(widgetFile "corrections-grade") -getSAssignR, postSAssignR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html +data ButtonSubmissionsAssign = BtnSubmissionsAssign + deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable) +instance Universe ButtonSubmissionsAssign +instance Finite ButtonSubmissionsAssign +nullaryPathPiece ''ButtonSubmissionsAssign camelToPathPiece +embedRenderMessage ''UniWorX ''ButtonSubmissionsAssign id +instance Button UniWorX ButtonSubmissionsAssign where + btnClasses BtnSubmissionsAssign = [BCIsButton, BCPrimary] + +-- | Gather info about corrector assignment per sheet +data SubAssignInfo = SubAssignInfo { saiName :: SheetName, saiSubmissionNr, saiCorrectorNr, saiUnassignedNr :: Int } + +getCAssignR, postCAssignR :: TermId -> SchoolId -> CourseShorthand -> Handler Html +getCAssignR = postCAssignR +postCAssignR tid ssh csh = do + shids <- runDB $ do + cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh + selectKeysList [SheetCourse ==. cid] [Asc SheetActiveTo] + assignHandler tid ssh csh shids + +getSAssignR, postSAssignR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html getSAssignR = postSAssignR -postSAssignR tid ssh csh shn cID = do - let actionUrl = CSubmissionR tid ssh csh shn cID SAssignR - sId <- decrypt cID - (currentCorrector, sheetCorrectors) <- runDB $ do - Submission{submissionRatingBy, submissionSheet} <- get404 sId - sheetCorrectors <- map (sheetCorrectorUser . entityVal) <$> selectList [SheetCorrectorSheet ==. submissionSheet] [] - userCorrector <- traverse getJustEntity submissionRatingBy - return (userCorrector, maybe id (:) submissionRatingBy sheetCorrectors) - - $logDebugS "SAssignR" $ tshow currentCorrector - let correctorField = selectField $ optionsPersistCryptoId [UserId <-. sheetCorrectors] [Asc UserSurname, Asc UserDisplayName] userDisplayName - ((corrResult, corrForm'), corrEncoding) <- runFormPost . renderAForm FormStandard $ - aopt correctorField (fslI MsgCorrector) (Just currentCorrector) - formResult corrResult $ \(fmap entityKey -> mbUserId) -> do - when (mbUserId /= fmap entityKey currentCorrector) . runDB $ do - now <- liftIO getCurrentTime - update sId [ SubmissionRatingBy =. mbUserId - , SubmissionRatingAssigned =. (now <$ mbUserId) - ] - addMessageI Success MsgCorrectorUpdated - redirect actionUrl - let corrForm = wrapForm' BtnSave corrForm' def - { formAction = Just $ SomeRoute actionUrl - , formEncoding = corrEncoding - , formSubmit = FormDualSubmit - } - defaultLayout $ do - setTitleI MsgCorrectorAssignTitle - $(widgetFile "submission-assign") - - +postSAssignR tid ssh csh shn = do + shid <- runDB $ fetchSheetId tid ssh csh shn + assignHandler tid ssh csh [shid] +assignHandler :: TermId -> SchoolId -> CourseShorthand -> [SheetId] -> Handler Html +assignHandler tid ssh csh rawSids = do + -- gather data + openSubs <- runDB $ (\f -> foldM f Map.empty rawSids) $ + \acc sid -> maybeT (return acc) $ do + Just Sheet{sheetName=saiName} <- lift $ get sid + guardM $ lift $ hasWriteAccessTo $ CSheetR tid ssh csh saiName SAssignR -- we must check, whether the submission is already closed and thus assignable + saiUnassignedNr <- lift $ count [SubmissionSheet ==. sid, SubmissionRatingBy ==. Nothing] + guard $ 0 < saiUnassignedNr -- only consider sheets with unassigned submissions + saiSubmissionNr <- lift $ count [SubmissionSheet ==. sid] + saiCorrectorNr <- lift $ count [SheetCorrectorSheet ==. sid, SheetCorrectorState ==. CorrectorNormal] + -- guard $ saiCorrectorNr > 0 -- COMMENTED OUT BECAUSE we should show sheets without possible correctors to inform the user about these problematic sheets + return $ Map.insert sid SubAssignInfo{..} acc + let sids = Map.keys openSubs + linkBack <- simpleLinkI (SomeMessage MsgGenericBack) <$> case sids of + [sid] -> do Sheet{sheetName} <- runDB $ getJust sid + return $ CSheetR tid ssh csh sheetName SSubsR + _ -> return $ CourseR tid ssh csh CCorrectionsR + -- process form + currentRoute <- getCurrentRoute + ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm FIDAssignSubmissions buttonForm + assignmentStatus <- case btnResult of + FormSuccess BtnSubmissionsAssign -> do -- Button was pressed, assign and report + -- Assign submissions + runDB $ (\f -> foldM f Map.empty sids) $ + \acc sid -> flip (Map.insert sid) acc <$> assignSubmissions sid Nothing + -- Too much important information for an alert. Display proper info page instead + other -> do + formFailure2Alerts other -- show possible allerts + return Map.empty -- no assignments performed + let btnForm = wrapForm btnWdgt def + { formAction = SomeRoute <$> currentRoute + , formEncoding = btnEnctype + , formSubmit = FormNoSubmit + } + headingShort = MsgMenuCorrectionsAssign + headingLong = prependCourseTitle tid ssh csh MsgMenuCorrectionsAssign + siteLayoutMsg headingShort $ do + setTitleI headingLong + $(widgetFile "corrections-assign") + if null sids || not (null assignmentStatus) + then linkBack -- TODO: convenience link might be unnecessary: either via breadcrumb or closing model. Remove, if modal works fine. Otherwise change to PrimaryAction? + else btnForm diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 12c605917..0fe085dc1 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -364,7 +364,7 @@ submissionHelper tid ssh csh shn mcid = do return (csheet,buddies,lastEdits,maySubmit,isLecturer,isOwner) -- @submissionModeUser == Nothing@ below iff we are currently serving a user with elevated rights (lecturer, admin, ...) -- Therefore we do not restrict upload behaviour in any way in that case - ((res,formWidget'), formEnctype) <- runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (UploadAny True Nothing) . submissionModeUser $ sheetSubmissionMode) sheetGrouping isLecturer $ bool id (Set.insert $ Right uid) isOwner buddies + ((res,formWidget'), formEnctype) <- runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (UploadAny True Nothing) . submissionModeUser $ sheetSubmissionMode) sheetGrouping isLecturer $ bool id (Set.insert $ Right uid) isOwner buddies let formWidget = wrapForm' BtnHandIn formWidget' def { formAction = Just $ SomeRoute actionUrl , formEncoding = formEnctype @@ -611,3 +611,36 @@ getCorrectionsDownloadR = do -- download all assigned and open submissions addMessageI Info MsgNoOpenSubmissions redirect CorrectionsR submissionMultiArchive $ Set.fromList subs + + +getSubAssignR, postSubAssignR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html +getSubAssignR = postSubAssignR +postSubAssignR tid ssh csh shn cID = do + let actionUrl = CSubmissionR tid ssh csh shn cID SubAssignR + sId <- decrypt cID + (currentCorrector, sheetCorrectors) <- runDB $ do + Submission{submissionRatingBy, submissionSheet} <- get404 sId + sheetCorrectors <- map (sheetCorrectorUser . entityVal) <$> selectList [SheetCorrectorSheet ==. submissionSheet] [] + userCorrector <- traverse getJustEntity submissionRatingBy + return (userCorrector, maybe id (:) submissionRatingBy sheetCorrectors) + + $logDebugS "SubAssignR" $ tshow currentCorrector + let correctorField = selectField $ optionsPersistCryptoId [UserId <-. sheetCorrectors] [Asc UserSurname, Asc UserDisplayName] userDisplayName + ((corrResult, corrForm'), corrEncoding) <- runFormPost . renderAForm FormStandard $ + aopt correctorField (fslI MsgCorrector) (Just currentCorrector) + formResult corrResult $ \(fmap entityKey -> mbUserId) -> do + when (mbUserId /= fmap entityKey currentCorrector) . runDB $ do + now <- liftIO getCurrentTime + update sId [ SubmissionRatingBy =. mbUserId + , SubmissionRatingAssigned =. (now <$ mbUserId) + ] + addMessageI Success MsgCorrectorUpdated + redirect actionUrl + let corrForm = wrapForm' BtnSave corrForm' def + { formAction = Just $ SomeRoute actionUrl + , formEncoding = corrEncoding + , formSubmit = FormSubmit + } + defaultLayout $ do + setTitleI MsgCorrectorAssignTitle + $(widgetFile "submission-assign") diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index 7356e17b0..84a747cf5 100644 --- a/src/Handler/Utils/Submission.hs +++ b/src/Handler/Utils/Submission.hs @@ -53,7 +53,6 @@ import Text.Hamlet (ihamletFile) import qualified Control.Monad.Catch as E (Handler(..)) - data AssignSubmissionException = NoCorrectors | NoCorrectorsByProportion | SubmissionsNotFound (NonNull (Set SubmissionId)) diff --git a/src/Utils.hs b/src/Utils.hs index 376817556..b9239d9e3 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -355,7 +355,14 @@ floorToDigits :: (RealFrac a, Integral b) => b -> a -> a floorToDigits d x = fromInteger (floor $ x * prec) / prec where prec = 10^d +-- | Integral division, but rounded upwards. +ceilingDiv :: Integral a => a -> a -> a +ceilingDiv d n = (d+n-1) `div` n +-- | Integral division, rounded to custom digit; convenience function for hamlets +roundDiv :: (Integral a, Integral b, RealFrac c) => Int -> a -> b -> c +roundDiv digits numerator denominator + = roundToDigits digits $ fromIntegral numerator / fromIntegral denominator ------------ -- Monoid -- diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index 629e82de8..2e5f22004 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -189,6 +189,7 @@ data FormIdentifier | FIDAdminDemo | FIDUserDelete | FIDCommunication + | FIDAssignSubmissions deriving (Eq, Ord, Read, Show) instance PathPiece FormIdentifier where @@ -606,6 +607,10 @@ formFailure errs' = do mr <- getMessageRender return . FormFailure $ map mr errs' +-- | Turn form errors into alerts, but otherwise do nothing at all +formFailure2Alerts :: MonadHandler m => FormResult a -> m () +formFailure2Alerts = flip formResult $ const $ return () + -- | Turns errors into alerts, ignores missing forms and applies processing function formResult :: MonadHandler m => FormResult a -> (a -> m ()) -> m () formResult res f = void . formResultMaybe res $ \x -> Nothing <$ f x @@ -668,7 +673,7 @@ aFormToWForm = mapRWST mFormToWForm' . over (mapped . _2) ($ []) . aFormToForm writer ((a, ints, enctype), vs) infixl 4 `fmapAForm` - + fmapAForm :: Functor m => (FormResult a -> FormResult b) -> (AForm m a -> AForm m b) fmapAForm f (AForm act) = AForm $ \app env ints -> over _1 f <$> act app env ints diff --git a/templates/corrections-assign.hamlet b/templates/corrections-assign.hamlet new file mode 100644 index 000000000..56bbbeeb5 --- /dev/null +++ b/templates/corrections-assign.hamlet @@ -0,0 +1,52 @@ +$# Display a table showing the result of the corrector assignment for possibly several sheets +$# Expected variables" +$# sids :: list of SheetId +$# openSubs :: Map from SheetId to SubAssignInfo, a datatype collecting info about open submissions +$# assignmentStatus :: Map from SheetId to (Set SubmissionId, Set SubmisionId), i.e. assigned submissions and unassigned submissions for that sheet +$if null sids +

+ _{MsgSheetNoOldUnassigned} +$else +

+ + + +
+ _{MsgSheet} + + _{MsgNrSubmissionsTotal} + + _{MsgNrSubmissionsUnassigned} + + _{MsgNrCorrectors} + $# Header-Styling indicates, whether assignment was attempted or not. + $with hasAssignment <- not (Map.null assignmentStatus) + + _{MsgNrSubmissionsNewlyAssigned} + + _{MsgNrSubmissionsNotAssigned} + + $forall sid <- sids + $case Map.lookup sid openSubs + $of Nothing + + $of Just SubAssignInfo{saiName, saiSubmissionNr, saiUnassignedNr, saiCorrectorNr} +
+ #{saiName} + + #{show saiSubmissionNr} + + #{show saiUnassignedNr} + + #{show saiCorrectorNr} + $case Map.lookup sid assignmentStatus + $of Nothing + + + + + $of Just (assigned,unassigned) + + #{show (Set.size assigned)} + + #{show (Set.size unassigned)}