diff --git a/src/GEval/Core.hs b/src/GEval/Core.hs index 474936e..4204931 100644 --- a/src/GEval/Core.hs +++ b/src/GEval/Core.hs @@ -34,8 +34,8 @@ module GEval.Core EvaluationContext(..), ParserSpec(..), fileAsLineSource, - checkAndGetFiles, - checkAndGetFilesSingleOut, + checkAndGetDataSource, + checkAndGetDataSources, checkMultipleOuts, checkMultipleOutsCore, gesMainMetric, @@ -48,7 +48,8 @@ module GEval.Core FileProcessingOptions(..), readHeaderFileWrapper, getInHeader, - getOutHeader + getOutHeader, + addPreprocessing, ) where import Debug.Trace @@ -266,22 +267,8 @@ data LineSource m = LineSource (ConduitT () Text m ()) (Text -> ItemTarget) (Tex geval :: GEvalSpecification -> IO [(SourceSpec, [MetricOutput])] geval gevalSpec = do - mInHeader <- readHeaderFileWrapper $ getInHeader gevalSpec - mOutHeader <- readHeaderFileWrapper $ getOutHeader gevalSpec - (inputSource, expectedSource, outSources) <- checkAndGetFiles False gevalSpec - let chDataSource = ChallengeDataSource { - challengeDataSourceInput = inputSource, - challengeDataSourceExpected = expectedSource, - challengeDataSourceSelector = gesSelector gevalSpec, - challengeDataSourcePreprocess = gesPreprocess gevalSpec, - challengeDataSourceFilter = Nothing, - challengeDataSourceInHeader = mInHeader, - challengeDataSourceOutHeader = mOutHeader } - - results <- Prelude.mapM (\outSource -> gevalOnSingleOut gevalSpec - DataSource { - dataSourceChallengeData = chDataSource, - dataSourceOut = outSource }) outSources + dataSources <- checkAndGetDataSources False gevalSpec + results <- Prelude.mapM (gevalOnSingleOut gevalSpec) dataSources return $ sortBy (\a b -> (show $ fst a) `naturalComp` (show $ fst b)) results noGraph :: d -> Maybe GraphSeries @@ -313,15 +300,15 @@ readHeaderFileWrapper (Just headerFilePath) = do Just header -> return $ Just header Nothing -> throwM $ NoHeaderFile headerFilePath -checkAndGetFilesSingleOut :: Bool -> GEvalSpecification -> IO (SourceSpec, SourceSpec, SourceSpec) -checkAndGetFilesSingleOut forceInput gevalSpec = do - res <- checkAndGetFiles forceInput gevalSpec +checkAndGetDataSource :: Bool -> GEvalSpecification -> IO DataSource +checkAndGetDataSource forceInput gevalSpec = do + res <- checkAndGetDataSources forceInput gevalSpec case res of - (inputSource, expectedSource, [outSource]) -> return (inputSource, expectedSource, outSource) + ([dataSource]) -> return dataSource _ -> throwM $ UnexpectedMultipleOutputs -checkAndGetFiles :: Bool -> GEvalSpecification -> IO (SourceSpec, SourceSpec, [SourceSpec]) -checkAndGetFiles forceInput gevalSpec = do +checkAndGetDataSources :: Bool -> GEvalSpecification -> IO [DataSource] +checkAndGetDataSources forceInput gevalSpec = do ess <- getSmartSourceSpec expectedTestDirectory defaultExpectedFile expectedFile case ess of Left NoSpecGiven -> throwM $ NoExpectedFile expectedFile @@ -348,7 +335,22 @@ checkAndGetFiles forceInput gevalSpec = do throwM $ NoOutFile outFile Right outSource -> do return [outSource] - return (inputSource, expectedSource, osss) + + mInHeader <- readHeaderFileWrapper $ getInHeader gevalSpec + mOutHeader <- readHeaderFileWrapper $ getOutHeader gevalSpec + + let chDataSource = ChallengeDataSource { + challengeDataSourceInput = inputSource, + challengeDataSourceExpected = expectedSource, + challengeDataSourceSelector = mSelector, + challengeDataSourcePreprocess = preprocess, + challengeDataSourceFilter = Nothing, + challengeDataSourceInHeader = mInHeader, + challengeDataSourceOutHeader = mOutHeader } + + return $ Prelude.map (\oss -> DataSource { + dataSourceChallengeData = chDataSource, + dataSourceOut = oss}) osss where expectedTestDirectory = expectedDirectory testName outTestDirectory = outDirectory testName expectedDirectory = getExpectedDirectory gevalSpec @@ -359,6 +361,9 @@ checkAndGetFiles forceInput gevalSpec = do inputFile = gesInputFile gevalSpec schemes = gesMetrics gevalSpec + mSelector = gesSelector gevalSpec + preprocess = gesPreprocess gevalSpec + checkSingleOut :: FilePath -> FilePath -> IO (Either SmartSourceError SourceSpec) checkSingleOut outTestDirectory outFile | outFile == defaultOutFile = do diff --git a/src/GEval/LineByLine.hs b/src/GEval/LineByLine.hs index 8b28bc9..3df74a1 100644 --- a/src/GEval/LineByLine.hs +++ b/src/GEval/LineByLine.hs @@ -474,26 +474,11 @@ runLineByLineGeneralized ordering spec consum = do references <- readReferences referencesFp return $ Just references Nothing -> return Nothing - (inputFilePath, expectedFilePath, outFilePath) <- checkAndGetFilesSingleOut True spec - mInHeader <- readHeaderFileWrapper $ getInHeader spec - mOutHeader <- readHeaderFileWrapper $ getOutHeader spec - let mOutHeader = Nothing - let chDataSource = ChallengeDataSource { - challengeDataSourceInput = inputFilePath, - challengeDataSourceExpected = expectedFilePath, - challengeDataSourceSelector = mSelector, - challengeDataSourcePreprocess = preprocess, - challengeDataSourceFilter = Nothing, - challengeDataSourceInHeader = mInHeader, - challengeDataSourceOutHeader = mOutHeader } - let dataSource = DataSource { - dataSourceChallengeData = chDataSource, - dataSourceOut = outFilePath } + dataSource' <- checkAndGetDataSource True spec + let dataSource = addPreprocessing (applyPreprocessingOperations scheme) dataSource' gevalLineByLineCore metric dataSource (sorter ordering .| consum mReferences) where metric = gesMainMetric spec scheme = gesMainScheme spec - mSelector = gesSelector spec - preprocess = (gesPreprocess spec) . (applyPreprocessingOperations scheme) sorter KeepTheOriginalOrder = doNothing sorter ordering = gobbleAndDo $ sortBy (sortOrder ordering (getMetricOrdering metric)) sortOrder FirstTheWorst TheHigherTheBetter = compareScores @@ -540,21 +525,14 @@ runOracleItemBased spec = runMultiOutputGeneralized spec consum runMultiOutputGeneralized :: GEvalSpecification -> ConduitT [LineRecord] Void (ResourceT IO) () -> IO () runMultiOutputGeneralized spec consum = do - (inputSource, expectedSource, outSource) <- checkAndGetFilesSingleOut True spec + dataSource' <- checkAndGetDataSource True spec + let dataSource = addPreprocessing (applyPreprocessingOperations scheme) dataSource' let (Just altOuts) = gesAltOutFiles spec altSourceSpecs' <- mapM (getSmartSourceSpec ((gesOutDirectory spec) (gesTestName spec)) "out.tsv") altOuts let altSourceSpecs = rights altSourceSpecs' + let outSource = dataSourceOut dataSource let sourceSpecs = (outSource:altSourceSpecs) - mInHeader <- readHeaderFileWrapper $ getInHeader spec - mOutHeader <- readHeaderFileWrapper $ getOutHeader spec - let chDataSource = ChallengeDataSource { - challengeDataSourceInput = inputSource, - challengeDataSourceExpected = expectedSource, - challengeDataSourceSelector = mSelector, - challengeDataSourcePreprocess = preprocess, - challengeDataSourceFilter = Nothing, - challengeDataSourceInHeader = mInHeader, - challengeDataSourceOutHeader = mOutHeader } + let chDataSource = dataSourceChallengeData dataSource let sources = Prelude.map (\s -> gevalLineByLineSource metric DataSource { dataSourceChallengeData = chDataSource, dataSourceOut = s}) sourceSpecs @@ -562,8 +540,6 @@ runMultiOutputGeneralized spec consum = do (sequenceSources sources .| consum) where metric = gesMainMetric spec scheme = gesMainScheme spec - preprocess = (gesPreprocess spec) . (applyPreprocessingOperations scheme) - mSelector = gesSelector spec runMostWorseningFeatures :: ResultOrdering -> FilePath -> GEvalSpecification -> BlackBoxDebuggingOptions -> IO () runMostWorseningFeatures ordering otherOut spec bbdo = do @@ -585,29 +561,17 @@ runMostWorseningFeatures ordering otherOut spec bbdo = do runDiffGeneralized :: ResultOrdering -> FilePath -> GEvalSpecification -> (Maybe References -> ConduitT (LineRecord, LineRecord) Void (ResourceT IO) a) -> IO a runDiffGeneralized ordering otherOut spec consum = do - (inputSource, expectedSource, outSource) <- checkAndGetFilesSingleOut True spec + dataSourceB <- checkAndGetDataSource True spec ooss <- getSmartSourceSpec ((gesOutDirectory spec) (gesTestName spec)) "out.tsv" otherOut - mInHeader <- readHeaderFileWrapper $ getInHeader spec - mOutHeader <- readHeaderFileWrapper $ getOutHeader spec case ooss of Left NoSpecGiven -> throwM $ NoOutFile otherOut Left (NoFile fp) -> throwM $ NoOutFile fp Left (NoDirectory d) -> throwM $ NoOutFile otherOut Right otherOutSource -> do - let chDataSource = ChallengeDataSource { - challengeDataSourceInput = inputSource, - challengeDataSourceExpected = expectedSource, - challengeDataSourceSelector = mSelector, - challengeDataSourcePreprocess = preprocess, - challengeDataSourceFilter = Nothing, - challengeDataSourceInHeader = mInHeader, - challengeDataSourceOutHeader = mOutHeader } + let chDataSource = dataSourceChallengeData dataSourceB let dataSourceA = DataSource { dataSourceChallengeData = chDataSource, dataSourceOut = otherOutSource} - let dataSourceB = DataSource { - dataSourceChallengeData = chDataSource, - dataSourceOut = outSource} let sourceA = gevalLineByLineSource metric dataSourceA let sourceB = gevalLineByLineSource metric dataSourceB runResourceT $ runConduit $