From 0337f8dafd30a0437906deefcd5681f381b1b99a Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Sat, 5 Sep 2020 16:14:20 +0200
Subject: [PATCH] Try to limit number of tests shown for a submission

---
 Handler/Query.hs         | 20 +++++++++++++++++++-
 Handler/ShowChallenge.hs |  2 +-
 2 files changed, 20 insertions(+), 2 deletions(-)

diff --git a/Handler/Query.hs b/Handler/Query.hs
index 088ff38..346e6bd 100644
--- a/Handler/Query.hs
+++ b/Handler/Query.hs
@@ -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)
diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs
index 27f5206..77c9b64 100644
--- a/Handler/ShowChallenge.hs
+++ b/Handler/ShowChallenge.hs
@@ -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)