parent
21bbb92d4c
commit
d59f686021
@ -93,11 +93,8 @@ getSheetListR tid ssh csh = do
|
|||||||
cid' <- encrypt sid
|
cid' <- encrypt sid
|
||||||
return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR
|
return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR
|
||||||
acell = anchorCellM mkRoute $(widgetFile "widgets/rating/rating")
|
acell = anchorCellM mkRoute $(widgetFile "widgets/rating/rating")
|
||||||
tellStats = do
|
tellStats = tell $ stats submissionRatingPoints
|
||||||
r <- mkRoute
|
in guardAuthCell ((, False) <$> mkRoute) $ acell & cellContents %~ (<* tellStats)
|
||||||
showRating <- lift $ hasReadAccessTo r
|
|
||||||
tell . stats $ bool Nothing submissionRatingPoints showRating
|
|
||||||
in acell & cellContents %~ (<* tellStats)
|
|
||||||
|
|
||||||
, sortable Nothing -- (Just "percent")
|
, sortable Nothing -- (Just "percent")
|
||||||
(i18nCell MsgRatingPercent)
|
(i18nCell MsgRatingPercent)
|
||||||
@ -105,10 +102,13 @@ getSheetListR tid ssh csh = do
|
|||||||
(Just (Entity sid Submission{submissionRatingPoints=Just sPoints})) ->
|
(Just (Entity sid Submission{submissionRatingPoints=Just sPoints})) ->
|
||||||
case preview (_grading . _maxPoints) sType of
|
case preview (_grading . _maxPoints) sType of
|
||||||
Just maxPoints
|
Just maxPoints
|
||||||
| maxPoints /= 0 -> cell $ do
|
| maxPoints /= 0 ->
|
||||||
cID <- encrypt sid
|
let
|
||||||
showRating <- hasReadAccessTo $ CSubmissionR tid ssh csh sheetName cID CorrectionR
|
mkRoute = liftHandler $ do
|
||||||
bool (return ()) (toWidget . toMessage $ textPercent sPoints maxPoints) showRating
|
cid' <- encrypt sid
|
||||||
|
return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR
|
||||||
|
in guardAuthCell ((, False) <$> mkRoute) . cell $ do
|
||||||
|
toWidget . toMessage $ textPercent sPoints maxPoints
|
||||||
_other -> mempty
|
_other -> mempty
|
||||||
_other -> mempty
|
_other -> mempty
|
||||||
]
|
]
|
||||||
|
|||||||
@ -65,6 +65,13 @@ linkEmptyCell = anchorCell
|
|||||||
msgCell :: (ToMessage t, IsDBTable m a) => t -> DBCell m a
|
msgCell :: (ToMessage t, IsDBTable m a) => t -> DBCell m a
|
||||||
msgCell = textCell . toMessage
|
msgCell = textCell . toMessage
|
||||||
|
|
||||||
|
guardAuthCell :: (IsDBTable m a, MonadAP m, MonadThrow m)
|
||||||
|
=> m (Route UniWorX, Bool) -- ^ @(route, isWrite)@
|
||||||
|
-> DBCell m a -> DBCell m a
|
||||||
|
guardAuthCell mkParams = over cellContents $ \act -> do
|
||||||
|
(route, isWrite) <- lift mkParams
|
||||||
|
ifM (fmap (is _Authorized) . lift $ evalAccess route isWrite) act (return mempty)
|
||||||
|
|
||||||
-- Recall: for line numbers, use dbRow
|
-- Recall: for line numbers, use dbRow
|
||||||
|
|
||||||
---------------------
|
---------------------
|
||||||
|
|||||||
Reference in New Issue
Block a user