From 338ddb7fbfb563ec836acd7eb83f9d7b6afec4f8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Filip=20Grali=C5=84ski?= <filipg@amu.edu.pl>
Date: Thu, 28 Jun 2018 16:22:22 +0200
Subject: [PATCH] fully handle multiple outputs

---
 app/Main.hs       | 24 +++++++++++++++++++++++-
 geval.cabal       |  1 +
 src/GEval/Core.hs | 13 +++++++------
 3 files changed, 31 insertions(+), 7 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 9cb6434..43703ac 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -13,6 +13,10 @@ import System.Exit
 
 import Data.Conduit.SmartSource
 
+import System.FilePath
+
+import Data.List (intercalate)
+
 main :: IO ()
 main = do
   args <- getArgs
@@ -24,7 +28,21 @@ main = do
 
 showTheResult :: GEvalOptions -> [(SourceSpec, [MetricValue])] -> IO ()
 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 ()
 -- do not show the metric if just one was given
@@ -34,6 +52,10 @@ showTheResult' opts [] = do
   exitFailure
 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 mPrecision (metric, val) = (show metric) ++ "\t" ++ (formatTheResult mPrecision val)
 
diff --git a/geval.cabal b/geval.cabal
index 362b741..640899c 100644
--- a/geval.cabal
+++ b/geval.cabal
@@ -71,6 +71,7 @@ executable geval
                      , geval
                      , optparse-applicative
                      , fgl
+                     , filepath
   default-language:    Haskell2010
 
 test-suite geval-test
diff --git a/src/GEval/Core.hs b/src/GEval/Core.hs
index a7994cf..cc328e5 100644
--- a/src/GEval/Core.hs
+++ b/src/GEval/Core.hs
@@ -276,11 +276,12 @@ data LineSource m = LineSource (Source m Text) SourceSpec Word32
 geval :: GEvalSpecification -> IO [(SourceSpec, [MetricValue])]
 geval gevalSpec = do
   (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"
+  Prelude.mapM (gevalOnSingleOut gevalSpec inputSource expectedSource) outSources
+
+gevalOnSingleOut :: GEvalSpecification -> SourceSpec -> SourceSpec -> SourceSpec -> IO (SourceSpec, [MetricValue])
+gevalOnSingleOut gevalSpec inputSource expectedSource outSource = do
+  vals <- Prelude.mapM (\metric -> gevalCore metric inputSource expectedSource outSource) metrics
+  return (outSource, vals)
   where metrics = gesMetrics gevalSpec
 
 checkAndGetFilesSingleOut :: Bool -> GEvalSpecification -> IO (SourceSpec, SourceSpec, SourceSpec)
@@ -332,7 +333,7 @@ checkAndGetFiles forceInput gevalSpec = do
 checkMultipleOuts :: GEvalSpecification -> IO (Maybe [FilePath])
 checkMultipleOuts gevalSpec = do
   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
   if outFile == "out.tsv" && not isSimpleOutThere && multipleOuts /= []
     then