packages feed

progression (empty) → 0.1

raw patch · 8 files changed

+612/−0 lines, 8 filesdep +basedep +containersdep +criterionsetup-changed

Dependencies added: base, containers, criterion, directory, filepath, haskeline, process, txt-sushi

Files

+ LICENSE view
@@ -0,0 +1,31 @@+Copyright Neil Brown 2009++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Neil Brown nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Progression/Config.hs view
@@ -0,0 +1,141 @@+-- Progression.+-- Copyright (c) 2010, Neil Brown.+-- All rights reserved.+-- +-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+--  * Redistributions of source code must retain the above copyright+--    notice, this list of conditions and the following disclaimer.+--  * Redistributions in binary form must reproduce the above copyright+--    notice, this list of conditions and the following disclaimer in the+--    documentation and/or other materials provided with the distribution.+--  * The name of Neil Brown may not be used to endorse or promote products derived from+--    this software without specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,+-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+-- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR+-- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-- | A module exposing the configuration for progression.+--+-- Each item is either a Maybe type or a list.  The values Nothing or the empty+-- list indicate a lack of preference and will be over-ridden by the other setting+-- in an mappend; settings can be joined together using their monoid instances.+module Progression.Config (RunSettings(..), GraphSettings(..), Mode(..), Config(..), processArgs)+  where++import Control.Monad ((>=>))+import Data.List (intercalate)+import Data.Monoid (Monoid(..))+import System.Console.GetOpt (OptDescr(..), ArgDescr(..), ArgOrder(..), getOpt, usageInfo)+import System.Environment (getProgName)+import System.Exit (ExitCode(..), exitWith)+import System.IO (hPutStrLn, stderr)++-- | The settings for running benchmarks; which prefixes to run (empty list means+-- no preference, i.e. all -- not none) and where to put the result.+data RunSettings = RunSettings { runPrefixes :: [String], runStoreAs :: Maybe String }++-- | The settings for plotting graphs; which labels (besides the one created by+-- the current run, if applicable) to feature in the graph, and where to store+-- the file (plot.png, by default).+data GraphSettings = GraphSettings { graphCompareTo :: [String]+                                   , graphFilename :: Maybe String+                                   --, graphSize :: Maybe (Int, Int)+                                   }++-- | The mode; just running and recording a benchmark, just graphing existing results,+-- or running a benchmark and produce a graph (the default).+data Mode = JustRun | RunAndGraph | JustGraph+  deriving Eq++-- | The mode (RunAndGraph, by default), the run settings and the graph settings.+data Config = Config {cfgMode :: Maybe Mode, cfgRun :: RunSettings, cfgGraph :: GraphSettings }++instance Monoid Config where+  mempty = Config Nothing mempty mempty+  mappend (Config m r g) (Config m' r' g') = Config (m||*m') (mappend r r') (mappend g g')++instance Monoid RunSettings where+  mempty = RunSettings mempty mempty+  mappend (RunSettings p s) (RunSettings p' s') = RunSettings (p++p') (s||*s')++instance Monoid GraphSettings where+  mempty = GraphSettings mempty mempty+  mappend (GraphSettings c f) (GraphSettings c' f')+    = GraphSettings (c++c') (f ||* f')++(||*) :: Maybe a -> Maybe a -> Maybe a+x ||* Nothing = x+_ ||* y = y++data OptM a = ShowHelp | Error String | Result a++instance Monad OptM where+  fail = Error+  return = Result++  ShowHelp >>= _ = ShowHelp+  (Error e) >>= _ = Error e+  (Result x) >>= f = f x++options :: [OptDescr (Config -> OptM Config)]+options  = [Option "p" ["prefixes"] (ReqArg prefix "PREFIX")+              "Run the specified comma-separated list of prefixes (can be given multiple times)"+           ,Option "n" ["name"] (ReqArg name "NAME")+              "Store the results with the specified name"+           ,Option "c" ["compare"] (ReqArg compareTo "COMPARISON")+              "Compare the given comma-separated list of previous recordings (can be given multiple times).  Automatically includes the current recording, if any"+           ,Option [] ["plot"] (ReqArg plot "FILENAME")+              "Store the plot as the given filename.  The extension, if any, is used to set the gnuplot terminal type"+--           ,Option [] ["plot-size"] (ReqArg plotSize "XxY")+--              "Plot with the given size (e.g. 640x480)"+           ,Option "m" ["mode"] (ReqArg mode "MODE")+              "Specify \"graph\" to just draw a graph, \"run\" to just run the benchmark, or \"normal\" (the default) to do both"+           ,Option "h" ["help"] (NoArg help)+              "Display this help message"+           ]+  where+    add :: (Monoid monoid, Monad monad) => monoid -> monoid -> monad monoid+    add x c = return $ c `mappend` x+    prefix p = add $ mempty {cfgRun = mempty {runPrefixes = [p]} }+    name n = add $ mempty {cfgRun = mempty { runStoreAs = Just n} }+    compareTo c = add $ mempty {cfgGraph = mempty {graphCompareTo = [c]} }+    plot c = add $ mempty {cfgGraph = mempty {graphFilename = Just c} }+--    plotSize c = undefined -- TODO add $ mempty {cfgGraph = mempty {graphSize = Just c} }++    mode "graph" = add $ mempty {cfgMode = Just JustGraph}+    mode "run" = add $ mempty {cfgMode = Just JustRun}+    mode "normal" = add $ mempty {cfgMode = Just RunAndGraph}+    mode m = const $ Error $ "Invalid mode setting: \"" ++ m ++ "\""++    help = const ShowHelp++-- | Processes the given arguments (got from getArgs, typically) to adjust the+-- given default configuration, returning the resulting configuration.  Exits the+-- whole program with an error if there is a problem, or if the user specified+-- "-h" (in which case it exits after printing the options).+processArgs :: Config -> [String] -> IO Config+processArgs defaultConfig ourArgs+  = let (cfgFuncs, nonOpt, otherErr) = getOpt Permute options ourArgs+        cfgResult = foldl (>=>) return cfgFuncs $ defaultConfig+    in case (cfgResult, not $ null $ nonOpt, not $ null $ otherErr) of+         (Error err, _, _) -> exitErr $ err ++ intercalate "," otherErr+         (_, _, True) -> exitErr $ intercalate "," otherErr+         (_, True, _) -> exitErr $ "Unrecognised options: " ++ intercalate "," nonOpt+         (ShowHelp, _, _) -> do progName <- getProgName+                                putStrLn $ usageInfo (progName ++ " [PROGRESSION-ARGS [-- CRITERION-ARGS]]") options+                                exitWith ExitSuccess+         (Result cfg, False, False) -> return cfg+  where+    exitErr e = hPutStrLn stderr e >> exitWith (ExitFailure 1)
+ Progression/Files.hs view
@@ -0,0 +1,75 @@+-- Progression.+-- Copyright (c) 2010, Neil Brown.+-- All rights reserved.+-- +-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+--  * Redistributions of source code must retain the above copyright+--    notice, this list of conditions and the following disclaimer.+--  * Redistributions in binary form must reproduce the above copyright+--    notice, this list of conditions and the following disclaimer in the+--    documentation and/or other materials provided with the distribution.+--  * The name of Neil Brown may not be used to endorse or promote products derived from+--    this software without specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,+-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+-- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR+-- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-- | Some helper functions for dealing with the results (CSV) files.+module Progression.Files (findResultFiles, makeFileName) where++import Control.Applicative ((<$>))+import Control.Monad (liftM)+import Data.List (isPrefixOf, sortBy)+import Data.Maybe (mapMaybe)+import Data.Ord (comparing)+import System.FilePath (splitExtension, (<.>))+import System.Directory (getDirectoryContents, getModificationTime)++specialPrefix :: String+specialPrefix = "bench-"++-- | Given a label for a result-set, turns it into a CSV file name.+--+-- Currently this is done by prepending \"bench-\" and appending \".csv\".+makeFileName :: String -> FilePath+makeFileName s = (specialPrefix ++ s) <.> "csv"++-- | Sorts a list of labels (not CSV file names) by their modification time, latest+-- first.+sortByModificationTime :: [String] -> IO [String]+sortByModificationTime+  = liftM (map fst . sortBy ((descending .) . comparing snd)) . mapM addModificationTime+  where+    addModificationTime f = (,) f <$> getModificationTime (makeFileName f)++    descending LT = GT+    descending EQ = EQ+    descending GT = LT++-- | Finds all the results files in the working directory, and returns a list of+-- their labels.+findResultFiles :: IO [String]+findResultFiles+  = sortByModificationTime =<< ((mapMaybe benchPrefix . mapMaybe csvStem) <$> getDirectoryContents ".")+  where+    csvStem :: FilePath -> Maybe String+    csvStem f = case splitExtension f of+      (stem, ".csv") -> Just stem+      _ -> Nothing++    benchPrefix :: String -> Maybe String+    benchPrefix f+      | specialPrefix `isPrefixOf` f = Just $ drop (length specialPrefix) f+      | otherwise = Nothing
+ Progression/Main.hs view
@@ -0,0 +1,110 @@+-- Progression.+-- Copyright (c) 2010, Neil Brown.+-- All rights reserved.+-- +-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+--  * Redistributions of source code must retain the above copyright+--    notice, this list of conditions and the following disclaimer.+--  * Redistributions in binary form must reproduce the above copyright+--    notice, this list of conditions and the following disclaimer in the+--    documentation and/or other materials provided with the distribution.+--  * The name of Neil Brown may not be used to endorse or promote products derived from+--    this software without specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,+-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+-- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR+-- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-- | The primary module in Progression; contains methods that you can use as the+-- main method of your wrapper program.  Typically, to use Progression, you create+-- a Haskell program that defines/imports the benchmarks, and passes them to the+-- 'defaultMain' method below.  You then compile that program and run it to record+-- and graph your benchmarks.+module Progression.Main (defaultMain, defaultMainWith) where++import qualified Criterion.Config as CriterionConfig (Config(..), defaultConfig)+import qualified Criterion.Main as Criterion (defaultMainWith)+import Criterion.Types (Benchmark(..))+import Data.Maybe (fromMaybe)+import Data.Monoid (Last(..), mempty)+import qualified Data.Set as Set+import System.Environment (getArgs, withArgs)++import Progression.Config+import Progression.Files+import Progression.Plot+import Progression.Prompt++allPrefixes :: Benchmark -> Set.Set String+allPrefixes (Benchmark _label _bench) = Set.empty+allPrefixes (BenchGroup prefix benches)+  = Set.mapMonotonic (prefix ++) $+      foldl Set.union (Set.singleton "") $+        map (Set.mapMonotonic ('/' :) . allPrefixes) benches++-- | Like 'defaultMain' but you can specify the default configuration.  Command-line+-- argument processing is still performed, and command-line settings will take+-- precedence over the config passed in.+defaultMainWith :: Config -> Benchmark -> IO ()+defaultMainWith defaultConfig bench = do+  origArgs <- getArgs+  let (ourArgs, criterionArgs) = span (/= "--") origArgs+  cfg <- processArgs defaultConfig ourArgs+  mainWith cfg (dropWhile (== "--") criterionArgs) bench++-- | Takes the given benchmark (which is likely a benchmark group) and runs it+-- as part of Progression, recording the results and producing graphs.  The Benchmark+-- type is imported from the Criterion library, so see the documentation for Criterion+-- to find out what can be benchmarked and any issues that might arise in the benchmarking.+--+-- This function will process the command-line arguments of the program, consuming+-- any progression arguments, and passing any arguments that occur after a \"--\"+-- argument on to Criterion.  If you want to perform further argument processing,+-- it is best to do this before the call, and wrap the call in 'withArgs'.+defaultMain :: Benchmark -> IO ()+defaultMain = defaultMainWith mempty++mainWith :: Config -> [String] -> Benchmark -> IO ()+mainWith cfg criterionArgs bench = do+  compareChoices <- findResultFiles+  (name, r) <- if not running then return (Nothing, Nothing) else do+         prefixes <- if length prefixChoices <= 1 || all (== "") prefixChoices+                       then return []+                       else optL (runPrefixes . cfgRun)+                                 (promptManyComma "Run which prefixes " prefixChoices)+         name <- opt (runStoreAs . cfgRun)+                     (promptOne "Store as" compareChoices)+         return $ (,) (Just name) $ Just $ withArgs (prefixes ++ criterionArgs) $+           Criterion.defaultMainWith (CriterionConfig.defaultConfig {CriterionConfig.cfgSummaryFile = (Last $ Just (makeFileName name))})+           (return ()) +           [bench]+  g <- if not graphing then return Nothing else do+         cmp <- optL (graphCompareTo . cfgGraph)+                     (promptManyComma "Compare to " compareChoices)+         return $ Just $ plotMulti (fromMaybe "plot.png" $ graphFilename $ cfgGraph cfg)+                                   (maybe cmp (:cmp) name)+  mrun r+  mrun g+  where+    prefixChoices :: [String]+    prefixChoices = Set.toList $ allPrefixes bench++    mrun = fromMaybe (return ())++    opt f m = maybe m return (f cfg)+    optL f m = case f cfg of+                 [] -> m+                 xs -> return xs+    graphing = fromMaybe RunAndGraph (cfgMode cfg) `elem` [RunAndGraph, JustGraph]+    running = fromMaybe RunAndGraph (cfgMode cfg) `elem` [RunAndGraph, JustRun]
+ Progression/Plot.hs view
@@ -0,0 +1,149 @@+-- Progression.+-- Copyright (c) 2010, Neil Brown.+-- All rights reserved.+-- +-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+--  * Redistributions of source code must retain the above copyright+--    notice, this list of conditions and the following disclaimer.+--  * Redistributions in binary form must reproduce the above copyright+--    notice, this list of conditions and the following disclaimer in the+--    documentation and/or other materials provided with the distribution.+--  * The name of Neil Brown may not be used to endorse or promote products derived from+--    this software without specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,+-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+-- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR+-- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-- | A helper module for plotting.+module Progression.Plot (plotMulti) where++import Control.Applicative (Applicative(..), (<$>))+import Control.Monad (ap, forM, liftM)+import Data.List (findIndex, intercalate)+import qualified Data.Map as Map+import Database.TxtSushi.FlatFile (csvFormat, formatTable, parseTable)+import System.Cmd (rawSystem)+import System.Exit (ExitCode(..))+import System.FilePath (dropExtension, takeExtension, (<.>))+import System.IO (hPutStrLn, stderr)++import Progression.Files++data BoundedMean = BoundedMean { _meanLB :: String, _mean :: String, _meanUB :: String }++-- | Plots to the given destination file (using its extension as the terminal type),+-- from the given CSV file, using the given list as labels.+plotFile :: FilePath -> (Integer, FilePath) -> [String] -> IO ()+plotFile destFile (numBench, csvFile) names = check =<< rawSystem "gnuplot" ("-e" :+ [concat+  ["set terminal " ++ terminalType ++ " size 1024,768;"+  ,"set output '", destFile, "';"+  ,"set xtics rotate;"+  ,"set xrange [-" ++ show (makeOffset 1) ++ ":"+     ++ show (fromInteger (numBench - 1) + makeOffset (toInteger $ length names)) ++ "];"+  ,"set bmargin 20;"+  ,"set datafile separator ',';"+  ,"plot " ++ intercalate ","+     [let indices = map show [i*3 + 2, i*3 + 3, i*3 + 4]+      in "'" ++  csvFile ++ "' using ($0+" ++ show (makeOffset i) ++ "):" ++ intercalate ":" indices ++ ":xtic(1) with errorlines title '" ++ n ++ "'"+     | (i, n) <- zip [0..] names]+  ]+ ])+ where+   terminalType = case takeExtension destFile of+     "" -> "png"+     (_:ext) -> ext++   check ExitSuccess = return ()+   check (ExitFailure _) = hPutStrLn stderr "Error executing gnuplot; have you got gnuplot installed on your system and in your path?"++   makeOffset :: Integer -> Double+   makeOffset i = (fromInteger i :: Double) / 8++-- | Plots to the given destination file (using its extension as the terminal type),+-- the given list of labels.+plotMulti :: FilePath -> [String] -> IO ()+plotMulti destFile names+  = do count <- joinMulti csvFile (map makeFileName names)+       plotFile destFile (count, csvFile) names+  where+    csvFile = dropExtension destFile <.> "csv"++-- I know this is really Either String; long story+data FailM a = Fail String | Fine a++instance Monad FailM where+  fail = Fail+  return = Fine+  (Fail s) >>= _ = Fail s+  (Fine x) >>= f = f x++instance Functor FailM where+  fmap = liftM++instance Applicative FailM where+  pure = return+  (<*>) = ap++-- | Joins all the result files in the list into the given destination file ready+-- to be fed to plotFile.  If the list is empty, nothing is done.+--+-- It returns the number of benchmarks that are in the resulting file+joinMulti :: FilePath -> [FilePath] -> IO Integer+joinMulti _ [] = return 0+joinMulti dest allFiles+  = do allData <- sequence [parseTable csvFormat <$> readFile path | path <- allFiles]+       case mapM tableToMap allData of+         Fail err -> hPutStrLn stderr err >> return 0+         -- ms must be non-empty, because "allFiles" was non-empty:+         Fine ms -> let m = foldl1 (Map.intersectionWith (++)) $+                              map (Map.map (:[])) ms+                    in do writeFile dest $ formatTable csvFormat (mapToTable m)+                          return (toInteger $ Map.size m)+  where+    headTail :: [a] -> FailM (a, [a])+    headTail [] = Fail "Empty file"+    headTail (x:xs) = return (x, xs)++    find' :: String -> [String] -> FailM Int+    find' s ss = case findIndex (== s) ss of+      Nothing -> Fail $ "Could not find row titled: " ++ s+      Just i -> return i++    (!) :: [a] -> Int -> FailM a+    (!) xs n | n >= length xs = Fail "Missing data in file"+             | otherwise = return $ xs !! n+    +    tableToMap :: [[String]] -> FailM (Map.Map String BoundedMean)+    tableToMap tbl = do (header, body) <- headTail tbl+                        nameIndex <- find' "Name" header+                        meanIndex <- find' "Mean" header+                        meanLBIndex <- find' "MeanLB" header+                        meanUBIndex <- find' "MeanUB" header+                        Map.fromList <$> forM body (\r ->+                          (,) <$> (r ! nameIndex) <*>+                             (BoundedMean <$>+                               (r ! meanLBIndex) <*> (r ! meanIndex) <*> (r ! meanUBIndex))+                          )++    -- No header at the moment:+    mapToTable :: Map.Map String [BoundedMean] -> [[String]]+    mapToTable = map itemToRow . Map.toList+      where+        itemToRow :: (String, [BoundedMean]) -> [String]+        itemToRow (n, ms) = n : concatMap meanToStr ms++        meanToStr :: BoundedMean -> [String]+        meanToStr (BoundedMean lb m ub) = [m, lb, ub]
+ Progression/Prompt.hs view
@@ -0,0 +1,69 @@+-- Progression.+-- Copyright (c) 2010, Neil Brown.+-- All rights reserved.+-- +-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+--  * Redistributions of source code must retain the above copyright+--    notice, this list of conditions and the following disclaimer.+--  * Redistributions in binary form must reproduce the above copyright+--    notice, this list of conditions and the following disclaimer in the+--    documentation and/or other materials provided with the distribution.+--  * The name of Neil Brown may not be used to endorse or promote products derived from+--    this software without specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,+-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+-- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR+-- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-- | A module containing helper functions for the interactive prompts.+module Progression.Prompt (promptOne, promptManyComma) where++import Control.Applicative ((<$>))+import Data.List (isPrefixOf, unfoldr)+import Data.Maybe (fromMaybe)+import System.Console.Haskeline (getInputLine, runInputT, Settings(Settings))+import System.Console.Haskeline.Completion (completeWord, simpleCompletion)+import Text.Show (showListWith)++-- | Prompts for a single item, using the given message, followed by some of the+-- list of suggestions.  All suggestions are used to form the tab completion.+-- The result will be trimmed of leading and trailing spaces.+promptOne :: String -> [String] -> IO String+promptOne msg opts = trim . fromMaybe "" <$> runInputT settings (getInputLine (msg ++ showListWith (++) fewOpts "" ++ ": "))+  where+    settings = Settings complete Nothing True+    complete = completeWord Nothing "," (return . completeOpt)+    completeOpt str = [simpleCompletion opt | opt <- opts, str `isPrefixOf` opt]++    fewOpts+      | length opts <= 5 = opts+      | otherwise = take 5 opts ++ ["..."]++-- | Prompts for one or more comma-separated items, using the given message and+-- suggestions (some of which will be shown with the message).  The results will+-- each be trimmed of leading and trailing spaces, and the whole list will have+-- empty items removed.+promptManyComma :: String -> [String] -> IO [String]+promptManyComma = ((<$>) (filter (not . null) . map trim . unfoldr splitFirstComma) .) . promptOne+  where+    splitFirstComma :: String -> Maybe (String, String)+    splitFirstComma [] = Nothing+    splitFirstComma s = case span (/= ',') s of+      (_, []) -> Just (s, "")+      (pre, _:post) -> Just (pre, post)++-- | Trims leading and trailing spaces.  Probably very inefficient, but it shouldn't+-- matter for our application.+trim :: String -> String+trim = reverse . dropWhile (== ' ') . reverse . dropWhile (== ' ')
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ progression.cabal view
@@ -0,0 +1,34 @@+name:                progression+version:             0.1+synopsis:            Automates the recording and graphing of criterion benchmarks+description:         Progression is a library that builds on the criterion+                     benchmarking library.  It stores the results of running+                     your benchmarks and graphs the performance of different+                     versions of your program against each other.  See the+                     "Progression.Main" module, and the original blog post at+                     <http://chplib.wordpress.com/2010/02/04/progression-supporting-optimisation-in-haskell/> to get started.+homepage:            http://chplib.wordpress.com/2010/02/04/progression-supporting-optimisation-in-haskell/+category:            Development+license:             BSD3+license-file:        LICENSE+author:              Neil Brown+maintainer:          neil@twistedsquare.com+build-depends:       base >= 3 && < 5,+                     criterion >= 0.4 && < 0.5,+                     directory,+                     txt-sushi >= 0.5 && < 0.6,+                     containers,+                     process,+                     filepath >= 1.1 && < 1.2,+                     haskeline >= 0.6 && < 0.7++build-type:          Simple++exposed-modules:     Progression.Config+                     Progression.Files+                     Progression.Main+                     Progression.Plot++other-modules:       Progression.Prompt++ghc-options:         -Wall