67 lines
2.4 KiB
Haskell
67 lines
2.4 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 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
|