Extend the visibility of outputs

Now the outputs for all tests can be viewed except for
the main test provided that the expected.tsv file is there.

It means that, for example, test-A will be shown is test-B is there.
This commit is contained in:
Filip Gralinski 2021-08-21 18:32:04 +02:00
parent 324107c89c
commit 6af80e0467

View File

@ -1,4 +1,5 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DoAndIfThenElse #-}
module Handler.Query where module Handler.Query where
@ -51,6 +52,8 @@ import Control.Lens hiding ((.=), (^.), (<.>))
import Data.Proxy as DPR import Data.Proxy as DPR
import Data.HashMap.Strict.InsOrd (fromList) import Data.HashMap.Strict.InsOrd (fromList)
import qualified System.Directory as D
import Handler.ShowChallenge import Handler.ShowChallenge
@ -564,7 +567,7 @@ viewOutputWithNonDefaultTestSelected entry tests mainTest (outputHash, testSet)
challenge <- handlerToWidget $ runDB $ get404 $ submissionChallenge $ entityVal $ tableEntrySubmission $ current entry challenge <- handlerToWidget $ runDB $ get404 $ submissionChallenge $ entityVal $ tableEntrySubmission $ current entry
let isNonSensitive = challengeSensitive challenge == Just False let isNonSensitive = challengeSensitive challenge == Just False
let shouldBeShown = not ("test-" `isInfixOf` testSet) && isNonSensitive let shouldBeShown = testSet /= (testName $ entityVal mainTest) && isNonSensitive
let mainMetric = testMetric $ entityVal mainTest let mainMetric = testMetric $ entityVal mainTest
@ -590,7 +593,13 @@ viewOutputWithNonDefaultTestSelected entry tests mainTest (outputHash, testSet)
Right opts <- liftIO $ readOptsFromConfigFile [] (current repoDir </> "config.txt") Right opts <- liftIO $ readOptsFromConfigFile [] (current repoDir </> "config.txt")
let spec = GEvalSpecification { expFile <- liftIO $ lookForCompressedFiles (current repoDir </> testName </> "expected.tsv")
expFileExists <- liftIO $ D.doesFileExist expFile
if expFileExists
then do
let spec = GEvalSpecification {
gesOutDirectory = current repoDir, gesOutDirectory = current repoDir,
gesExpectedDirectory = Nothing, gesExpectedDirectory = Nothing,
gesTestName = testName, gesTestName = testName,
@ -613,19 +622,22 @@ viewOutputWithNonDefaultTestSelected entry tests mainTest (outputHash, testSet)
gesOutHeader = gesOutHeader $ geoSpec opts, gesOutHeader = gesOutHeader $ geoSpec opts,
gesShowPreprocessed = True } gesShowPreprocessed = True }
case outPaths of case outPaths of
OneThing _ -> do OneThing _ -> do
result <- liftIO $ runLineByLineGeneralized FirstTheWorst result <- liftIO $ runLineByLineGeneralized FirstTheWorst
spec spec
(\_ -> CL.take maximumNumberOfItemsToBeShown) (\_ -> CL.take maximumNumberOfItemsToBeShown)
return $ Just $ zip [1..] $ map getUniLineRecord result return $ Just $ zip [1..] $ map getUniLineRecord result
TwoThings (Just (oldRepoDir, oldOutFilePath)) _ -> do TwoThings (Just (oldRepoDir, oldOutFilePath)) _ -> do
absOldOutFilePath <- liftIO $ makeAbsolute (oldRepoDir </> testName </> (takeFileName oldOutFilePath)) absOldOutFilePath <- liftIO $ makeAbsolute (oldRepoDir </> testName </> (takeFileName oldOutFilePath))
result <- liftIO $ runDiffGeneralized FirstTheWorst result <- liftIO $ runDiffGeneralized FirstTheWorst
absOldOutFilePath absOldOutFilePath
spec spec
(\_ -> CL.take maximumNumberOfItemsToBeShown) (\_ -> CL.take maximumNumberOfItemsToBeShown)
return $ Just $ zip [1..] $ map getBiLineRecord result return $ Just $ zip [1..] $ map getBiLineRecord result
else
do
return Nothing
Nothing -> return Nothing Nothing -> return Nothing
else else
return Nothing return Nothing