multiple outs are recognised but not handled

This commit is contained in:
Filip Graliński 2018-06-28 15:36:47 +02:00
parent 656a194f42
commit ba26cdb9e0
3 changed files with 74 additions and 36 deletions

View File

@ -60,6 +60,7 @@ library
, transformers-base
, bzlib-conduit
, lzma-conduit
, Glob
default-language: Haskell2010
executable geval

View File

@ -36,6 +36,7 @@ module GEval.Core
ParserSpec(..),
fileAsLineSource,
checkAndGetFiles,
checkAndGetFilesSingleOut,
gesMainMetric
) where
@ -81,6 +82,8 @@ import Data.Proxy
import Data.Word
import System.FilePath.Glob
type MetricValue = Double
defaultLogLossHashedSize :: Word32
@ -226,6 +229,7 @@ data GEvalException = NoExpectedFile FilePath
| TooManyLinesInInput
| EmptyOutput
| UnexpectedData Word32 String
| UnexpectedMultipleOutputs
deriving (Eq)
instance Exception GEvalException
@ -245,6 +249,7 @@ instance Show GEvalException where
show TooManyLinesInInput = "Too many lines in the input file"
show EmptyOutput = "The output file is empty"
show (UnexpectedData lineNo message) = "Line " ++ (show lineNo) ++ ": Unexpected data [" ++ message ++ "]"
show UnexpectedMultipleOutputs = "Multiple outputs are not possible in this mode"
somethingWrongWithFilesMessage :: String -> FilePath -> String
somethingWrongWithFilesMessage msg filePath = Prelude.concat
@ -270,22 +275,23 @@ data LineSource m = LineSource (Source m Text) SourceSpec Word32
geval :: GEvalSpecification -> IO [(SourceSpec, [MetricValue])]
geval gevalSpec = do
(inputSource, expectedSource, outSource) <- checkAndGetFiles False gevalSpec
(inputSource, expectedSource, outSources) <- checkAndGetFiles False gevalSpec
case outSources of
[outSource] -> do
results <- Prelude.mapM (\metric -> gevalCore metric inputSource expectedSource outSource) metrics
return [(outSource, results)]
_ -> error $ "multiple outputs not handled yet"
where metrics = gesMetrics gevalSpec
checkAndGetFiles :: Bool -> GEvalSpecification -> IO (SourceSpec, SourceSpec, SourceSpec)
checkAndGetFilesSingleOut :: Bool -> GEvalSpecification -> IO (SourceSpec, SourceSpec, SourceSpec)
checkAndGetFilesSingleOut forceInput gevalSpec = do
res <- checkAndGetFiles forceInput gevalSpec
case res of
(inputSource, expectedSource, [outSource]) -> return (inputSource, expectedSource, outSource)
_ -> throwM $ UnexpectedMultipleOutputs
checkAndGetFiles :: Bool -> GEvalSpecification -> IO (SourceSpec, SourceSpec, [SourceSpec])
checkAndGetFiles forceInput gevalSpec = do
oss <- getSmartSourceSpec outTestDirectory "out.tsv" outFile
case oss of
Left NoSpecGiven -> throwM $ NoOutFile outFile
Left (NoFile fp) -> throwM $ NoOutFile fp
Left (NoDirectory d) -> do
unlessM (D.doesDirectoryExist outDirectory) $ throwM $ NoOutDirectory outDirectory
unlessM (D.doesDirectoryExist outTestDirectory) $ throwM $ NoOutTestDirectory outTestDirectory
throwM $ NoOutFile outFile
Right outSource -> do
ess <- getSmartSourceSpec expectedTestDirectory "expected.tsv" expectedFile
case ess of
Left NoSpecGiven -> throwM $ NoExpectedFile expectedFile
@ -297,7 +303,22 @@ checkAndGetFiles forceInput gevalSpec = do
Right expectedSource -> do
-- in most cases inputSource is NoSource (unless needed by a metric or in the line-by-line mode)
inputSource <- getInputSourceIfNeeded forceInput metrics expectedTestDirectory inputFile
return (inputSource, expectedSource, outSource)
mMultipleOuts <- checkMultipleOuts gevalSpec
osss <- case mMultipleOuts of
Just filePaths -> return $ Prelude.map (\fp -> FilePathSpec fp) filePaths
Nothing -> do
oss <- getSmartSourceSpec outTestDirectory "out.tsv" outFile
case oss of
Left NoSpecGiven -> throwM $ NoOutFile outFile
Left (NoFile fp) -> throwM $ NoOutFile fp
Left (NoDirectory d) -> do
unlessM (D.doesDirectoryExist outDirectory) $ throwM $ NoOutDirectory outDirectory
unlessM (D.doesDirectoryExist outTestDirectory) $ throwM $ NoOutTestDirectory outTestDirectory
throwM $ NoOutFile outFile
Right outSource -> do
return [outSource]
return (inputSource, expectedSource, osss)
where expectedTestDirectory = expectedDirectory </> testName
outTestDirectory = outDirectory </> testName
expectedDirectory = getExpectedDirectory gevalSpec
@ -308,6 +329,22 @@ checkAndGetFiles forceInput gevalSpec = do
inputFile = gesInputFile gevalSpec
metrics = gesMetrics gevalSpec
checkMultipleOuts :: GEvalSpecification -> IO (Maybe [FilePath])
checkMultipleOuts gevalSpec = do
isSimpleOutThere <- D.doesFileExist (outTestDirectory </> outFile)
let patterns = Prelude.map (\ext -> compile ("out-*" ++ ext)) ["", ".gz", ".bz2", ".xz"]
multipleOuts <- Prelude.concat <$> globDir patterns outTestDirectory
if outFile == "out.tsv" && not isSimpleOutThere && multipleOuts /= []
then
return $ Just multipleOuts
else
return Nothing
where outFile = gesOutFile gevalSpec
outTestDirectory = outDirectory </> testName
outDirectory = gesOutDirectory gevalSpec
testName = gesTestName gevalSpec
getOutFile :: GEvalSpecification -> FilePath -> FilePath
getOutFile gevalSpec out = outDirectory </> testName </> out
where outDirectory = gesOutDirectory gevalSpec

View File

@ -56,7 +56,7 @@ runLineByLine ordering spec = runLineByLineGeneralized ordering spec consum
runLineByLineGeneralized :: ResultOrdering -> GEvalSpecification -> ConduitT LineRecord Void (ResourceT IO) a -> IO a
runLineByLineGeneralized ordering spec consum = do
(inputFilePath, expectedFilePath, outFilePath) <- checkAndGetFiles True spec
(inputFilePath, expectedFilePath, outFilePath) <- checkAndGetFilesSingleOut True spec
gevalLineByLineCore metric inputFilePath expectedFilePath outFilePath (sorter ordering .| consum)
where metric = gesMainMetric spec
sorter KeepTheOriginalOrder = doNothing
@ -88,7 +88,7 @@ runDiff ordering otherOut spec = runDiffGeneralized ordering otherOut spec consu
runDiffGeneralized :: ResultOrdering -> FilePath -> GEvalSpecification -> ConduitT (LineRecord, LineRecord) Void (ResourceT IO) a -> IO a
runDiffGeneralized ordering otherOut spec consum = do
(inputSource, expectedSource, outSource) <- checkAndGetFiles True spec
(inputSource, expectedSource, outSource) <- checkAndGetFilesSingleOut True spec
ooss <- getSmartSourceSpec ((gesOutDirectory spec) </> (gesTestName spec)) "out.tsv" otherOut
case ooss of
Left NoSpecGiven -> throwM $ NoOutFile otherOut