fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Rating type shown along rating in all corrections.

Browse Source
This commit is contained in:
SJost 2018-11-30 21:51:16 +01:00
parent 2ef4bbc014
commit b05f1ccc75
3 changed files with 28 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Handler/Corrections.hs
View File

@ -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

36
src/Handler/Utils/Form.hs
View File

@ -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

17
templates/widgets/rating.hamlet
View File

@ -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}