Gregor Kleen
parent
bfad72f734
commit
f74581c356
@ -378,6 +378,10 @@ CorrectionsTitle: Zugewiesene Korrekturen
|
||||
CourseCorrectionsTitle: Korrekturen für diesen Kurs
|
||||
CorrectorsHead sheetName@SheetName: Korrektoren für #{sheetName}
|
||||
CorrectorAssignTitle: Korrektor zuweisen
|
||||
SubmissionCorrector: Korrektor
|
||||
SubmissionCorrectorTip: Der hier eingetragene Korrektor erhält vollen Zugriff auf diese Korrektur, kann sie also auch nachträglich noch verändern.
|
||||
SubmissionNoCorrector: Kein Korrektor
|
||||
SubmissionCannotBeRatedWithoutCorrector: Die Korrektur kann nur abgeschlossen werden, wenn auch ein Korrektor angegeben wird
|
||||
|
||||
CorrectionsGrade: Korrekturen eintragen
|
||||
|
||||
@ -655,6 +659,7 @@ RatingDone: Bewertung abgeschlossen
|
||||
RatingDoneTip: Das Korrekturergebnis ist nur dann für die Abgebenden sichtbar und kann gegen etwaige Klausur-Bonuspunkte verrechnet werden, wenn die Bewertung abgeschlossen ist.
|
||||
RatingPercent: Erreicht
|
||||
RatingFiles: Korrigierte Dateien
|
||||
RatingFilesTip: Hier hochgeladene Dateien ersetzen ggf. die bestehende korrigierte Version der Abgabe vollständig (nicht erneut hochgeladene Dateien werden gelöscht). Die original abgegebene Version bleibt erhalten.
|
||||
PointsNotPositive: Punktzahl darf nicht negativ sein
|
||||
PointsTooHigh maxPoints@Points: Punktzahl darf nicht höher als #{maxPoints} sein
|
||||
PointsTooLow minPoints@Points: Punktzahl darf nicht kleiner als #{minPoints} sein
|
||||
@ -674,6 +679,7 @@ CorrectionAchievedPoints: Erzielte Punkte
|
||||
CorrectionAchievedPass: Bestanden
|
||||
FileCorrected: Korrigiert (Dateien)
|
||||
FileCorrectedDeleted: Korrigiert (gelöscht)
|
||||
RatingDraftUpdated: Korrekturentwurf gespeichert
|
||||
RatingUpdated: Korrektur gespeichert
|
||||
RatingDeleted: Korrektur zurückgesetzt
|
||||
RatingFilesUpdated: Korrigierte Dateien überschrieben
|
||||
|
||||
@ -377,6 +377,10 @@ CorrectionsTitle: Assigned corrections
|
||||
CourseCorrectionsTitle: Corrections for this course
|
||||
CorrectorsHead sheetName: Correctors for #{sheetName}
|
||||
CorrectorAssignTitle: Assign corrector
|
||||
SubmissionCorrector: Corrector
|
||||
SubmissionCorrectorTip: The corrector you configure here will have full access to this correction including the right to update it in the future.
|
||||
SubmissionNoCorrector: No corrector
|
||||
SubmissionCannotBeRatedWithoutCorrector: The rating can only be marked as finished if a corrector is also configured
|
||||
|
||||
CorrectionsGrade: Grade submissions
|
||||
|
||||
@ -653,6 +657,7 @@ RatingDone: Rating finished
|
||||
RatingDoneTip: The rating is only visible to the submittors and considered for any exam bonuses if it is finished.
|
||||
RatingPercent: Achieved
|
||||
RatingFiles: Marked files
|
||||
RatingFilesTip: Files uploaded here completely replace any existing corrected versions (i.e. files not uploaded again are deleted). The original version as submitted will remain untouched.
|
||||
PointsNotPositive: Points may not be negative
|
||||
PointsTooHigh maxPoints: Points may not be more than #{maxPoints}
|
||||
PointsTooLow minPoints: Points may not be less than #{minPoints}
|
||||
@ -671,6 +676,7 @@ CorrectionAchievedPoints: Achieved points
|
||||
CorrectionAchievedPass: Passed
|
||||
FileCorrected: Marked (files)
|
||||
FileCorrectedDeleted: Marked (deleted)
|
||||
RatingDraftUpdated: Successfully saved correction draft
|
||||
RatingUpdated: Successfully updated correction
|
||||
RatingDeleted: Successfully reset correction
|
||||
RatingFilesUpdated: Corrected files successfully overwritten
|
||||
|
||||
@ -34,6 +34,8 @@ import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import qualified Control.Monad.State.Class as State
|
||||
|
||||
-- import Data.Time
|
||||
-- import Data.Function ((&))
|
||||
--
|
||||
@ -59,8 +61,6 @@ import Database.Persist.Sql (updateWhereCount)
|
||||
|
||||
import Data.List (genericLength)
|
||||
|
||||
import qualified Control.Monad.State.Class as State
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
|
||||
@ -791,11 +791,13 @@ getCorrectionR tid ssh csh shn cid = do
|
||||
postCorrectionR tid ssh csh shn cid = do
|
||||
sub <- decrypt cid
|
||||
|
||||
results <- runDB $ correctionData tid ssh csh shn sub
|
||||
(results, isLecturer) <- runDB $ (,)
|
||||
<$> correctionData tid ssh csh shn sub
|
||||
<*> hasWriteAccessTo (CSheetR tid ssh csh shn SSubsR)
|
||||
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
case results of
|
||||
[(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ subm@Submission{..}, corrector)] -> do
|
||||
[(Entity cId Course{..}, Entity shId Sheet{..}, Entity _ subm@Submission{..}, corrector)] -> do
|
||||
let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c))
|
||||
pointsForm = case sheetType of
|
||||
NotGraded
|
||||
@ -808,59 +810,76 @@ postCorrectionR tid ssh csh shn cid = do
|
||||
-> aopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType)
|
||||
(fslpI MsgRatingPoints (mr MsgPointsPlaceholder) & setTooltip sheetType)
|
||||
(Just submissionRatingPoints)
|
||||
correctorForm
|
||||
| not isLecturer = wFormToAForm $ pure . Just <$> requireAuthId
|
||||
| otherwise = wFormToAForm $ do
|
||||
let correctors = E.from $ \user -> do
|
||||
let isCorrector = E.exists . E.from $ \sheetCorrector ->
|
||||
E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. user E.^. UserId
|
||||
E.&&. sheetCorrector E.^. SheetCorrectorSheet E.==. E.val shId
|
||||
isLecturer' = E.exists . E.from $ \lecturer ->
|
||||
E.where_ $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||
E.&&. lecturer E.^. LecturerCourse E.==. E.val cId
|
||||
E.where_ $ isCorrector E.||. isLecturer'
|
||||
return user
|
||||
wopt (selectField' (Just $ SomeMessage MsgSubmissionNoCorrector) $ userOptionsE correctors) (fslI MsgSubmissionCorrector & setTooltip MsgSubmissionCorrectorTip) (Just submissionRatingBy)
|
||||
validateCorr = do
|
||||
(now, ratingBy', rated, ratingPoints', ratingComment') <- State.get
|
||||
mapM_ tellValidationError $ validateRating sheetType Rating'
|
||||
{ ratingPoints = ratingPoints'
|
||||
, ratingComment = ratingComment'
|
||||
, ratingTime = guardOn rated now
|
||||
}
|
||||
guardValidation MsgSubmissionCannotBeRatedWithoutCorrector $ isn't _Nothing ratingBy' || not rated
|
||||
|
||||
((corrResult, corrForm'), corrEncoding) <- runFormPost . identifyForm FIDcorrection . renderAForm FormStandard $ (,,)
|
||||
<$> areq checkBoxField (fslI MsgRatingDone & setTooltip MsgRatingDoneTip) (Just $ submissionRatingDone Submission{..})
|
||||
((corrResult, corrForm'), corrEncoding) <- runFormPost . validateForm validateCorr . identifyForm FIDcorrection . renderAForm FormStandard $ (,,,,)
|
||||
<$> wFormToAForm (pure <$> liftIO getCurrentTime)
|
||||
<*> correctorForm
|
||||
<*> apopt checkBoxField (fslI MsgRatingDone & setTooltip MsgRatingDoneTip) (Just $ submissionRatingDone Submission{..})
|
||||
<*> pointsForm
|
||||
<*> (((\t -> t <$ guard (not $ null t)) =<<) . fmap (Text.strip . unTextarea) <$> aopt textareaField (fslI MsgRatingComment) (Just $ Textarea <$> submissionRatingComment))
|
||||
<*> aopt (textareaField & isoField _Wrapped & cfStrip) (fslI MsgRatingComment) (Just submissionRatingComment)
|
||||
let corrForm = wrapForm' BtnSave corrForm' def
|
||||
{ formAction = Just . SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
|
||||
, formEncoding = corrEncoding
|
||||
}
|
||||
|
||||
((uploadResult, uploadForm'), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionUpload . renderAForm FormStandard $
|
||||
areq (zipFileField True Nothing) (fslI MsgRatingFiles) Nothing
|
||||
apopt (zipFileField True Nothing) (fslI MsgRatingFiles & setTooltip MsgRatingFilesTip) Nothing
|
||||
let uploadForm = wrapForm uploadForm' def
|
||||
{ formAction = Just . SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
|
||||
, formEncoding = uploadEncoding
|
||||
}
|
||||
|
||||
formResult corrResult $ \(rated, ratingPoints', ratingComment') -> do
|
||||
uid <- liftHandler requireAuthId
|
||||
now <- liftIO getCurrentTime
|
||||
formResult corrResult $ \(now, ratingBy', rated, ratingPoints', ratingComment') -> do
|
||||
runDBJobs $ do
|
||||
update sub [ SubmissionRatingBy =. ratingBy'
|
||||
, SubmissionRatingTime =. (now <$ guard rated)
|
||||
, SubmissionRatingPoints =. ratingPoints'
|
||||
, SubmissionRatingComment =. ratingComment'
|
||||
]
|
||||
|
||||
if
|
||||
| errs <- validateRating sheetType Rating'
|
||||
{ ratingPoints = ratingPoints'
|
||||
, ratingComment = ratingComment'
|
||||
, ratingTime = (now <$ guard rated)
|
||||
}
|
||||
, not $ null errs
|
||||
-> mapM_ (addMessageI Error) errs
|
||||
| otherwise -> do
|
||||
runDBJobs $ do
|
||||
update sub [ SubmissionRatingBy =. Just uid
|
||||
, SubmissionRatingTime =. (now <$ guard rated)
|
||||
, SubmissionRatingPoints =. ratingPoints'
|
||||
, SubmissionRatingComment =. ratingComment'
|
||||
]
|
||||
when (rated && is _Nothing submissionRatingTime) $ do
|
||||
$logDebugS "CorrectionR" [st|Rated #{tshow sub}|]
|
||||
queueDBJob . JobQueueNotification $ NotificationSubmissionRated sub
|
||||
|
||||
addMessageI Success $ bool MsgRatingDeleted MsgRatingUpdated rated
|
||||
|
||||
when (rated && isNothing submissionRatingTime) $ do
|
||||
$logDebugS "CorrectionR" [st|Rated #{tshow sub}|]
|
||||
queueDBJob . JobQueueNotification $ NotificationSubmissionRated sub
|
||||
redirect $ CSubmissionR tid ssh csh shn cid CorrectionR
|
||||
addMessageI Success $ if
|
||||
| rated -> MsgRatingUpdated
|
||||
| is _Nothing ratingComment'
|
||||
, is _Nothing ratingPoints'
|
||||
, is _Nothing ratingBy' -> MsgRatingDeleted
|
||||
| is _Nothing ratingComment'
|
||||
, is _Nothing ratingPoints' -> MsgCorrectorUpdated
|
||||
| otherwise -> MsgRatingDraftUpdated
|
||||
redirect $ CSubmissionR tid ssh csh shn cid CorrectionR
|
||||
|
||||
formResult uploadResult $ \fileUploads -> do
|
||||
uid <- maybeAuthId
|
||||
|
||||
res <- msgSubmissionErrors . runDBJobs . runConduit $ transPipe (lift . lift) fileUploads .| C.mapM (either get404 return) .| extractRatingsMsg .| sinkSubmission uid (Right sub) True
|
||||
case res of
|
||||
Nothing -> return () -- ErrorMessages are already added by msgSubmissionErrors
|
||||
(Just _) -> do
|
||||
addMessageI Success MsgRatingFilesUpdated
|
||||
redirect $ CSubmissionR tid ssh csh shn cid CorrectionR
|
||||
|
||||
when (is _Just res) $ do
|
||||
addMessageI Success MsgRatingFilesUpdated
|
||||
redirect $ CSubmissionR tid ssh csh shn cid CorrectionR
|
||||
|
||||
let heading = MsgCorrectionHead tid ssh csh shn cid
|
||||
headingWgt = [whamlet|
|
||||
|
||||
@ -1919,3 +1919,8 @@ makeWrapped ''CourseParticipantStateIsActive
|
||||
|
||||
courseParticipantStateIsActiveField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Maybe (SomeMessage UniWorX) -> Field m Bool
|
||||
courseParticipantStateIsActiveField optMsg = hoistField liftHandler . isoField (_Wrapped @CourseParticipantStateIsActive) $ radioGroupField optMsg optionsFinite
|
||||
|
||||
|
||||
userOptionsE :: E.SqlQuery (E.SqlExpr (Entity User))
|
||||
-> Handler (OptionList UserId)
|
||||
userOptionsE = fmap (fmap entityKey) . flip optionsCryptoIdE userDisplayName
|
||||
|
||||
@ -64,6 +64,7 @@ _Maybe = iso (is _Just) (bool Nothing (Just ()))
|
||||
_CI :: FoldCase s => Iso' (CI s) s
|
||||
_CI = iso CI.original CI.mk
|
||||
|
||||
makeWrapped ''Textarea
|
||||
|
||||
-----------------------------------
|
||||
-- Lens Definitions for our Types
|
||||
|
||||
Loading…
Reference in New Issue
Block a user