module Test.SBench.File.FileOps (
criterion2series
, series2sbench
, series2sbench'
, sbench2series
) where
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' )
version = "0.1"
type CriterionFile = FilePath
type SBenchFile = FilePath
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."
criterion2series :: Num a => [a] -> CriterionFile -> IO [(a, Double)]
criterion2series seeds file = do
means <- readMeans file
return $ zip seeds (map read means)
series2sbench :: (Show a, Real a, Show b, Real b) =>
(String, String)
-> Maybe EvalMod
-> Algorithm (c -> d)
-> DataGen (e -> c)
-> Title
-> SBenchFile
-> [(a, b)]
-> IO SBenchFile
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)
series2sbench' :: (Show a, Real a, Show b, Real b) =>
(String, String)
-> Maybe EvalMod
-> Algorithm (c -> d)
-> Data c
-> Title
-> SBenchFile
-> [(a, b)]
-> IO SBenchFile
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)
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
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
myReadFile :: FilePath -> IO String
myReadFile f = do
hfile <- openFile f ReadMode
s <- hGetContents hfile
seq (length s) $ hClose hfile
return s