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:
parent
324107c89c
commit
6af80e0467
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user