forked from filipg/gonito
Teacher can see results of his students'
This commit is contained in:
parent
3bbbff7291
commit
f6b696cffa
@ -34,7 +34,7 @@ import Data.SplitIntoCrossTabs
|
|||||||
|
|
||||||
rawCommitQuery :: (MonadIO m, RawSql a) => Text -> ReaderT SqlBackend m [a]
|
rawCommitQuery :: (MonadIO m, RawSql a) => Text -> ReaderT SqlBackend m [a]
|
||||||
rawCommitQuery sha1Prefix =
|
rawCommitQuery sha1Prefix =
|
||||||
rawSql "SELECT ?? FROM submission WHERE is_public AND cast(commit as text) like ?" [PersistText $ "\\\\x" ++ sha1Prefix ++ "%"]
|
rawSql "SELECT ?? FROM submission WHERE cast(commit as text) like ?" [PersistText $ "\\\\x" ++ sha1Prefix ++ "%"]
|
||||||
|
|
||||||
rawOutQuery :: (MonadIO m, RawSql a) => Text -> ReaderT SqlBackend m [a]
|
rawOutQuery :: (MonadIO m, RawSql a) => Text -> ReaderT SqlBackend m [a]
|
||||||
rawOutQuery sha1Prefix =
|
rawOutQuery sha1Prefix =
|
||||||
@ -48,9 +48,8 @@ groupBySecond lst = map putOut $ groupOn (fsiSubmissionId . fst) lst
|
|||||||
findSubmissions :: Text -> Handler [(FullSubmissionInfo, [SHA1])]
|
findSubmissions :: Text -> Handler [(FullSubmissionInfo, [SHA1])]
|
||||||
findSubmissions sha1Prefix = do
|
findSubmissions sha1Prefix = do
|
||||||
mauthId <- maybeAuth
|
mauthId <- maybeAuth
|
||||||
submissions <- runDB $ case mauthId of
|
allSubmissions <- runDB $ rawCommitQuery sha1Prefix
|
||||||
Just (Entity authId _) -> rawSql "SELECT ?? FROM submission WHERE (is_public OR submitter = ?) AND cast(commit as text) like ?" [toPersistValue authId, PersistText $ "\\\\x" ++ sha1Prefix ++ "%"]
|
submissions <- filterM (\sub -> runDB $ checkWhetherVisible (entityVal sub) (entityKey <$> mauthId)) allSubmissions
|
||||||
Nothing -> rawCommitQuery sha1Prefix
|
|
||||||
justSubmissions' <- mapM getFullInfo submissions
|
justSubmissions' <- mapM getFullInfo submissions
|
||||||
let justSubmissions = map (\s -> (s, [])) justSubmissions'
|
let justSubmissions = map (\s -> (s, [])) justSubmissions'
|
||||||
|
|
||||||
@ -196,7 +195,9 @@ getViewVariantR variantId = do
|
|||||||
(submissionChallenge theSubmission)
|
(submissionChallenge theSubmission)
|
||||||
let tests = sortBy (flip testComparator) tests'
|
let tests = sortBy (flip testComparator) tests'
|
||||||
|
|
||||||
if submissionIsPublic theSubmission || Just (submissionSubmitter theSubmission) == (entityKey <$> mauthId)
|
isViewable <- runDB $ checkWhetherVisible theSubmission (entityKey <$> mauthId)
|
||||||
|
|
||||||
|
if isViewable
|
||||||
then
|
then
|
||||||
do
|
do
|
||||||
fullSubmissionInfo <- getFullInfo (Entity theSubmissionId theSubmission)
|
fullSubmissionInfo <- getFullInfo (Entity theSubmissionId theSubmission)
|
||||||
@ -236,17 +237,19 @@ paramsTable = mempty
|
|||||||
|
|
||||||
viewOutput :: TableEntry -> [Entity Test] -> (SHA1, Text) -> WidgetFor App ()
|
viewOutput :: TableEntry -> [Entity Test] -> (SHA1, Text) -> WidgetFor App ()
|
||||||
viewOutput entry tests (outputHash, testSet) = do
|
viewOutput entry tests (outputHash, testSet) = do
|
||||||
|
mauthId <- maybeAuthId
|
||||||
|
|
||||||
let tests'@(mainTest:_) = filter (\e -> (testName $ entityVal e) == testSet) tests
|
let tests'@(mainTest:_) = filter (\e -> (testName $ entityVal e) == testSet) tests
|
||||||
let outputSha1AsText = fromSHA1ToText $ outputHash
|
let outputSha1AsText = fromSHA1ToText $ outputHash
|
||||||
|
|
||||||
let variant = variantName $ entityVal $ tableEntryVariant entry
|
let variant = variantName $ entityVal $ tableEntryVariant entry
|
||||||
|
|
||||||
let theStamp = submissionStamp $ entityVal $ tableEntrySubmission entry
|
let theStamp = submissionStamp $ entityVal $ tableEntrySubmission entry
|
||||||
let isPublic = submissionIsPublic $ entityVal $ tableEntrySubmission entry
|
isViewable <- handlerToWidget $ runDB $ checkWhetherVisible (entityVal $ tableEntrySubmission entry) mauthId
|
||||||
challenge <- handlerToWidget $ runDB $ get404 $ submissionChallenge $ entityVal $ tableEntrySubmission entry
|
challenge <- handlerToWidget $ runDB $ get404 $ submissionChallenge $ entityVal $ tableEntrySubmission entry
|
||||||
let isNonSensitive = challengeSensitive challenge == Just False
|
let isNonSensitive = challengeSensitive challenge == Just False
|
||||||
|
|
||||||
let shouldBeShown = not ("test-" `isInfixOf` testSet) && isPublic && isNonSensitive
|
let shouldBeShown = not ("test-" `isInfixOf` testSet) && isViewable && isNonSensitive
|
||||||
|
|
||||||
let mainMetric = testMetric $ entityVal mainTest
|
let mainMetric = testMetric $ entityVal mainTest
|
||||||
|
|
||||||
@ -272,6 +275,7 @@ viewOutput entry tests (outputHash, testSet) = do
|
|||||||
gesTestName = (T.unpack testSet),
|
gesTestName = (T.unpack testSet),
|
||||||
gesSelector = Nothing,
|
gesSelector = Nothing,
|
||||||
gesOutFile = outFile,
|
gesOutFile = outFile,
|
||||||
|
gesAltOutFiles = Nothing,
|
||||||
gesExpectedFile = "expected.tsv",
|
gesExpectedFile = "expected.tsv",
|
||||||
gesInputFile = "in.tsv",
|
gesInputFile = "in.tsv",
|
||||||
gesMetrics = [mainMetric],
|
gesMetrics = [mainMetric],
|
||||||
|
Loading…
Reference in New Issue
Block a user