Refactor code
This commit is contained in:
parent
2f348dd616
commit
991ce3f09b
@ -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
|
||||
|
@ -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 $
|
||||
|
Loading…
Reference in New Issue
Block a user