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