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 , transformers-base
, bzlib-conduit , bzlib-conduit
, lzma-conduit , lzma-conduit
, Glob
default-language: Haskell2010 default-language: Haskell2010
executable geval executable geval

View File

@ -36,6 +36,7 @@ module GEval.Core
ParserSpec(..), ParserSpec(..),
fileAsLineSource, fileAsLineSource,
checkAndGetFiles, checkAndGetFiles,
checkAndGetFilesSingleOut,
gesMainMetric gesMainMetric
) where ) where
@ -81,6 +82,8 @@ import Data.Proxy
import Data.Word import Data.Word
import System.FilePath.Glob
type MetricValue = Double type MetricValue = Double
defaultLogLossHashedSize :: Word32 defaultLogLossHashedSize :: Word32
@ -226,6 +229,7 @@ data GEvalException = NoExpectedFile FilePath
| TooManyLinesInInput | TooManyLinesInInput
| EmptyOutput | EmptyOutput
| UnexpectedData Word32 String | UnexpectedData Word32 String
| UnexpectedMultipleOutputs
deriving (Eq) deriving (Eq)
instance Exception GEvalException instance Exception GEvalException
@ -245,6 +249,7 @@ instance Show GEvalException where
show TooManyLinesInInput = "Too many lines in the input file" show TooManyLinesInInput = "Too many lines in the input file"
show EmptyOutput = "The output file is empty" show EmptyOutput = "The output file is empty"
show (UnexpectedData lineNo message) = "Line " ++ (show lineNo) ++ ": Unexpected data [" ++ message ++ "]" 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 :: String -> FilePath -> String
somethingWrongWithFilesMessage msg filePath = Prelude.concat somethingWrongWithFilesMessage msg filePath = Prelude.concat
@ -270,43 +275,75 @@ data LineSource m = LineSource (Source m Text) SourceSpec Word32
geval :: GEvalSpecification -> IO [(SourceSpec, [MetricValue])] geval :: GEvalSpecification -> IO [(SourceSpec, [MetricValue])]
geval gevalSpec = do geval gevalSpec = do
(inputSource, expectedSource, outSource) <- checkAndGetFiles False gevalSpec (inputSource, expectedSource, outSources) <- checkAndGetFiles False gevalSpec
results <- Prelude.mapM (\metric -> gevalCore metric inputSource expectedSource outSource) metrics case outSources of
return [(outSource, results)] [outSource] -> do
where metrics = gesMetrics gevalSpec 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 checkAndGetFiles forceInput gevalSpec = do
oss <- getSmartSourceSpec outTestDirectory "out.tsv" outFile ess <- getSmartSourceSpec expectedTestDirectory "expected.tsv" expectedFile
case oss of case ess of
Left NoSpecGiven -> throwM $ NoOutFile outFile Left NoSpecGiven -> throwM $ NoExpectedFile expectedFile
Left (NoFile fp) -> throwM $ NoOutFile fp Left (NoFile fp) -> throwM $ NoExpectedFile fp
Left (NoDirectory d) -> do Left (NoDirectory d) -> do
unlessM (D.doesDirectoryExist outDirectory) $ throwM $ NoOutDirectory outDirectory unlessM (D.doesDirectoryExist expectedDirectory) $ throwM $ NoExpectedDirectory expectedDirectory
unlessM (D.doesDirectoryExist outTestDirectory) $ throwM $ NoOutTestDirectory outTestDirectory unlessM (D.doesDirectoryExist expectedTestDirectory) $ throwM $ NoExpectedTestDirectory expectedTestDirectory
throwM $ NoOutFile outFile throwM $ NoExpectedDirectory d
Right outSource -> do Right expectedSource -> do
ess <- getSmartSourceSpec expectedTestDirectory "expected.tsv" expectedFile -- in most cases inputSource is NoSource (unless needed by a metric or in the line-by-line mode)
case ess of inputSource <- getInputSourceIfNeeded forceInput metrics expectedTestDirectory inputFile
Left NoSpecGiven -> throwM $ NoExpectedFile expectedFile
Left (NoFile fp) -> throwM $ NoExpectedFile fp mMultipleOuts <- checkMultipleOuts gevalSpec
Left (NoDirectory d) -> do osss <- case mMultipleOuts of
unlessM (D.doesDirectoryExist expectedDirectory) $ throwM $ NoExpectedDirectory expectedDirectory Just filePaths -> return $ Prelude.map (\fp -> FilePathSpec fp) filePaths
unlessM (D.doesDirectoryExist expectedTestDirectory) $ throwM $ NoExpectedTestDirectory expectedTestDirectory Nothing -> do
throwM $ NoExpectedDirectory d oss <- getSmartSourceSpec outTestDirectory "out.tsv" outFile
Right expectedSource -> do case oss of
-- in most cases inputSource is NoSource (unless needed by a metric or in the line-by-line mode) Left NoSpecGiven -> throwM $ NoOutFile outFile
inputSource <- getInputSourceIfNeeded forceInput metrics expectedTestDirectory inputFile Left (NoFile fp) -> throwM $ NoOutFile fp
return (inputSource, expectedSource, outSource) Left (NoDirectory d) -> do
where expectedTestDirectory = expectedDirectory </> testName unlessM (D.doesDirectoryExist outDirectory) $ throwM $ NoOutDirectory outDirectory
outTestDirectory = outDirectory </> testName unlessM (D.doesDirectoryExist outTestDirectory) $ throwM $ NoOutTestDirectory outTestDirectory
expectedDirectory = getExpectedDirectory gevalSpec throwM $ NoOutFile outFile
outDirectory = gesOutDirectory gevalSpec Right outSource -> do
testName = gesTestName gevalSpec return [outSource]
outFile = gesOutFile gevalSpec return (inputSource, expectedSource, osss)
expectedFile = gesExpectedFile gevalSpec where expectedTestDirectory = expectedDirectory </> testName
inputFile = gesInputFile gevalSpec outTestDirectory = outDirectory </> testName
metrics = gesMetrics gevalSpec expectedDirectory = getExpectedDirectory gevalSpec
outDirectory = gesOutDirectory gevalSpec
testName = gesTestName gevalSpec
outFile = gesOutFile gevalSpec
expectedFile = gesExpectedFile gevalSpec
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 :: GEvalSpecification -> FilePath -> FilePath
getOutFile gevalSpec out = outDirectory </> testName </> out getOutFile gevalSpec out = outDirectory </> testName </> out

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 :: ResultOrdering -> GEvalSpecification -> ConduitT LineRecord Void (ResourceT IO) a -> IO a
runLineByLineGeneralized ordering spec consum = do 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) gevalLineByLineCore metric inputFilePath expectedFilePath outFilePath (sorter ordering .| consum)
where metric = gesMainMetric spec where metric = gesMainMetric spec
sorter KeepTheOriginalOrder = doNothing 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 :: ResultOrdering -> FilePath -> GEvalSpecification -> ConduitT (LineRecord, LineRecord) Void (ResourceT IO) a -> IO a
runDiffGeneralized ordering otherOut spec consum = do 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 ooss <- getSmartSourceSpec ((gesOutDirectory spec) </> (gesTestName spec)) "out.tsv" otherOut
case ooss of case ooss of
Left NoSpecGiven -> throwM $ NoOutFile otherOut Left NoSpecGiven -> throwM $ NoOutFile otherOut