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 CryptoUUIDUser Text (Maybe Text) (Map ExamPartNumber (Maybe Points)) -- { ciUserIdent :: CryptoUUIDUser -- , ciUserDisplayName :: Text -- , ciUserMatrikelnummer :: Maybe Text -- , ciResults :: Map ExamPartNumber (Maybe Points) -- } | CorrectInterfaceFailure Icon Text -- { ciIcon :: Icon -- , ciMessage :: Text -- } deriveJSON defaultOptions { constructorTagModifier = camelToPathPiece' 2 , fieldLabelModifier = camelToPathPiece' 1 , sumEncoding = TaggedObject "status" "result" } ''CorrectInterfaceResponse -- E.g.: { "status": "success", "user-ident": "Max Musterstudent", "user-matrikelnummer": "123", "results": { "1a": null, "2a": 7, "2c3.5": 12 } } data CorrectInterfaceRequest = CorrectInterfaceRequest Text (Map ExamPartNumber (Maybe Points)) -- { cirName :: Text -- , cirResults :: Map ExamPartNumber (Maybe Points) -- } deriveJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 } ''CorrectInterfaceRequest -- 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 "widgets/exam-correct") postECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Value postECorrectR = error "ECorrectR not implemented" -- use returnJson & requireCheckJsonBody