feat(eecorrectr): basic handler structure (WIP)
This commit is contained in:
Sarah Vaupel
parent
be2eb3c38d
commit
de02895ed0
@ -1435,6 +1435,7 @@ BreadcrumbAdminCrontab: Crontab
|
||||
|
||||
ExternalExamEdit coursen@CourseName examn@ExamName: Bearbeiten: #{coursen}, #{examn}
|
||||
ExternalExamGrades coursen@CourseName examn@ExamName: Prüfungsleistungen: #{coursen}, #{examn}
|
||||
ExternalExamCorrectHeading coursen@CourseName examn@ExamName: Prüfungsleistungen für #{coursen}, #{examn} eintragen
|
||||
ExternalExamUsers coursen@CourseName examn@ExamName: Teilnehmer: #{coursen}, #{examn}
|
||||
|
||||
TitleMetrics: Metriken
|
||||
|
||||
@ -1435,6 +1435,7 @@ BreadcrumbAdminCrontab: Crontab
|
||||
|
||||
ExternalExamEdit coursen examn: Edit: #{coursen}, #{examn}
|
||||
ExternalExamGrades coursen examn: Exam achievements: #{coursen}, #{examn}
|
||||
ExternalExamCorrectHeading coursen examn: Enter exam results for #{coursen}, #{examn}
|
||||
ExternalExamUsers coursen examn: Exam participants: #{coursen}, #{examn}
|
||||
|
||||
TitleMetrics: Metrics
|
||||
|
||||
@ -4,10 +4,157 @@ module Handler.ExternalExam.Correct
|
||||
|
||||
import Import
|
||||
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
import Database.Persist.Sql (transactionUndo)
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Utils.ExternalExam
|
||||
|
||||
import Utils.Exam
|
||||
|
||||
|
||||
getEECorrectR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
|
||||
getEECorrectR _tid _ssh _coursen _examn = error "getEECorrectR WIP"
|
||||
getEECorrectR tid ssh coursen examn = do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
|
||||
Entity _eeId ExternalExam{..} <- runDB $ fetchExternalExam tid ssh coursen examn
|
||||
|
||||
mayEditResults <- hasWriteAccessTo $ EExamR tid ssh coursen examn EEUsersR
|
||||
|
||||
let
|
||||
heading = mr $ MsgExternalExamCorrectHeading coursen examn
|
||||
|
||||
ptsInput :: ExamPartNumber -> Widget
|
||||
ptsInput = const mempty
|
||||
|
||||
examParts :: [ExamPart]
|
||||
examParts = []
|
||||
|
||||
examGrades :: [ExamGrade]
|
||||
examGrades = universeF
|
||||
|
||||
examGradingMode = externalExamGradingMode
|
||||
|
||||
examCorrectIdent :: Text
|
||||
examCorrectIdent = "TODO" -- TODO fix below
|
||||
|
||||
-- examCorrectIdent <- encrypt eeId :: Handler (CryptoID UUID ExternalExamId)
|
||||
|
||||
siteLayoutMsg heading $ do
|
||||
setTitleI heading
|
||||
let
|
||||
examCorrectExplanation = $(i18nWidgetFile "external-exam-correct-explanation")
|
||||
$(widgetFile "exam-correct")
|
||||
|
||||
|
||||
postEECorrectR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Void
|
||||
postEECorrectR _tid _ssh _coursen _examn = error "postEECorrectR WIP"
|
||||
postEECorrectR tid ssh coursen examn = do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
|
||||
CorrectInterfaceRequest{..} <- requireCheckJsonBody
|
||||
|
||||
mayEditResults <- hasWriteAccessTo $ EExamR tid ssh coursen examn EEUsersR
|
||||
|
||||
response <- runDB . exceptT (<$ transactionUndo) return $ do
|
||||
Entity eeId ExternalExam{..} <- lift $ fetchExternalExam tid ssh coursen examn
|
||||
euid <- traverse decrypt ciqUser
|
||||
|
||||
guardMExceptT (maybe True ((>= 3) . length) $ euid ^? _Left) $ -- TODO rethink max needle length
|
||||
CorrectInterfaceResponseFailure Nothing <$> (getMessageRender <*> pure MsgExamCorrectErrorNeedleTooShort)
|
||||
|
||||
matches <- lift . E.select . E.from $ \user -> do
|
||||
let mUserIdent = euid ^? _Left
|
||||
E.where_ $ either (const E.false) (\uid -> user E.^. UserId E.==. E.val uid) euid
|
||||
E.||. (case mUserIdent of
|
||||
Just userIdent ->
|
||||
user E.^. UserSurname E.==. E.val userIdent
|
||||
E.||. user E.^. UserSurname `E.hasInfix` E.val userIdent
|
||||
E.||. user E.^. UserFirstName E.==. E.val userIdent
|
||||
E.||. user E.^. UserFirstName `E.hasInfix` E.val userIdent
|
||||
E.||. user E.^. UserDisplayName E.==. E.val userIdent
|
||||
E.||. user E.^. UserDisplayName `E.hasInfix` E.val userIdent
|
||||
E.||. user E.^. UserMatrikelnummer E.==. E.val mUserIdent
|
||||
E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val mUserIdent
|
||||
Nothing -> E.false)
|
||||
return user
|
||||
|
||||
let
|
||||
userToResponse (Entity uid User{..}) = do -- TODO move to util
|
||||
uuid <- encrypt uid
|
||||
return CorrectInterfaceUser
|
||||
{ ciuSurname = userSurname
|
||||
, ciuDisplayName = userDisplayName
|
||||
, ciuMatNr = userMatrikelnummer
|
||||
, ciuId = uuid
|
||||
}
|
||||
|
||||
if
|
||||
| is _Nothing ciqResults, is _Nothing ciqGrade -> do
|
||||
users <- traverse userToResponse matches
|
||||
return CorrectInterfaceResponseNoOp
|
||||
{ cirnUsers = Set.fromList users
|
||||
}
|
||||
| [match@(Entity uid _)] <- matches -> do
|
||||
now <- liftIO getCurrentTime
|
||||
newExamResult <- for ciqGrade $ \ciqGrade' -> lift $ do
|
||||
unless mayEditResults $
|
||||
permissionDeniedI MsgUnauthorizedExamCorrectorGrade
|
||||
mOldResult <- getBy $ UniqueExternalExamResult eeId uid
|
||||
if
|
||||
| Just (Entity oldId _) <- mOldResult, is _Nothing ciqGrade' -> do
|
||||
delete oldId
|
||||
audit $ TransactionExternalExamResultDelete eeId uid
|
||||
return Nothing
|
||||
| Just resultGrade <- ciqGrade' -> let
|
||||
mOld = externalExamResultResult . entityVal <$> mOldResult
|
||||
in if
|
||||
| ciqGrade' /= mOld -> do
|
||||
newResult <- upsert ExternalExamResult
|
||||
{ externalExamResultExam = eeId
|
||||
, externalExamResultUser = uid
|
||||
, externalExamResultResult = resultGrade
|
||||
, externalExamResultTime = now -- TODO add and use utcTimeField
|
||||
, externalExamResultLastChanged = now
|
||||
}
|
||||
[ ExternalExamResultResult =. resultGrade
|
||||
, ExternalExamResultTime =. now -- TODO add and use utcTimeField
|
||||
, ExternalExamResultLastChanged =. now
|
||||
]
|
||||
audit $ TransactionExternalExamResultEdit eeId uid
|
||||
return $ newResult ^? _entityVal . _externalExamResultResult
|
||||
| otherwise -> return $ mOldResult ^? _Just . _entityVal . _externalExamResultResult
|
||||
| otherwise -> return Nothing
|
||||
|
||||
user <- userToResponse match
|
||||
return CorrectInterfaceResponseSuccess
|
||||
{ cirsUser = user
|
||||
, cirsResults = mempty
|
||||
, cirsGrade = newExamResult
|
||||
, cirsTime = now
|
||||
}
|
||||
|
||||
| [] <- matches -> return CorrectInterfaceResponseFailure
|
||||
{ cirfUser = Nothing
|
||||
, cirfMessage = mr MsgExamCorrectErrorNoMatchingParticipants -- TODO use new msg
|
||||
}
|
||||
|
||||
| otherwise -> do
|
||||
users <- traverse userToResponse matches
|
||||
return CorrectInterfaceResponseAmbiguous
|
||||
{ ciraUsers = Set.fromList users
|
||||
, ciraMessage = mr MsgExamCorrectErrorMultipleMatchingParticipants -- TODO use new msg
|
||||
}
|
||||
|
||||
let
|
||||
responseStatus = case response of
|
||||
CorrectInterfaceResponseSuccess{} -> ok200
|
||||
CorrectInterfaceResponseNoOp{} -> ok200
|
||||
_ -> badRequest400
|
||||
|
||||
whenM acceptsJson $
|
||||
sendResponseStatus responseStatus $ toJSON response
|
||||
|
||||
redirect $ EExamR tid ssh coursen examn EEShowR
|
||||
|
||||
15
src/Handler/Utils/ExternalExam.hs
Normal file
15
src/Handler/Utils/ExternalExam.hs
Normal file
@ -0,0 +1,15 @@
|
||||
module Handler.Utils.ExternalExam
|
||||
( fetchExternalExam
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
|
||||
fetchExternalExam :: MonadHandler m => TermId -> SchoolId -> CourseName -> ExamName -> ReaderT SqlBackend m (Entity ExternalExam)
|
||||
fetchExternalExam tid ssh coursen examn =
|
||||
let cachId = encodeUtf8 $ tshow (tid, ssh, coursen, examn)
|
||||
in cachedBy cachId $ do
|
||||
mExtEx <- getBy $ UniqueExternalExam tid ssh coursen examn
|
||||
case mExtEx of
|
||||
Just extEx -> return extEx
|
||||
_ -> notFound
|
||||
@ -0,0 +1,30 @@
|
||||
$newline never
|
||||
<p>
|
||||
Um eine Prüfungsleistung einzutragen können Sie in der #
|
||||
Teilnehmer-Spalte einen beliebigen eindeutigen Identifikator des #
|
||||
Teilnehmers angeben.<br />
|
||||
|
||||
Es können nur Ergebnisse für Studierende eingetragen werden, die #
|
||||
bereits Prüfungsteilnehmer sind. #
|
||||
Über diese Oberfläche können keine neuen Benutzer zur Klausur #
|
||||
angemeldet werden.<br />
|
||||
|
||||
Vermutlich eindeutig ist die Matrikelnummer des Teilnehmers, aber #
|
||||
auch der Name oder ein Teil der Matrikelnummer können unter #
|
||||
Umständen bereits eindeutig sein.<br />
|
||||
|
||||
Wenn Felder für Ergebnisse frei gelassen werden, wird an dieser #
|
||||
Stelle nichts in die Datenbank eingetragen.<br />
|
||||
|
||||
Beim Senden von Ergebnissen wird der bisherige Stand in der #
|
||||
Datenbank überschrieben. #
|
||||
Es werden auch Ergebnisse überschrieben, die andere Benutzer #
|
||||
eingetragen haben.<br />
|
||||
|
||||
Bereits eingetragene Ergebnisse können auch gelöscht werden; es ist #
|
||||
danach für den jeweiligen Teil der Prüfung kein Ergebnis mehr in der #
|
||||
Datenbank hinterlegt.<br />
|
||||
|
||||
Falls eine automatische Notenberechnung konfiguriert ist, müssen die #
|
||||
berechneten Ergebnisse noch auf der Seite der Klausurteilnehmerliste #
|
||||
akzeptiert werden.
|
||||
@ -0,0 +1,27 @@
|
||||
$newline never
|
||||
<p>
|
||||
To enter a participant's exam achievement you can submit any string #
|
||||
that uniquely identifies the participant.<br />
|
||||
|
||||
Results can only be entered for users who are already exam #
|
||||
participants. #
|
||||
No new participants can be added to the exam using this interface. #
|
||||
|
||||
Matriculation numbers are likely unique. #
|
||||
The participant's name or a part of their matriculation number may #
|
||||
also be sufficiently unique.<br />
|
||||
|
||||
If any fields are left blank no result is saved for that part of the #
|
||||
exam.<br />
|
||||
|
||||
When entering results, the current state in the database is #
|
||||
overwritten. #
|
||||
Results entered by other users are also overwritten.<br />
|
||||
|
||||
It is possible to delete results. #
|
||||
After doing so no result is saved for that part of the exam within #
|
||||
the database.<br />
|
||||
|
||||
If grades are to be computed automatically for this exam, the #
|
||||
results need to be accepted. #
|
||||
This is done via the listing of exam participants.
|
||||
Loading…
Reference in New Issue
Block a user