multiple outs are recognised but not handled
This commit is contained in:
parent
656a194f42
commit
ba26cdb9e0
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user