fully handle multiple outputs
This commit is contained in:
parent
ba26cdb9e0
commit
338ddb7fbf
24
app/Main.hs
24
app/Main.hs
@ -13,6 +13,10 @@ import System.Exit
|
|||||||
|
|
||||||
import Data.Conduit.SmartSource
|
import Data.Conduit.SmartSource
|
||||||
|
|
||||||
|
import System.FilePath
|
||||||
|
|
||||||
|
import Data.List (intercalate)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
@ -24,7 +28,21 @@ main = do
|
|||||||
|
|
||||||
showTheResult :: GEvalOptions -> [(SourceSpec, [MetricValue])] -> IO ()
|
showTheResult :: GEvalOptions -> [(SourceSpec, [MetricValue])] -> IO ()
|
||||||
showTheResult opts [(_, vals)] = showTheResult' opts vals
|
showTheResult opts [(_, vals)] = showTheResult' opts vals
|
||||||
showTheResult _ _ = error "multiple outputs not handled yet"
|
showTheResult opts [] = error "no output given"
|
||||||
|
showTheResult opts multipleResults = showTable opts multipleResults
|
||||||
|
|
||||||
|
showTable :: GEvalOptions -> [(SourceSpec, [MetricValue])] -> IO ()
|
||||||
|
showTable opts multipleResults = do
|
||||||
|
case metrics of
|
||||||
|
[singleMetric] -> return ()
|
||||||
|
[] -> error "no metric given"
|
||||||
|
metrics -> putStrLn $ intercalate "\t" ("File name" : map show metrics)
|
||||||
|
mapM_ (\entry -> putStrLn $ formatTableEntry opts entry) multipleResults
|
||||||
|
where metrics = gesMetrics $ geoSpec opts
|
||||||
|
|
||||||
|
formatTableEntry :: GEvalOptions -> (SourceSpec, [MetricValue]) -> String
|
||||||
|
formatTableEntry opts (sourceSpec, metrics) = intercalate "\t" (formatSourceSpec sourceSpec : vals)
|
||||||
|
where vals = map (formatTheResult (gesPrecision $ geoSpec opts)) metrics
|
||||||
|
|
||||||
showTheResult' :: GEvalOptions -> [MetricValue] -> IO ()
|
showTheResult' :: GEvalOptions -> [MetricValue] -> IO ()
|
||||||
-- do not show the metric if just one was given
|
-- do not show the metric if just one was given
|
||||||
@ -34,6 +52,10 @@ showTheResult' opts [] = do
|
|||||||
exitFailure
|
exitFailure
|
||||||
showTheResult' opts vals = mapM_ putStrLn $ map (formatTheMetricAndResult (gesPrecision $ geoSpec opts)) $ zip (gesMetrics $ geoSpec opts) vals
|
showTheResult' opts vals = mapM_ putStrLn $ map (formatTheMetricAndResult (gesPrecision $ geoSpec opts)) $ zip (gesMetrics $ geoSpec opts) vals
|
||||||
|
|
||||||
|
formatSourceSpec :: SourceSpec -> String
|
||||||
|
formatSourceSpec (FilePathSpec fp) = dropExtensions $ takeFileName fp
|
||||||
|
formatSourceSpec spec = show spec
|
||||||
|
|
||||||
formatTheMetricAndResult :: Maybe Int -> (Metric, MetricValue) -> String
|
formatTheMetricAndResult :: Maybe Int -> (Metric, MetricValue) -> String
|
||||||
formatTheMetricAndResult mPrecision (metric, val) = (show metric) ++ "\t" ++ (formatTheResult mPrecision val)
|
formatTheMetricAndResult mPrecision (metric, val) = (show metric) ++ "\t" ++ (formatTheResult mPrecision val)
|
||||||
|
|
||||||
|
@ -71,6 +71,7 @@ executable geval
|
|||||||
, geval
|
, geval
|
||||||
, optparse-applicative
|
, optparse-applicative
|
||||||
, fgl
|
, fgl
|
||||||
|
, filepath
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
test-suite geval-test
|
test-suite geval-test
|
||||||
|
@ -276,11 +276,12 @@ 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, outSources) <- checkAndGetFiles False gevalSpec
|
(inputSource, expectedSource, outSources) <- checkAndGetFiles False gevalSpec
|
||||||
case outSources of
|
Prelude.mapM (gevalOnSingleOut gevalSpec inputSource expectedSource) outSources
|
||||||
[outSource] -> do
|
|
||||||
results <- Prelude.mapM (\metric -> gevalCore metric inputSource expectedSource outSource) metrics
|
gevalOnSingleOut :: GEvalSpecification -> SourceSpec -> SourceSpec -> SourceSpec -> IO (SourceSpec, [MetricValue])
|
||||||
return [(outSource, results)]
|
gevalOnSingleOut gevalSpec inputSource expectedSource outSource = do
|
||||||
_ -> error $ "multiple outputs not handled yet"
|
vals <- Prelude.mapM (\metric -> gevalCore metric inputSource expectedSource outSource) metrics
|
||||||
|
return (outSource, vals)
|
||||||
where metrics = gesMetrics gevalSpec
|
where metrics = gesMetrics gevalSpec
|
||||||
|
|
||||||
checkAndGetFilesSingleOut :: Bool -> GEvalSpecification -> IO (SourceSpec, SourceSpec, SourceSpec)
|
checkAndGetFilesSingleOut :: Bool -> GEvalSpecification -> IO (SourceSpec, SourceSpec, SourceSpec)
|
||||||
@ -332,7 +333,7 @@ checkAndGetFiles forceInput gevalSpec = do
|
|||||||
checkMultipleOuts :: GEvalSpecification -> IO (Maybe [FilePath])
|
checkMultipleOuts :: GEvalSpecification -> IO (Maybe [FilePath])
|
||||||
checkMultipleOuts gevalSpec = do
|
checkMultipleOuts gevalSpec = do
|
||||||
isSimpleOutThere <- D.doesFileExist (outTestDirectory </> outFile)
|
isSimpleOutThere <- D.doesFileExist (outTestDirectory </> outFile)
|
||||||
let patterns = Prelude.map (\ext -> compile ("out-*" ++ ext)) ["", ".gz", ".bz2", ".xz"]
|
let patterns = Prelude.map (\ext -> compile ("out-*.tsv" ++ ext)) ["", ".gz", ".bz2", ".xz"]
|
||||||
multipleOuts <- Prelude.concat <$> globDir patterns outTestDirectory
|
multipleOuts <- Prelude.concat <$> globDir patterns outTestDirectory
|
||||||
if outFile == "out.tsv" && not isSimpleOutThere && multipleOuts /= []
|
if outFile == "out.tsv" && not isSimpleOutThere && multipleOuts /= []
|
||||||
then
|
then
|
||||||
|
Loading…
Reference in New Issue
Block a user