This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Handler/Exam/Correct.hs

67 lines
2.2 KiB
Haskell

module Handler.Exam.Correct
( getECorrectR, postECorrectR
) where
import Import
import qualified Data.CaseInsensitive as CI (original)
import Handler.Utils
import Handler.Utils.Exam (fetchExam)
data CorrectInterfaceResponse
= CorrectInterfaceSuccess
{ ciUserIdent :: CryptoUUIDUser
, ciUserDisplayName :: Text
, ciUserMatrikelnummer :: Maybe Text
, ciResults :: Map ExamPartNumber (Maybe Points)
}
| CorrectInterfaceFailure
{ ciIcon :: Icon
, ciMessage :: Text
}
deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece' 2
, fieldLabelModifier = camelToPathPiece' 1
, sumEncoding = TaggedObject "status" "result"
} ''CorrectorInterfaceResponse
-- E.g.: { "status": "success", "user-ident": "Max Musterstudent", "user-matrikelnummer": "123", "results": { "1a": null, "2a": 7, "2c3.5": 12 } }
data CorrectInterfaceRequest
= CorrectInterfaceRequest
{ cirName :: Text
, cirResults :: Map ExamPartNumber (Maybe Points)
}
deriveJSON defaultOptions
{ fieldLabelModifier = camelToPathPiece' 1
} ''CorrectorInterfaceRequest
-- E.g.: { "name": "max", "results": { "1a": null, "2c3.5": 9001.2 }}
getECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
getECorrectR tid ssh csh examn = do
MsgRenderer mr <- getMsgRenderer
(Entity _ Exam{..}, examParts) <- runDB $ do
exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn
examParts <- sortOn (view $ _entityVal . _examPartNumber) <$> selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
return (exam, entityVal <$> examParts)
let
heading = prependCourseTitle tid ssh csh $ (mr . MsgExamCorrectHeading . CI.original) examName
ptsInput :: ExamPartNumber -> Widget
ptsInput n = do
name <- newIdent
fieldView (pointsField :: Field Handler Points) ("exam-correct__" <> toPathPiece n) name [("class","exam-correct__pts-input")] (Left "") False
participantHeadTooltip = [whamlet| _{MsgExamCorrectHeadParticipantTooltip} |]
siteLayoutMsg heading $ do
setTitleI heading
$(widgetFile "exam-correct")
postECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Value
postECorrectR = error "ECorrectR not implemented" -- use returnJson & requireCheckJsonBody