print params

This commit is contained in:
Filip Graliński 2018-07-10 16:22:28 +02:00
parent 9f5882719b
commit 0c6032d166
3 changed files with 49 additions and 11 deletions

View File

@ -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

View File

@ -75,6 +75,9 @@ executable geval
, optparse-applicative
, fgl
, filepath
, containers
, unordered-containers
, text
default-language: Haskell2010
test-suite geval-test

View File

@ -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