Results are presented as cross tables (if possible)
This commit is contained in:
parent
4ba61b6e6e
commit
5171cf0ac6
25
app/Main.hs
25
app/Main.hs
@ -16,6 +16,8 @@ import System.Exit
|
|||||||
|
|
||||||
import Data.Conduit.SmartSource
|
import Data.Conduit.SmartSource
|
||||||
|
|
||||||
|
import Data.SplitIntoCrossTabs
|
||||||
|
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
|
|
||||||
import Data.List (intercalate, sort)
|
import Data.List (intercalate, sort)
|
||||||
@ -23,6 +25,7 @@ import Data.List (intercalate, sort)
|
|||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
import Data.Map.Strict as M
|
import Data.Map.Strict as M
|
||||||
|
import qualified Data.Map.Lazy as LM
|
||||||
import Data.Set as S
|
import Data.Set as S
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
@ -79,7 +82,27 @@ showTheResult' opts [val] = putStrLn $ formatTheResult (gesPrecision $ geoSpec o
|
|||||||
showTheResult' opts [] = do
|
showTheResult' opts [] = do
|
||||||
hPutStrLn stderr "no metric given, use --metric option"
|
hPutStrLn stderr "no metric given, use --metric option"
|
||||||
exitFailure
|
exitFailure
|
||||||
showTheResult' opts vals = mapM_ putStrLn $ Prelude.map (formatTheMetricAndResult (gesPrecision $ geoSpec opts)) $ zip (gesMetrics $ geoSpec opts) vals
|
showTheResult' opts vals = mapM_ putStrLn
|
||||||
|
$ intercalate [""]
|
||||||
|
$ Prelude.map (formatCrossTable (gesPrecision $ geoSpec opts))
|
||||||
|
$ splitIntoTablesWithValues (T.pack "metric") (T.pack "value") mapping metricLabels
|
||||||
|
where mapping = LM.fromList $ zip metricLabels vals
|
||||||
|
metricLabels = Prelude.map T.pack $ Prelude.map evaluationSchemeName $ gesMetrics $ geoSpec opts
|
||||||
|
|
||||||
|
formatCrossTable :: Maybe Int -> TableWithValues MetricValue -> [String]
|
||||||
|
formatCrossTable mPrecision (TableWithValues [_, _] body) =
|
||||||
|
-- actually we won't print metric/value header
|
||||||
|
-- (1) to keep backward-compatible with the previous version
|
||||||
|
-- (2) to be concise
|
||||||
|
Prelude.map (formatCrossTableLine mPrecision) body
|
||||||
|
formatCrossTable mPrecision (TableWithValues header body) =
|
||||||
|
(intercalate "\t" $ Prelude.map T.unpack header) : Prelude.map (formatCrossTableLine mPrecision) body
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
formatCrossTableLine :: Maybe Int -> (T.Text, [MetricValue]) -> String
|
||||||
|
formatCrossTableLine mPrecision (rowName, values) =
|
||||||
|
intercalate "\t" ((T.unpack rowName):Prelude.map (formatTheResult mPrecision) values)
|
||||||
|
|
||||||
formatSourceSpec :: SourceSpec -> String
|
formatSourceSpec :: SourceSpec -> String
|
||||||
formatSourceSpec (FilePathSpec fp) = dropExtensions $ takeFileName fp
|
formatSourceSpec (FilePathSpec fp) = dropExtensions $ takeFileName fp
|
||||||
|
@ -2,7 +2,9 @@
|
|||||||
|
|
||||||
module Data.SplitIntoCrossTabs
|
module Data.SplitIntoCrossTabs
|
||||||
(splitIntoCrossTabs,
|
(splitIntoCrossTabs,
|
||||||
|
splitIntoTablesWithValues,
|
||||||
CrossTab(..),
|
CrossTab(..),
|
||||||
|
TableWithValues(..),
|
||||||
TextFrag(..))
|
TextFrag(..))
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -13,17 +15,40 @@ import qualified Data.Map.Ordered as OM
|
|||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import qualified Data.Foldable as F
|
import qualified Data.Foldable as F
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
import qualified Data.Map.Lazy as LM
|
||||||
|
|
||||||
import Debug.Trace
|
import Debug.Trace
|
||||||
|
|
||||||
import Data.List (unfoldr, sortBy, maximumBy, minimumBy)
|
import Data.List (unfoldr, sortBy, maximumBy, minimumBy)
|
||||||
|
|
||||||
|
data TableWithValues a = TableWithValues [Text] [(Text, [a])]
|
||||||
|
|
||||||
data CrossTab = SingleItem Text | CrossTab [TextFrag] [TextFrag]
|
data CrossTab = SingleItem Text | CrossTab [TextFrag] [TextFrag]
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data TextFrag = Prefix Text | Suffix Text
|
data TextFrag = Prefix Text | Suffix Text
|
||||||
deriving (Show, Eq, Ord)
|
deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
|
splitIntoTablesWithValues :: Text
|
||||||
|
-> Text
|
||||||
|
-> LM.Map Text a -- ^ map from which values will be taken,
|
||||||
|
-- deliberately a lazy map so that
|
||||||
|
-- values could be shown one by one
|
||||||
|
-> [Text]
|
||||||
|
-> [TableWithValues a]
|
||||||
|
splitIntoTablesWithValues defaultMainHeader defaultSecondaryHeader mapping =
|
||||||
|
joinSingleItems . map (convertIntoTableWithValues defaultMainHeader defaultSecondaryHeader mapping) . splitIntoCrossTabs
|
||||||
|
where joinSingleItems (TableWithValues h@[_, _] arows : TableWithValues [_, _] brows : rest) =
|
||||||
|
joinSingleItems (TableWithValues h (arows ++ brows) : rest)
|
||||||
|
joinSingleItems (e : rest) = e : joinSingleItems rest
|
||||||
|
joinSingleItems [] = []
|
||||||
|
|
||||||
|
convertIntoTableWithValues :: Text -> Text -> LM.Map Text a -> CrossTab -> TableWithValues a
|
||||||
|
convertIntoTableWithValues defaultMainHeader defaultSecondaryHeader mapping (SingleItem t) =
|
||||||
|
TableWithValues [defaultMainHeader, defaultSecondaryHeader] [(t, [mapping LM.! t])]
|
||||||
|
convertIntoTableWithValues defaultMainHeader defaultSecondaryHeader mapping (CrossTab rowNames columnNames) =
|
||||||
|
TableWithValues (T.empty : (map toText columnNames)) (map processRow rowNames)
|
||||||
|
where processRow rowName = (toText rowName, map (\colName -> mapping LM.! (combineFrags rowName colName)) columnNames)
|
||||||
|
|
||||||
splitIntoCrossTabs :: [Text] -> [CrossTab]
|
splitIntoCrossTabs :: [Text] -> [CrossTab]
|
||||||
splitIntoCrossTabs inputs =
|
splitIntoCrossTabs inputs =
|
||||||
@ -103,6 +128,10 @@ toSet :: CrossTab -> S.Set Text
|
|||||||
toSet (SingleItem t) = S.singleton t
|
toSet (SingleItem t) = S.singleton t
|
||||||
toSet (CrossTab rowNames columnNames) = S.fromList [rName `combineFrags` cName | rName <- rowNames, cName <- columnNames]
|
toSet (CrossTab rowNames columnNames) = S.fromList [rName `combineFrags` cName | rName <- rowNames, cName <- columnNames]
|
||||||
|
|
||||||
|
toText :: TextFrag -> Text
|
||||||
|
toText (Prefix prefix) = T.stripEnd prefix
|
||||||
|
toText (Suffix prefix) = T.stripStart prefix
|
||||||
|
|
||||||
combineFrags :: TextFrag -> TextFrag -> Text
|
combineFrags :: TextFrag -> TextFrag -> Text
|
||||||
combineFrags (Prefix prefix) (Suffix suffix) = prefix <> suffix
|
combineFrags (Prefix prefix) (Suffix suffix) = prefix <> suffix
|
||||||
combineFrags (Suffix suffix) (Prefix prefix) = prefix <> suffix
|
combineFrags (Suffix suffix) (Prefix prefix) = prefix <> suffix
|
||||||
|
Loading…
Reference in New Issue
Block a user