geval/app/Main.hs

94 lines
3.3 KiB
Haskell
Raw Normal View History

2015-08-17 23:32:00 +02:00
module Main where
2015-08-23 08:14:47 +02:00
import GEval.Core
2019-01-10 22:53:43 +01:00
import GEval.Common
2015-08-23 08:14:47 +02:00
import GEval.OptionsParser
2018-07-10 16:22:28 +02:00
import GEval.ParseParams
2015-08-17 23:32:00 +02:00
2015-08-23 08:14:47 +02:00
import System.Environment
2015-08-22 00:00:46 +02:00
import Options.Applicative
2015-09-12 15:36:50 +02:00
import Text.Printf
2018-06-08 12:38:45 +02:00
import System.IO
import System.Exit
import Data.Conduit.SmartSource
2018-06-28 16:22:22 +02:00
import System.FilePath
2018-07-10 16:22:28 +02:00
import Data.List (intercalate, sort)
import qualified Data.Text as T
import Data.Map.Strict as M
import Data.Set as S
2018-06-28 16:22:22 +02:00
2015-08-17 23:32:00 +02:00
main :: IO ()
main = do
args <- getArgs
2015-09-12 15:36:50 +02:00
result <- runGEvalGetOptions args
case result of
Left parseResult -> handleParseResult parseResult >> return ()
2018-06-08 12:38:45 +02:00
Right (opts, Just results) -> showTheResult opts results
2015-09-12 15:36:50 +02:00
Right (_, Nothing) -> return ()
showTheResult :: GEvalOptions -> [(SourceSpec, [MetricValue])] -> IO ()
showTheResult opts [(_, vals)] = showTheResult' opts vals
2018-06-28 16:22:22 +02:00
showTheResult opts [] = error "no output given"
showTheResult opts multipleResults = showTable opts multipleResults
showTable :: GEvalOptions -> [(SourceSpec, [MetricValue])] -> IO ()
showTable opts multipleResults = do
2018-07-10 16:22:28 +02:00
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
2018-06-28 16:22:22 +02:00
where metrics = gesMetrics $ geoSpec opts
2018-07-10 16:22:28 +02:00
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 ()
2018-06-08 12:38:45 +02:00
-- do not show the metric if just one was given
showTheResult' opts [val] = putStrLn $ formatTheResult (gesPrecision $ geoSpec opts) val
showTheResult' opts [] = do
2018-06-08 12:38:45 +02:00
hPutStrLn stderr "no metric given, use --metric option"
exitFailure
2018-07-10 16:22:28 +02:00
showTheResult' opts vals = mapM_ putStrLn $ Prelude.map (formatTheMetricAndResult (gesPrecision $ geoSpec opts)) $ zip (gesMetrics $ geoSpec opts) vals
2018-06-08 12:38:45 +02:00
2018-06-28 16:22:22 +02:00
formatSourceSpec :: SourceSpec -> String
formatSourceSpec (FilePathSpec fp) = dropExtensions $ takeFileName fp
formatSourceSpec spec = show spec
2018-06-08 12:38:45 +02:00
formatTheMetricAndResult :: Maybe Int -> (Metric, MetricValue) -> String
formatTheMetricAndResult mPrecision (metric, val) = (show metric) ++ "\t" ++ (formatTheResult mPrecision val)
2015-09-12 15:36:50 +02:00
formatTheResult :: Maybe Int -> MetricValue -> String
formatTheResult Nothing = show
formatTheResult (Just prec) = printf "%0.*f" prec