diff --git a/src/GEval/Core.hs b/src/GEval/Core.hs index 0a43801..ba8d734 100644 --- a/src/GEval/Core.hs +++ b/src/GEval/Core.hs @@ -33,7 +33,8 @@ module GEval.Core EvaluationContext(..), ParserSpec(..), fileAsLineSource, - checkAndGetFiles + checkAndGetFiles, + getOutFile ) where import Data.Conduit @@ -154,7 +155,7 @@ getExpectedDirectory :: GEvalSpecification -> FilePath getExpectedDirectory spec = fromMaybe outDirectory $ gesExpectedDirectory spec where outDirectory = gesOutDirectory spec -data GEvalSpecialCommand = Init | LineByLine +data GEvalSpecialCommand = Init | LineByLine | Diff FilePath data GEvalOptions = GEvalOptions { geoSpecialCommand :: Maybe GEvalSpecialCommand, @@ -232,7 +233,7 @@ checkAndGetFiles gevalSpec = do checkInputFileIfNeeded metric inputFilePath return (inputFilePath, expectedFilePath, outFilePath) where expectedFilePath = expectedTestDirectory (gesExpectedFile gevalSpec) - outFilePath = outTestDirectory (gesOutFile gevalSpec) + outFilePath = getOutFile gevalSpec (gesOutFile gevalSpec) inputFilePath = expectedTestDirectory (gesInputFile gevalSpec) expectedTestDirectory = expectedDirectory testName outTestDirectory = outDirectory testName @@ -241,6 +242,11 @@ checkAndGetFiles gevalSpec = do testName = gesTestName gevalSpec metric = gesMetric gevalSpec +getOutFile :: GEvalSpecification -> FilePath -> FilePath +getOutFile gevalSpec out = outDirectory testName out + where outDirectory = gesOutDirectory gevalSpec + testName = gesTestName gevalSpec + checkInputFileIfNeeded :: Metric -> FilePath -> IO () checkInputFileIfNeeded CharMatch inputFilePath = do unlessM (D.doesFileExist inputFilePath) $ throwM $ NoInputFile inputFilePath diff --git a/src/GEval/LineByLine.hs b/src/GEval/LineByLine.hs index 750f11f..9afdf83 100644 --- a/src/GEval/LineByLine.hs +++ b/src/GEval/LineByLine.hs @@ -8,7 +8,8 @@ module GEval.LineByLine - (runLineByLine + (runLineByLine, + runDiff ) where import GEval.Core @@ -34,7 +35,6 @@ runLineByLine spec = do (inputFilePath, expectedFilePath, outFilePath) <- checkAndGetFiles spec gevalLineByLineCore metric inputFilePath expectedFilePath outFilePath consum where metric = gesMetric spec - justScore (LineRecord _ _ _ _ score) = score consum :: Consumer LineRecord (ResourceT IO) () consum = (CL.map (encodeUtf8 . formatOutput) =$= CC.unlinesAscii =$= CC.stdout) formatOutput (LineRecord inp exp out _ score) = Data.Text.intercalate "\t" [ @@ -44,7 +44,33 @@ runLineByLine spec = do escapeTabs out] formatScore :: MetricValue -> Text formatScore = Data.Text.pack . printf "%f" - escapeTabs = Data.Text.replace "\t" "" + +runDiff :: FilePath -> GEvalSpecification -> IO () +runDiff otherOut spec = do + let otherOutFilePath = getOutFile spec otherOut + (inputFilePath, expectedFilePath, outFilePath) <- checkAndGetFiles spec + let sourceA = gevalLineByLineSource metric inputFilePath expectedFilePath outFilePath + let sourceB = gevalLineByLineSource metric inputFilePath expectedFilePath otherOutFilePath + runResourceT $ + ((getZipSource $ (,) + <$> ZipSource sourceA + <*> ZipSource sourceB) $$ consum) + where metric = gesMetric spec + consum :: Consumer (LineRecord, LineRecord) (ResourceT IO) () + consum = (CL.filter shouldBeShown =$= CL.map (encodeUtf8 . formatOutput) =$= CC.unlinesAscii =$= CC.stdout) + shouldBeShown (LineRecord _ _ outA _ scoreA, LineRecord _ _ outB _ scoreB) = + outA /= outB && scoreA /= scoreB + formatOutput (LineRecord inp exp outA _ scoreA, LineRecord _ _ outB _ scoreB) = Data.Text.intercalate "\t" [ + formatScoreDiff (scoreB - scoreA), + escapeTabs inp, + escapeTabs exp, + escapeTabs outA, + escapeTabs outB] + formatScoreDiff :: Double -> Text + formatScoreDiff = Data.Text.pack . printf "%f" + +escapeTabs :: Text -> Text +escapeTabs = Data.Text.replace "\t" "" gevalLineByLineCore :: Metric -> FilePath -> FilePath -> FilePath -> Sink LineRecord (ResourceT IO) () -> IO () gevalLineByLineCore metric inputFilePath expectedFilePath outFilePath consum = diff --git a/src/GEval/OptionsParser.hs b/src/GEval/OptionsParser.hs index b440911..617d718 100644 --- a/src/GEval/OptionsParser.hs +++ b/src/GEval/OptionsParser.hs @@ -34,7 +34,13 @@ optionsParser = GEvalOptions (flag' LineByLine ( long "line-by-line" <> short 'l' - <> help "Give scores for each line rather than the whole test set" ))) + <> help "Give scores for each line rather than the whole test set" )) + <|> + (Diff <$> strOption + ( long "diff" + <> short 'd' + <> metavar "OTHER-OUT" + <> help "compare results"))) <*> specParser precisionArgParser :: Parser Int @@ -151,6 +157,9 @@ runGEval''' (Just Init) spec = do runGEval''' (Just LineByLine) spec = do runLineByLine spec return Nothing +runGEval''' (Just (Diff otherOut)) spec = do + runDiff otherOut spec + return Nothing initChallenge :: GEvalSpecification -> IO () initChallenge spec = case gesExpectedDirectory spec of