diff --git a/src/Handler/Exam/Correct.hs b/src/Handler/Exam/Correct.hs index 895d72d86..c74970da7 100644 --- a/src/Handler/Exam/Correct.hs +++ b/src/Handler/Exam/Correct.hs @@ -6,7 +6,6 @@ import Import import qualified Data.Set as Set import qualified Data.CaseInsensitive as CI -import qualified Data.Aeson as JSON import qualified Database.Esqueleto as E import qualified Database.Esqueleto.Utils as E @@ -15,63 +14,7 @@ import Database.Persist.Sql (transactionUndo) import Handler.Utils import Handler.Utils.Exam (fetchExam) -import qualified Data.HashMap.Strict as HashMap - - -data CorrectInterfaceUser - = CorrectInterfaceUser - { ciuSurname :: Text - , ciuDisplayName :: Text - , ciuMatNr :: Maybe UserMatriculation - , ciuId :: CryptoUUIDUser - } deriving (Eq,Ord) -deriveJSON defaultOptions - { fieldLabelModifier = camelToPathPiece' 1 - } ''CorrectInterfaceUser - -data CorrectInterfaceResponse - = CorrectInterfaceResponseSuccess - { cirsUser :: CorrectInterfaceUser - , cirsResults :: Map ExamPartNumber (Maybe ExamResultPoints) - , cirsGrade :: Maybe (Maybe ExamResultPassedGrade) - , cirsTime :: UTCTime - } - | CorrectInterfaceResponseAmbiguous - { ciraUsers :: Set CorrectInterfaceUser - , ciraMessage :: Text - } - | CorrectInterfaceResponseFailure - { cirfUser :: Maybe CorrectInterfaceUser - , cirfMessage :: Text - } - | CorrectInterfaceResponseNoOp - { cirnUsers :: Set CorrectInterfaceUser - } -deriveToJSON defaultOptions - { constructorTagModifier = camelToPathPiece' 3 - , fieldLabelModifier = camelToPathPiece' 1 - , sumEncoding = TaggedObject "status" "results" - , omitNothingFields = True - } ''CorrectInterfaceResponse - -data CorrectInterfaceRequest - = CorrectInterfaceRequest - { ciqUser :: Either Text (CryptoID UUID (Key User)) - , ciqResults :: Maybe (NonNull (Map ExamPartNumber (Maybe Points))) - , ciqGrade :: Maybe (Maybe ExamResultPassedGrade) - } - -instance FromJSON CorrectInterfaceRequest where - parseJSON = JSON.withObject "CorrectInterfaceRequest" $ \o -> do - ciqUser <- Right <$> o JSON..: "user" <|> Left <$> o JSON..: "user" - results <- o JSON..:? "results" - ciqResults <- for results $ maybe (fail "Results may not be nullable") return . fromNullable - ciqGrade <- if - | "grade" `HashMap.member` o - -> Just <$> o JSON..: "grade" - | otherwise - -> pure Nothing - return CorrectInterfaceRequest{..} +import Utils.Exam getECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html diff --git a/src/Utils/Exam.hs b/src/Utils/Exam.hs new file mode 100644 index 000000000..bca2727ca --- /dev/null +++ b/src/Utils/Exam.hs @@ -0,0 +1,70 @@ +module Utils.Exam + ( CorrectInterfaceRequest(..) + , CorrectInterfaceResponse(..) + , CorrectInterfaceUser(..) + ) where + +import Import.NoFoundation + +import qualified Data.Aeson as JSON +import qualified Data.HashMap.Strict as HashMap + + +data CorrectInterfaceUser + = CorrectInterfaceUser + { ciuSurname :: Text + , ciuDisplayName :: Text + , ciuMatNr :: Maybe UserMatriculation + , ciuId :: CryptoUUIDUser + } deriving (Eq,Ord) + +deriveJSON defaultOptions + { fieldLabelModifier = camelToPathPiece' 1 + } ''CorrectInterfaceUser + + +data CorrectInterfaceResponse + = CorrectInterfaceResponseSuccess + { cirsUser :: CorrectInterfaceUser + , cirsResults :: Map ExamPartNumber (Maybe ExamResultPoints) + , cirsGrade :: Maybe (Maybe ExamResultPassedGrade) + , cirsTime :: UTCTime + } + | CorrectInterfaceResponseAmbiguous + { ciraUsers :: Set CorrectInterfaceUser + , ciraMessage :: Text + } + | CorrectInterfaceResponseFailure + { cirfUser :: Maybe CorrectInterfaceUser + , cirfMessage :: Text + } + | CorrectInterfaceResponseNoOp + { cirnUsers :: Set CorrectInterfaceUser + } + +deriveToJSON defaultOptions + { constructorTagModifier = camelToPathPiece' 3 + , fieldLabelModifier = camelToPathPiece' 1 + , sumEncoding = TaggedObject "status" "results" + , omitNothingFields = True + } ''CorrectInterfaceResponse + + +data CorrectInterfaceRequest + = CorrectInterfaceRequest + { ciqUser :: Either Text (CryptoID UUID (Key User)) + , ciqResults :: Maybe (NonNull (Map ExamPartNumber (Maybe Points))) + , ciqGrade :: Maybe (Maybe ExamResultPassedGrade) + } + +instance FromJSON CorrectInterfaceRequest where + parseJSON = JSON.withObject "CorrectInterfaceRequest" $ \o -> do + ciqUser <- Right <$> o JSON..: "user" <|> Left <$> o JSON..: "user" + results <- o JSON..:? "results" + ciqResults <- for results $ maybe (fail "Results may not be nullable") return . fromNullable + ciqGrade <- if + | "grade" `HashMap.member` o + -> Just <$> o JSON..: "grade" + | otherwise + -> pure Nothing + return CorrectInterfaceRequest{..}