multiple outs can be accepted now
This commit is contained in:
parent
bb77049918
commit
f3960c371d
@ -9,6 +9,7 @@ import qualified Data.Text.Lazy as TL
|
|||||||
import Text.Markdown
|
import Text.Markdown
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Map.Strict as M
|
||||||
|
|
||||||
import qualified Yesod.Table as Table
|
import qualified Yesod.Table as Table
|
||||||
|
|
||||||
@ -20,7 +21,7 @@ import Handler.TagUtils
|
|||||||
|
|
||||||
import GEval.Core
|
import GEval.Core
|
||||||
import GEval.OptionsParser
|
import GEval.OptionsParser
|
||||||
|
import GEval.ParseParams (parseParamsFromFilePath, OutputFileParsed(..))
|
||||||
|
|
||||||
import PersistSHA1
|
import PersistSHA1
|
||||||
|
|
||||||
@ -28,6 +29,8 @@ import Options.Applicative
|
|||||||
|
|
||||||
import System.IO (readFile)
|
import System.IO (readFile)
|
||||||
|
|
||||||
|
import System.FilePath (takeFileName, dropExtensions)
|
||||||
|
|
||||||
import Data.Attoparsec.Text
|
import Data.Attoparsec.Text
|
||||||
|
|
||||||
import Data.Text (pack, unpack)
|
import Data.Text (pack, unpack)
|
||||||
@ -282,9 +285,10 @@ getOuts chan submissionId = do
|
|||||||
let challengeId = submissionChallenge submission
|
let challengeId = submissionChallenge submission
|
||||||
repoDir <- getRepoDir $ submissionRepo submission
|
repoDir <- getRepoDir $ submissionRepo submission
|
||||||
activeTests <- runDB $ selectList [TestChallenge ==. challengeId, TestActive ==. True] []
|
activeTests <- runDB $ selectList [TestChallenge ==. challengeId, TestActive ==. True] []
|
||||||
testsDone <- filterM (liftIO . doesOutExist repoDir) activeTests
|
|
||||||
theVariant <- getVariant submissionId "out"
|
outs' <- mapM (outsForTest repoDir submissionId) activeTests
|
||||||
outs <- mapM (outForTest repoDir theVariant) testsDone
|
let outs = concat outs'
|
||||||
|
|
||||||
mapM_ checkOrInsertOut outs
|
mapM_ checkOrInsertOut outs
|
||||||
mapM_ (checkOrInsertEvaluation repoDir chan) outs
|
mapM_ (checkOrInsertEvaluation repoDir chan) outs
|
||||||
return outs
|
return outs
|
||||||
@ -305,21 +309,49 @@ doesOutExist repoDir (Entity _ test) = do
|
|||||||
result <- findOutFile repoDir test
|
result <- findOutFile repoDir test
|
||||||
return $ isJust result
|
return $ isJust result
|
||||||
|
|
||||||
outForTest :: MonadIO m => FilePath -> Key Variant -> Entity Test -> m Out
|
outForTest :: MonadIO m => FilePath -> FilePath -> Key Variant -> Entity Test -> m Out
|
||||||
outForTest repoDir variantId (Entity testId test) = do
|
outForTest repoDir outF variantId (Entity testId test) = do
|
||||||
(Just outF) <- liftIO $ findOutFile repoDir test
|
let outPath = repoDir </> (T.unpack $ testName test) </> outF
|
||||||
checksum <- liftIO $ gatherSHA1ForCollectionOfFiles [outF]
|
checksum <- liftIO $ gatherSHA1ForCollectionOfFiles [outPath]
|
||||||
return Out {
|
return Out {
|
||||||
outVariant=variantId,
|
outVariant=variantId,
|
||||||
outTest=testId,
|
outTest=testId,
|
||||||
outChecksum=SHA1 checksum }
|
outChecksum=SHA1 checksum }
|
||||||
|
|
||||||
getVariant :: SubmissionId -> Text -> Handler VariantId
|
outsForTest :: FilePath -> SubmissionId -> Entity Test -> HandlerFor App [Out]
|
||||||
getVariant submissionId name = runDB $ do
|
outsForTest repoDir submissionId testEnt@(Entity _ test) = do
|
||||||
|
outFiles <- liftIO $ outFilesForTest repoDir test
|
||||||
|
|
||||||
|
forM outFiles $ \outFile -> do
|
||||||
|
theVariant <- getVariant submissionId outFile
|
||||||
|
outForTest repoDir outFile theVariant testEnt
|
||||||
|
|
||||||
|
-- returns the filename (not file path)
|
||||||
|
outFilesForTest :: FilePath -> Test -> IO [FilePath]
|
||||||
|
outFilesForTest repoDir test = do
|
||||||
|
mMultipleOuts <- checkMultipleOutsCore repoDir (Data.Text.unpack $ testName test) "out.tsv"
|
||||||
|
case mMultipleOuts of
|
||||||
|
Just outFiles -> return $ map takeFileName outFiles
|
||||||
|
Nothing -> do
|
||||||
|
mOutFile <- findOutFile repoDir test
|
||||||
|
case mOutFile of
|
||||||
|
Just outF -> return [takeFileName outF]
|
||||||
|
Nothing -> return []
|
||||||
|
|
||||||
|
getVariant :: SubmissionId -> FilePath -> Handler VariantId
|
||||||
|
getVariant submissionId outFilePath = runDB $ do
|
||||||
|
let outFile = takeFileName outFilePath
|
||||||
|
let name = Data.Text.pack $ dropExtensions outFile
|
||||||
maybeVariant <- getBy $ UniqueVariantSubmissionName submissionId name
|
maybeVariant <- getBy $ UniqueVariantSubmissionName submissionId name
|
||||||
case maybeVariant of
|
case maybeVariant of
|
||||||
Just (Entity vid _) -> return vid
|
Just (Entity vid _) -> return vid
|
||||||
Nothing -> insert $ Variant submissionId name
|
Nothing -> do
|
||||||
|
vid <- insert $ Variant submissionId name
|
||||||
|
let (OutputFileParsed _ paramMap) = parseParamsFromFilePath outFile
|
||||||
|
forM_ (M.toList paramMap) $ \(param, val) -> do
|
||||||
|
_ <- insert $ Parameter vid param val
|
||||||
|
return ()
|
||||||
|
return vid
|
||||||
|
|
||||||
checkOrInsertOut :: Out -> Handler ()
|
checkOrInsertOut :: Out -> Handler ()
|
||||||
checkOrInsertOut out = do
|
checkOrInsertOut out = do
|
||||||
@ -339,7 +371,8 @@ checkOrInsertEvaluation repoDir chan out = do
|
|||||||
Nothing -> do
|
Nothing -> do
|
||||||
msg chan $ "Start evaluation..."
|
msg chan $ "Start evaluation..."
|
||||||
challengeDir <- getRepoDir $ challengePrivateRepo challenge
|
challengeDir <- getRepoDir $ challengePrivateRepo challenge
|
||||||
resultOrException <- liftIO $ rawEval challengeDir (testMetric test) repoDir (testName test)
|
variant <- runDB $ get404 $ outVariant out
|
||||||
|
resultOrException <- liftIO $ rawEval challengeDir (testMetric test) repoDir (testName test) ((T.unpack $ variantName variant) <.> "tsv")
|
||||||
case resultOrException of
|
case resultOrException of
|
||||||
Right (Left _) -> do
|
Right (Left _) -> do
|
||||||
err chan "Cannot parse options, check the challenge repo"
|
err chan "Cannot parse options, check the challenge repo"
|
||||||
@ -360,11 +393,12 @@ checkOrInsertEvaluation repoDir chan out = do
|
|||||||
Left exception -> do
|
Left exception -> do
|
||||||
err chan $ "Evaluation failed: " ++ (T.pack $ show exception)
|
err chan $ "Evaluation failed: " ++ (T.pack $ show exception)
|
||||||
|
|
||||||
rawEval :: FilePath -> Metric -> FilePath -> Text -> IO (Either GEvalException (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe [(SourceSpec, [MetricValue])])))
|
rawEval :: FilePath -> Metric -> FilePath -> Text -> FilePath -> IO (Either GEvalException (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe [(SourceSpec, [MetricValue])])))
|
||||||
rawEval challengeDir metric repoDir name = Import.try (runGEvalGetOptions [
|
rawEval challengeDir metric repoDir name outF = Import.try (runGEvalGetOptions [
|
||||||
"--alt-metric", (show metric),
|
"--alt-metric", (show metric),
|
||||||
"--expected-directory", challengeDir,
|
"--expected-directory", challengeDir,
|
||||||
"--out-directory", repoDir,
|
"--out-directory", repoDir,
|
||||||
|
"--out-file", outF,
|
||||||
"--test-name", (T.unpack name)])
|
"--test-name", (T.unpack name)])
|
||||||
|
|
||||||
getSubmissionRepo :: Key Challenge -> RepoSpec -> Channel -> Handler (Maybe (Key Repo))
|
getSubmissionRepo :: Key Challenge -> RepoSpec -> Channel -> Handler (Maybe (Key Repo))
|
||||||
|
@ -122,7 +122,7 @@ library
|
|||||||
, filemanip
|
, filemanip
|
||||||
, cryptohash
|
, cryptohash
|
||||||
, markdown
|
, markdown
|
||||||
, geval >= 1.1.0.0 && < 1.2
|
, geval >= 1.1.2.0 && < 1.2
|
||||||
, filepath
|
, filepath
|
||||||
, yesod-table
|
, yesod-table
|
||||||
, regex-tdfa
|
, regex-tdfa
|
||||||
|
Loading…
Reference in New Issue
Block a user