From b05f1ccc75adf07159e110ea70f1b56e32101d62 Mon Sep 17 00:00:00 2001 From: SJost Date: Fri, 30 Nov 2018 21:51:16 +0100 Subject: [PATCH] Rating type shown along rating in all corrections. --- src/Handler/Corrections.hs | 4 +--- src/Handler/Utils/Form.hs | 36 ++++++++++++++++----------------- templates/widgets/rating.hamlet | 17 ++++++++-------- 3 files changed, 28 insertions(+), 29 deletions(-) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index ab625a903..9a398e017 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -150,6 +150,7 @@ colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=( tid = course ^. _3 ssh = course ^. _4 -- shn = sheetName + mkRoute = do cid <- encrypt subId return $ CSubmissionR tid ssh csh sheetName cid CorrectionR @@ -435,7 +436,6 @@ postCorrectionsR = do , colAssigned , colRating , colRated - , colSheetType ] -- Continue here psValidator = def & restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information @@ -456,7 +456,6 @@ postCCorrectionsR tid ssh csh = do , colSMatrikel , colSubmittors , colSubmissionLink - , colSheetType , colRating , colRated , colCorrector @@ -771,7 +770,6 @@ postCorrectionsGradeR = do , colSheet , colPseudonyms , colSubmissionLink - , colSheetType , colRated , colRatedField , colPointsField diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index d1c9d3e4b..cc16635d7 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -263,7 +263,7 @@ multiFileField permittedFiles' = Field{..} pVals <- lift permittedFiles' let decrypt' :: CryptoUUIDFile -> Handler (Maybe FileId) - decrypt' = fmap (either (\(_ :: CryptoIDError) -> Nothing) Just) . try . decrypt + decrypt' = fmap (either (\(_ :: CryptoIDError) -> Nothing) Just) . try . decrypt yieldMany vals .| C.filter (/= unpackZips) .| C.map fromPathPiece .| C.catMaybes @@ -288,7 +288,7 @@ multiFileField permittedFiles' = Field{..} let fuiChecked | Right sentVals' <- sentVals = fuiId' `elem` sentVals' | otherwise = True - return FileUploadInfo{..} + return FileUploadInfo{..} fileInfos <- mapM toFUI <=< handlerToWidget . runDB . E.select . E.from $ \file -> do E.where_ $ file E.^. FileId `E.in_` E.valList (setToList pVals) E.orderBy [E.asc $ file E.^. FileTitle] @@ -303,13 +303,13 @@ multiFileField permittedFiles' = Field{..} data SheetGrading' = Points' | PassPoints' | PassBinary' - deriving (Eq, Ord, Read, Show, Enum, Bounded) + deriving (Eq, Ord, Read, Show, Enum, Bounded) instance Universe SheetGrading' instance Finite SheetGrading' nullaryPathPiece ''SheetGrading' (camelToPathPiece . dropSuffix "'") -embedRenderMessage ''UniWorX ''SheetGrading' ("SheetGrading" <>) +embedRenderMessage ''UniWorX ''SheetGrading' ("SheetGrading" <>) data SheetType' = Bonus' | Normal' | Informational' | NotGraded' @@ -319,7 +319,7 @@ instance Universe SheetType' instance Finite SheetType' nullaryPathPiece ''SheetType' (camelToPathPiece . dropSuffix "'") -embedRenderMessage ''UniWorX ''SheetType' ("SheetType" <>) +embedRenderMessage ''UniWorX ''SheetType' ("SheetType" <>) data SheetGroup' = Arbitrary' | RegisteredGroups' | NoGroups' @@ -333,31 +333,31 @@ embedRenderMessage ''UniWorX ''SheetGroup' (("SheetGroup" <>) . dropSuffix "'") sheetGradingAFormReq :: FieldSettings UniWorX -> Maybe SheetGrading -> AForm Handler SheetGrading sheetGradingAFormReq fs template = multiActionA fs selOptions (classify' <$> template) - where - selOptions = Map.fromList - [ ( Points', Points <$> maxPointsReq ) + where + selOptions = Map.fromList + [ ( Points', Points <$> maxPointsReq ) , ( PassPoints', PassPoints <$> maxPointsReq <*> passPointsReq ) , ( PassBinary', pure PassBinary) ] - classify' :: SheetGrading -> SheetGrading' - classify' = \case - Points {} -> Points' + classify' :: SheetGrading -> SheetGrading' + classify' = \case + Points {} -> Points' PassPoints {} -> PassPoints' PassBinary {} -> PassBinary' - - maxPointsReq = apreq pointsField (fslI MsgSheetGradingMaxPoints) (template >>= preview _maxPoints) + + maxPointsReq = apreq pointsField (fslI MsgSheetGradingMaxPoints) (template >>= preview _maxPoints) passPointsReq = apreq pointsField (fslI MsgSheetGradingPassingPoints) (template >>= preview _passingPoints) sheetTypeAFormReq :: FieldSettings UniWorX -> Maybe SheetType -> AForm Handler SheetType sheetTypeAFormReq fs template = multiActionA fs selOptions (classify' <$> template) - where + where selOptions = Map.fromList [ ( Bonus' , Bonus <$> gradingReq ) , ( Normal', Normal <$> gradingReq ) , ( Informational', Informational <$> gradingReq ) , ( NotGraded', pure NotGraded ) - ] + ] gradingReq = sheetGradingAFormReq (fslI MsgSheetGrading & setTooltip MsgSheetGradingInfo) (template >>= preview _grading) @@ -440,8 +440,8 @@ utcTimeField = Field fieldTimeFormat :: String --fieldTimeFormat = "%e.%m.%y %k:%M" fieldTimeFormat = "%Y-%m-%dT%H:%M" - - -- `defaultTimeLocale` is okay here, since `fieldTimeFormat` does not contain any + + -- `defaultTimeLocale` is okay here, since `fieldTimeFormat` does not contain any readTime :: Text -> Either UniWorXMessage UTCTime readTime t = case localTimeToUTC <$> parseTimeM True defaultTimeLocale fieldTimeFormat (T.unpack t) of @@ -595,7 +595,7 @@ formResultModal res finalDest handler = maybeT_ $ do FormMissing -> mzero FormFailure errs -> mapM_ (addMessage Error . toHtml) errs >> mzero FormSuccess val -> lift . execWriterT $ handler val - + isModal <- hasCustomHeader HeaderIsModal if | isModal -> sendResponse $ toJSON messages diff --git a/templates/widgets/rating.hamlet b/templates/widgets/rating.hamlet index d9241e561..366769452 100644 --- a/templates/widgets/rating.hamlet +++ b/templates/widgets/rating.hamlet @@ -3,18 +3,19 @@ $# submissionRatingPoints :: Maybe points $maybe points <- submissionRatingPoints $maybe grading <- preview _grading sheetType - $case grading + $case grading $of Points{..} - _{MsgAchievedOf points maxPoints} - $of PassPoints{} - $if fromMaybe False (gradingPassed grading points) - _{MsgPassed} - $else - _{MsgNotPassed} - $of PassBinary + _{MsgAchievedOf points maxPoints} + $of PassPoints{maxPoints} + $if fromMaybe False (gradingPassed grading points) + _{MsgPassed}, _{MsgAchievedOf points maxPoints} + $else + _{MsgNotPassed}, _{MsgAchievedOf points maxPoints} + $of PassBinary $if fromMaybe False (gradingPassed grading points) _{MsgPassed} $else _{MsgNotPassed} + , _{SheetTypeHeader sheetType} $nothing #{tickmarkS}