diff

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

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,6 +44,32 @@ runLineByLine spec = do
            escapeTabs out]
          formatScore :: MetricValue -> Text
          formatScore = Data.Text.pack . printf "%f"
+
+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" "<tab>"
 
 gevalLineByLineCore :: Metric -> FilePath -> FilePath -> FilePath -> Sink LineRecord (ResourceT IO) () -> IO ()

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