module Test.SBench.File.FileOps ( criterion2series , series2sbench , series2sbench' , sbench2series ) where --import Database.TxtSushi.FlatFile (csvFormat, parseTable) import Data.Csv ( decode ) import qualified Data.Vector as V ( Vector, head, tail, findIndex, toList, map, (!) ) import qualified Data.ByteString.Lazy as LBS ( ByteString, unpack, pack ) import qualified Codec.Binary.UTF8.String as UTF8 ( encode ) import System.IO ( FilePath, openFile, hClose, hGetContents, hPutStr, IOMode (..) ) import System.Directory ( doesFileExist ) import System.FilePath ( addExtension, dropExtension, takeExtension ) import Data.List ( findIndex ) import Test.SBench.File.Types ( MetaInfo(..), Range(..) ) import Test.SBench.File.Parser ( getWholeFile ) import Test.SBench.STerm ( Algorithm, DataGen, Data, STerm (..) ) import Test.SBench.Options ( EvalMod, Title ) import Data.List ( foldl' ) -- | File format version. version = "0.1" type CriterionFile = FilePath type SBenchFile = FilePath -- * Get data from Criterion files -- | Extract the mean runtimes from a criterion data file. readMeans :: CriterionFile -> IO [String] readMeans fin = do exists <- doesFileExist fin if exists then do filecont <- myReadFile fin all <- case decode False (LBS.pack $ UTF8.encode filecont) :: Either String (V.Vector (V.Vector String)) of Left s -> fail s Right dat -> return dat let header = V.head all body = V.tail all meanIndex = V.findIndex (== "Mean") header case meanIndex of Nothing -> error $ "Criterion-File " ++ " is in a wrong format." Just i -> return $ V.toList $ V.map ((V.! i)) body else error $ "File " ++ fin ++ " does not exist." -- | Read the mean runtimes of a criterion data file and tuple them with seeds -- to a seed-runtime series. criterion2series :: Num a => [a] -> CriterionFile -> IO [(a, Double)] criterion2series seeds file = do means <- readMeans file return $ zip seeds (map read means) -- * Store and read data series from SBench data files -- | Store a series of measurements over /different inputs/ in a .sbench file. -- The SBench file format take some extra information about the measurement. series2sbench :: (Show a, Real a, Show b, Real b) => (String, String) -- ^ (build options, runtime options) used for the measurement. -> Maybe EvalMod -- ^ Evaluation mode for the input (e.g. as given to criterion for time measurements) -> Algorithm (c -> d) -- ^ The function tested. -> DataGen (e -> c) -- ^ The data generator used. -> Title -- ^ Name the measurement should get when the graph is plotted. -> SBenchFile -- ^ File the data should be stored in. -> [(a, b)] -- ^ Data. -> IO SBenchFile -- ^ The generated data file. series2sbench (bOpts, eOpts) evMod alg gen title file ser = do let mi = prepareMetaInfo fout = (addExtension (dropExtension file) "sbench") putStrLn $ "creating sbench data file " ++ fout ++ "..." generateFile mi ser fout return fout where generateFile :: (Show a, Real a, Show b, Real b) => MetaInfo a b -> [(a, b)] -> FilePath -> IO () generateFile mi ser fout = myWriteFile fout $ show mi ++ toGNUStyle ser prepareMetaInfo = MetaInfo { header = ["This file was automatically generated by SBench"] , sbenchVersion = version , graphRanges = getRanges $ ser , miGraphTitle = title , miAlgName = stName alg , miGenName = Left $ stName gen , evalMod = evMod , buildOptions = bOpts , exeOptions = eOpts } getRanges [] = (AutoRange, AutoRange) getRanges ((x,y):ps) = foldl' adjustRanges (ManRange (x,x), ManRange (y,y)) ps adjustRanges (r1, r2) (v1, v2) = (adjustRange r1 v1, adjustRange r2 v2) adjustRange (ManRange (d1, d2)) d = ManRange (min d1 d, max d2 d) -- | Store a series of measurements with /a single input/ in a .sbench file. -- The SBench file format take some extra information about the measurement. series2sbench' :: (Show a, Real a, Show b, Real b) => (String, String) -- ^ (build options, runtime options) used for the measurement. -> Maybe EvalMod -- ^ Evaluation mode for the input (e.g. as given to criterion for time measurements) -> Algorithm (c -> d) -- ^ The function tested. -> Data c -- ^ The data used. -> Title -- ^ Name the measurement should get when the graph is plotted. -> SBenchFile -- ^ File the data should be stored in. -> [(a, b)] -- ^ Data. -> IO SBenchFile -- ^ The generated data file. series2sbench' (bOpts, eOpts) evMod alg inp title file ser = do let mi = prepareMetaInfo fout = (addExtension (dropExtension file) "sbench") putStrLn $ "creating sbench data file " ++ fout ++ "..." generateFile mi ser fout return fout where generateFile :: (Show a, Real a, Show b, Real b) => MetaInfo a b -> [(a, b)] -> FilePath -> IO () generateFile mi ser fout = myWriteFile fout $ show mi ++ toGNUStyle ser prepareMetaInfo = MetaInfo { header = ["This file was automatically generated by SBench"] , sbenchVersion = version , graphRanges = getRanges $ ser , miGraphTitle = title , miAlgName = stName alg , miGenName = Right $ stName inp , evalMod = evMod , buildOptions = bOpts , exeOptions = eOpts } getRanges [] = (AutoRange, AutoRange) getRanges ((x,y):ps) = foldl' adjustRanges (ManRange (x,x), ManRange (y,y)) ps adjustRanges (r1, r2) (v1, v2) = (adjustRange r1 v1, adjustRange r2 v2) adjustRange (ManRange (d1, d2)) d = ManRange (min d1 d, max d2 d) -- | Read a measurment series from a .sbench data file. -- Additionally to the measurement series a data structure with meta informations is returned. sbench2series :: FilePath -> IO (MetaInfo Double Double, [(Double, Double)]) sbench2series file = let f = if takeExtension file == "sbench" then file else addExtension file "sbench" in getWholeFile f -- * Auxiliar functions toGNUStyle :: (Show a, Show b) => [(a, b)] -> String toGNUStyle = foldr (++) "" . map (\(g, r) -> show g ++ "\t" ++ show r ++ "\n") myWriteFile :: FilePath -> String -> IO () myWriteFile f s = do hfile <- openFile f WriteMode hPutStr hfile s hClose hfile -- strict read version myReadFile :: FilePath -> IO String myReadFile f = do hfile <- openFile f ReadMode s <- hGetContents hfile seq (length s) $ hClose hfile return s