Fix SubmissionRatingDone
This commit is contained in:
Gregor Kleen
parent
c50b24b962
commit
3342daa0e8
@ -184,18 +184,23 @@ colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_
|
||||
cell [whamlet|#{review pseudonymText pseudo}|]
|
||||
in lCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
|
||||
|
||||
colPointsField :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData SubmissionId (Maybe (Either Bool Points), a))))
|
||||
colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPointsDone & cellTooltip MsgRatingPointsDone) $ formCell
|
||||
colRatedField :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData SubmissionId (Bool, a, b))))
|
||||
colRatedField = sortable Nothing (i18nCell MsgRatingDone) $ formCell
|
||||
(\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId)
|
||||
(\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _) } _ -> over (_1.mapped) (_1 .~) . over _2 fvInput <$> mreq checkBoxField "" (Just done))
|
||||
|
||||
colPointsField :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData SubmissionId (a, Maybe Points, b))))
|
||||
colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPointsDone) $ formCell
|
||||
(\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId)
|
||||
(\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _) } _ -> case sheetType of
|
||||
NotGraded -> over (_1.mapped) ((_1 .~) . fmap Left) . over _2 fvInput <$> mopt checkBoxField "" (Just . Just $ isJust submissionRatingPoints)
|
||||
_other -> over (_1.mapped) ((_1 .~) . fmap Right) . over _2 fvInput <$> mopt pointsField "" (Just submissionRatingPoints)
|
||||
NotGraded -> over (_1.mapped) (_2 .~) <$> pure (FormSuccess Nothing, mempty)
|
||||
_other -> over (_1.mapped) (_2 .~) . over _2 fvInput <$> mopt pointsField "" (Just submissionRatingPoints)
|
||||
)
|
||||
|
||||
colCommentField :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData SubmissionId (a, Maybe Text))))
|
||||
colCommentField :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData SubmissionId (a, b, Maybe Text))))
|
||||
colCommentField = sortable Nothing (i18nCell MsgRatingComment) $ formCell
|
||||
(\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId)
|
||||
(\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _) } _ -> over (_1.mapped) ((_2 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField "" (Just $ Textarea <$> submissionRatingComment))
|
||||
(\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _) } _ -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField "" (Just $ Textarea <$> submissionRatingComment))
|
||||
|
||||
|
||||
type CorrectionTableExpr = (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
|
||||
@ -497,11 +502,12 @@ postCorrectionR tid ssh csh shn cid = do
|
||||
[(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, corrector)] -> do
|
||||
let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c))
|
||||
pointsForm = case sheetType of
|
||||
NotGraded -> bool Nothing (Just 0) <$> areq checkBoxField (fslI MsgRatingDone) (Just $ submissionRatingDone Submission{..})
|
||||
_otherwise -> aopt pointsField (fslpI MsgRatingPoints "Punktezahl" & setTooltip MsgRatingPointsDone) (Just $ submissionRatingPoints)
|
||||
NotGraded -> pure Nothing
|
||||
_otherwise -> aopt pointsField (fslpI MsgRatingPoints "Punktezahl") (Just $ submissionRatingPoints)
|
||||
|
||||
((corrResult, corrForm), corrEncoding) <- runFormPost . identForm FIDcorrection . renderAForm FormStandard $ (,)
|
||||
<$> pointsForm
|
||||
((corrResult, corrForm), corrEncoding) <- runFormPost . identForm FIDcorrection . renderAForm FormStandard $ (,,)
|
||||
<$> areq checkBoxField (fslI MsgRatingDone) (Just $ submissionRatingDone Submission{..})
|
||||
<*> pointsForm
|
||||
<*> (((\t -> t <$ guard (not $ null t)) =<<) . fmap (Text.strip . unTextarea) <$> aopt textareaField (fslI MsgRatingComment) (Just $ Textarea <$> submissionRatingComment))
|
||||
<* submitButton
|
||||
|
||||
@ -512,13 +518,11 @@ postCorrectionR tid ssh csh shn cid = do
|
||||
case corrResult of
|
||||
FormMissing -> return ()
|
||||
FormFailure errs -> mapM_ (addMessage Error . toHtml) errs
|
||||
FormSuccess (ratingPoints, ratingComment) -> do
|
||||
FormSuccess (rated, ratingPoints, ratingComment) -> do
|
||||
runDBJobs $ do
|
||||
uid <- liftHandlerT requireAuthId
|
||||
now <- liftIO getCurrentTime
|
||||
|
||||
let rated = isJust ratingPoints -- <|> void ratingComment -- Comment shouldn't cause rating
|
||||
|
||||
Submission{submissionRatingTime} <- getJust sub
|
||||
|
||||
update sub [ SubmissionRatingBy =. (uid <$ guard rated)
|
||||
@ -742,12 +746,13 @@ postCorrectionsGradeR = do
|
||||
, colPseudonyms
|
||||
, colSubmissionLink
|
||||
, colRated
|
||||
, colRatedField
|
||||
, colPointsField
|
||||
, colCommentField
|
||||
] -- Continue here
|
||||
psValidator = def
|
||||
& defaultSorting [("ratingtime", SortDesc)] :: PSValidator (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult (DBFormResult CorrectionTableData SubmissionId (Maybe (Either Bool Points), Maybe Text)))
|
||||
unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _) } -> (bool (Right <$> submissionRatingPoints) (Just . Left $ isJust submissionRatingPoints) $ sheetType == NotGraded, submissionRatingComment)
|
||||
& defaultSorting [("ratingtime", SortDesc)] :: PSValidator (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult (DBFormResult CorrectionTableData SubmissionId (Bool, Maybe Points, Maybe Text)))
|
||||
unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment)
|
||||
|
||||
tableForm <- makeCorrectionsTable whereClause displayColumns psValidator $ \i@(Entity subId _, Entity _ Sheet{ sheetName = shn }, (_, csh, tid, ssh), _, _) -> do
|
||||
cID <- encrypt subId
|
||||
@ -760,15 +765,14 @@ postCorrectionsGradeR = do
|
||||
FormFailure errs -> forM_ errs $ addMessage Error . toHtml
|
||||
FormSuccess resMap -> do
|
||||
now <- liftIO getCurrentTime
|
||||
subs <- fmap catMaybes . runDB . forM (Map.toList resMap) $ \(subId, (mPoints, mComment)) -> do
|
||||
let mPoints' = either (bool Nothing $ return 0) return =<< mPoints
|
||||
Submission{..} <- get404 subId
|
||||
subs <- fmap catMaybes . runDB . forM (Map.toList resMap) $ \(subId, (rated, mPoints, mComment)) -> do
|
||||
s@Submission{..} <- get404 subId
|
||||
if
|
||||
| submissionRatingPoints /= mPoints' || submissionRatingComment /= mComment
|
||||
-> Just subId <$ update subId [ SubmissionRatingPoints =. mPoints'
|
||||
| submissionRatingPoints /= mPoints || submissionRatingComment /= mComment || rated /= submissionRatingDone s
|
||||
-> Just subId <$ update subId [ SubmissionRatingPoints =. mPoints
|
||||
, SubmissionRatingComment =. mComment
|
||||
, SubmissionRatingBy =. Just uid
|
||||
, SubmissionRatingTime =. now <$ (void mPoints' <|> void mComment)
|
||||
, SubmissionRatingTime =. now <$ guard rated
|
||||
]
|
||||
| otherwise -> return $ Nothing
|
||||
subs' <- traverse encrypt subs :: Handler [CryptoFileNameSubmission]
|
||||
|
||||
@ -51,4 +51,4 @@ data PWEntry = PWEntry
|
||||
$(deriveJSON defaultOptions ''PWEntry)
|
||||
|
||||
submissionRatingDone :: Submission -> Bool
|
||||
submissionRatingDone Submission{..} = isJust submissionRatingPoints
|
||||
submissionRatingDone Submission{..} = isJust submissionRatingTime
|
||||
|
||||
Loading…
Reference in New Issue
Block a user