From 0c6032d166b32a30b2ad81cf891b55b929927f9a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Filip=20Grali=C5=84ski?= <filipg@amu.edu.pl>
Date: Tue, 10 Jul 2018 16:22:28 +0200
Subject: [PATCH] print params

---
 app/Main.hs              | 47 +++++++++++++++++++++++++++++++---------
 geval.cabal              |  3 +++
 src/GEval/ParseParams.hs | 10 ++++++++-
 3 files changed, 49 insertions(+), 11 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 43703ac..f7a8db6 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -2,6 +2,7 @@ module Main where
 
 import GEval.Core
 import GEval.OptionsParser
+import GEval.ParseParams
 
 import System.Environment
 import Options.Applicative
@@ -15,7 +16,12 @@ import Data.Conduit.SmartSource
 
 import System.FilePath
 
-import Data.List (intercalate)
+import Data.List (intercalate, sort)
+
+import qualified Data.Text as T
+
+import Data.Map.Strict as M
+import Data.Set as S
 
 main :: IO ()
 main = do
@@ -33,16 +39,37 @@ 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
+  let params = Prelude.map (\(ss, _) -> parseParamsFromSourceSpec ss) multipleResults
+
+  let paramNames =
+        sort
+        $ S.toList
+        $ S.unions
+        $ Prelude.map (\(OutputFileParsed _ m) -> M.keysSet m)
+        $ params
+
+  case getHeader paramNames metrics of
+    Just header -> putStrLn header
+    Nothing -> return ()
+
+  mapM_ (\entry -> putStrLn $ formatTableEntry opts paramNames entry) $ zip multipleResults params
   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
+getHeader :: [T.Text] -> [Metric] -> Maybe String
+getHeader [] [singleMetric] = Nothing
+getHeader [] [] = error "no metric given"
+getHeader [] metrics = Just $ intercalate "\t" ("File name" : Prelude.map show metrics)
+getHeader params metrics = Just $ intercalate "\t" (Prelude.map T.unpack params
+                                                    ++ Prelude.map show metrics)
+
+formatTableEntry :: GEvalOptions -> [T.Text] -> ((SourceSpec, [MetricValue]), OutputFileParsed) -> String
+formatTableEntry opts paramNames ((sourceSpec, metrics), ofParsed) = intercalate "\t" ((initialColumns paramNames sourceSpec ofParsed) ++ vals)
+   where vals = Prelude.map (formatTheResult (gesPrecision $ geoSpec opts)) metrics
+
+initialColumns :: [T.Text] -> SourceSpec -> OutputFileParsed -> [String]
+initialColumns [] sourceSpec ofParsed = [formatSourceSpec sourceSpec]
+initialColumns params sourceSpec (OutputFileParsed _ paramMap) =
+  Prelude.map (\p -> T.unpack $ M.findWithDefault (T.pack "") p paramMap) params
 
 showTheResult' :: GEvalOptions -> [MetricValue] -> IO ()
 -- do not show the metric if just one was given
@@ -50,7 +77,7 @@ showTheResult' opts [val] = putStrLn $ formatTheResult (gesPrecision $ geoSpec o
 showTheResult' opts [] = do
   hPutStrLn stderr "no metric given, use --metric option"
   exitFailure
-showTheResult' opts vals =  mapM_ putStrLn $ map (formatTheMetricAndResult (gesPrecision $ geoSpec opts)) $ zip (gesMetrics $ geoSpec opts) vals
+showTheResult' opts vals =  mapM_ putStrLn $ Prelude.map (formatTheMetricAndResult (gesPrecision $ geoSpec opts)) $ zip (gesMetrics $ geoSpec opts) vals
 
 formatSourceSpec :: SourceSpec -> String
 formatSourceSpec (FilePathSpec fp) = dropExtensions $ takeFileName fp
diff --git a/geval.cabal b/geval.cabal
index 42ceba1..c2990e3 100644
--- a/geval.cabal
+++ b/geval.cabal
@@ -75,6 +75,9 @@ executable geval
                      , optparse-applicative
                      , fgl
                      , filepath
+                     , containers
+                     , unordered-containers
+                     , text
   default-language:    Haskell2010
 
 test-suite geval-test
diff --git a/src/GEval/ParseParams.hs b/src/GEval/ParseParams.hs
index eaaeb43..0b0027a 100644
--- a/src/GEval/ParseParams.hs
+++ b/src/GEval/ParseParams.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module GEval.ParseParams(parseParamsFromFilePath,OutputFileParsed(..))
+module GEval.ParseParams(parseParamsFromFilePath,
+                         parseParamsFromSourceSpec,
+                         OutputFileParsed(..))
        where
 
 import Data.Map.Strict as M
@@ -9,9 +11,15 @@ import Data.Attoparsec.Text
 
 import System.FilePath
 
+import Data.Conduit.SmartSource (SourceSpec(..), recoverPath)
+
 data OutputFileParsed = OutputFileParsed String (M.Map Text Text)
                         deriving (Eq, Show)
 
+parseParamsFromSourceSpec :: SourceSpec -> OutputFileParsed
+parseParamsFromSourceSpec (FilePathSpec filePath) = parseParamsFromFilePath filePath
+parseParamsFromSourceSpec spec = OutputFileParsed (recoverPath spec) M.empty
+
 parseParamsFromFilePath :: FilePath -> OutputFileParsed
 parseParamsFromFilePath filePath = parseParamsFromBaseName fileBaseName
   where fileBaseName = dropExtensions $ takeBaseName filePath