filipg/gonito
1
0
Fork 1
Code Issues 1 Pull Requests Releases Wiki Activity

Try to limit number of tests shown for a submission

Browse Source
This commit is contained in:
Filip Gralinski 2020-09-05 16:14:20 +02:00
parent c0ef2319ca
commit 0337f8dafd
2 changed files with 20 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
Handler/Query.hs
View File

@ -358,19 +358,24 @@ lineByLineTable (Entity testId test) theStamp = mempty
resultTable :: Entity Submission -> WidgetFor App ()
resultTable (Entity submissionId submission) = do
(tableEntries, tests) <- handlerToWidget
(tableEntries, tests') <- handlerToWidget
$ runDB
$ getChallengeSubmissionInfos 2
(\s -> entityKey s == submissionId)
(const True)
id
(submissionChallenge submission)
let paramNames =
nub
$ map (parameterName . entityVal)
$ concat
$ map tableEntryParams tableEntries
let maximumNumberOfColumns = 10
let tests = adjustNumberOfColumnsShown (maximumNumberOfColumns - length paramNames) tests'
let resultId = show $ fromSqlKey submissionId
let jsSelector = String $ T.pack ("#t" ++ resultId ++ " > table")
@ -379,6 +384,19 @@ resultTable (Entity submissionId submission) = do
$(widgetFile "result-table")
adjustNumberOfColumnsShown :: Int -> [Entity Test] -> [Entity Test]
adjustNumberOfColumnsShown maximumNumberOfColumns tests = adjustNumberOfColumnsShown' (max maximumNumberOfColumns minimumNumberOfTests) tests
where adjustNumberOfColumnsShown' maximumNumberOfColumns' tests'
| length tests <= maximumNumberOfColumns' = tests'
| otherwise = let filteredTests = filter (\t -> not ("dev" `isInfixOf` (testName $ entityVal t))) tests'
in if null filteredTests
then tests'
else
if length filteredTests <= maximumNumberOfColumns'
then filteredTests
else take maximumNumberOfColumns' filteredTests
minimumNumberOfTests = 2
data GitServer = Gogs | GitLab
deriving (Eq, Show)

2
Handler/ShowChallenge.hs
View File

@ -62,7 +62,7 @@ getShowChallengeR name = do
(altLeaderboard, altTests) <- if showAltLeaderboard
then
do
(leaderboard', (_, tests')) <- getLeaderboardEntries 2 ByTag challengeId
(leaderboard', (_, tests')) <- getLeaderboardEntries 3 ByTag challengeId
return $ (Just leaderboard', Just tests')
else
return (Nothing, Nothing)