Refactor code

This commit is contained in:
Filip Gralinski 2020-05-12 21:08:10 +02:00
parent 2f348dd616
commit 991ce3f09b
2 changed files with 39 additions and 70 deletions

View File

@ -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

View File

@ -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 $