multiple outs are recognised but not handled
This commit is contained in:
parent
656a194f42
commit
ba26cdb9e0
@ -60,6 +60,7 @@ library
|
||||
, transformers-base
|
||||
, bzlib-conduit
|
||||
, lzma-conduit
|
||||
, Glob
|
||||
default-language: Haskell2010
|
||||
|
||||
executable geval
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user