module HSBencher.Types
(
RunFlags, CompileFlags, FilePredicate(..), filePredCheck,
BuildResult(..), BuildMethod(..),
mkBenchmark,
Benchmark(..),
BenchSpace(..), ParamSetting(..),
enumerateBenchSpace, compileOptsOnly, isCompileTime,
toCompileFlags, toRunFlags, toEnvVars, toCmdPaths,
BuildID, makeBuildID,
DefaultParamMeaning(..),
Config(..), BenchM,
#ifdef FUSION_TABLES
FusionConfig(..),
#endif
CommandDescr(..), RunResult(..), SubProcess(..), LineHarvester(..),
BenchmarkResult(..), emptyBenchmarkResult,
doc
)
where
import Control.Monad.Reader
import Data.Char
import Data.List
import qualified Data.Map as M
import Data.Maybe (catMaybes)
import Control.Monad (filterM)
import System.FilePath
import System.Directory
import System.Process (CmdSpec(..))
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as B
import qualified System.IO.Streams as Strm
import Debug.Trace
import Text.PrettyPrint.GenericPretty (Out(doc,docPrec), Generic)
#ifdef FUSION_TABLES
import Network.Google.FusionTables (TableId)
import Network.Google.FusionTables (createTable, listTables, listColumns, insertRows,
TableId, CellType(..), TableMetadata(..))
#endif
type EnvVars = [(String,String)]
type RunFlags = [String]
type CompileFlags = [String]
type PathRegistry = M.Map String String
data FilePredicate =
WithExtension String
| IsExactly String
| InDirectoryWithExactlyOne FilePredicate
| PredOr FilePredicate FilePredicate
| AnyFile
deriving (Show, Generic, Ord, Eq)
filePredCheck :: FilePredicate -> FilePath -> IO (Maybe FilePath)
filePredCheck pred path =
let filename = takeFileName path in
case pred of
AnyFile -> return (Just path)
IsExactly str -> return$ if str == filename
then Just path else Nothing
WithExtension ext -> return$ if takeExtension filename == ext
then Just path else Nothing
PredOr p1 p2 -> do
x <- filePredCheck p1 path
case x of
Just _ -> return x
Nothing -> filePredCheck p2 path
InDirectoryWithExactlyOne p2 -> do
ls <- getDirectoryContents (takeDirectory path)
ls' <- fmap catMaybes $
mapM (filePredCheck p2) ls
case ls' of
[x] -> return (Just$ takeDirectory path </> x)
_ -> return Nothing
data BuildResult =
StandAloneBinary FilePath
| RunInPlace (RunFlags -> EnvVars -> CommandDescr)
instance Show BuildResult where
show (StandAloneBinary p) = "StandAloneBinary "++p
show (RunInPlace fn) = "RunInPlace <fn>"
data BuildMethod =
BuildMethod
{ methodName :: String
, canBuild :: FilePredicate
, concurrentBuild :: Bool
, compile :: PathRegistry -> BuildID -> CompileFlags -> FilePath -> BenchM BuildResult
, clean :: PathRegistry -> BuildID -> FilePath -> BenchM ()
, setThreads :: Maybe (Int -> [ParamSetting])
}
instance Show BuildMethod where
show BuildMethod{methodName, canBuild} = "<buildMethod "++methodName++" "++show canBuild ++">"
type BenchM a = ReaderT Config IO a
data Config = Config
{ benchlist :: [Benchmark DefaultParamMeaning]
, benchsetName :: Maybe String
, benchversion :: (String, Double)
, runTimeOut :: Maybe Double
, maxthreads :: Int
, trials :: Int
, skipTo :: Maybe Int
, runID :: Maybe String
, shortrun :: Bool
, doClean :: Bool
, keepgoing :: Bool
, pathRegistry :: PathRegistry
, hostname :: String
, startTime :: Integer
, resultsFile :: String
, logFile :: String
, gitInfo :: (String,String,Int)
, buildMethods :: [BuildMethod]
, logOut :: Strm.OutputStream B.ByteString
, resultsOut :: Strm.OutputStream B.ByteString
, stdOut :: Strm.OutputStream B.ByteString
, envs :: [[(String, String)]]
, argsBeforeFlags :: Bool
, harvesters :: (LineHarvester, Maybe LineHarvester)
, doFusionUpload :: Bool
#ifdef FUSION_TABLES
, fusionConfig :: FusionConfig
#endif
}
deriving Show
#ifdef FUSION_TABLES
data FusionConfig =
FusionConfig
{ fusionTableID :: Maybe TableId
, fusionClientID :: Maybe String
, fusionClientSecret :: Maybe String
}
deriving Show
#endif
instance Show (Strm.OutputStream a) where
show _ = "<OutputStream>"
data Benchmark a = Benchmark
{ target :: FilePath
, cmdargs :: [String]
, configs :: BenchSpace a
} deriving (Eq, Show, Ord, Generic)
mkBenchmark :: FilePath -> [String] -> BenchSpace a -> Benchmark a
mkBenchmark target cmdargs configs =
Benchmark {target, cmdargs, configs}
data BenchSpace meaning = And [BenchSpace meaning]
| Or [BenchSpace meaning]
| Set meaning ParamSetting
deriving (Show,Eq,Ord,Read, Generic)
data DefaultParamMeaning
= Threads Int
| Variant String
| NoMeaning
deriving (Show,Eq,Ord,Read, Generic)
enumerateBenchSpace :: BenchSpace a -> [ [(a,ParamSetting)] ]
enumerateBenchSpace bs =
case bs of
Set m p -> [ [(m,p)] ]
Or ls -> concatMap enumerateBenchSpace ls
And ls -> loop ls
where
loop [] = [ [] ]
loop [lst] = enumerateBenchSpace lst
loop (hd:tl) =
let confs = enumerateBenchSpace hd in
[ c++r | c <- confs
, r <- loop tl ]
isCompileTime :: ParamSetting -> Bool
isCompileTime CompileParam{} = True
isCompileTime CmdPath {} = True
isCompileTime RuntimeParam{} = False
isCompileTime RuntimeEnv {} = False
toCompileFlags :: [(a,ParamSetting)] -> CompileFlags
toCompileFlags [] = []
toCompileFlags ((_,CompileParam s1) : tl) = s1 : toCompileFlags tl
toCompileFlags (_ : tl) = toCompileFlags tl
toRunFlags :: [(a,ParamSetting)] -> RunFlags
toRunFlags [] = []
toRunFlags ((_,RuntimeParam s1) : tl) = (s1) : toRunFlags tl
toRunFlags (_ : tl) = toRunFlags tl
toCmdPaths :: [(a,ParamSetting)] -> [(String,String)]
toCmdPaths = catMaybes . map fn
where
fn (_,CmdPath c p) = Just (c,p)
fn _ = Nothing
toEnvVars :: [(a,ParamSetting)] -> [(String,String)]
toEnvVars [] = []
toEnvVars ((_,RuntimeEnv s1 s2)
: tl) = (s1,s2) : toEnvVars tl
toEnvVars (_ : tl) = toEnvVars tl
type BuildID = String
makeBuildID :: FilePath -> CompileFlags -> BuildID
makeBuildID target strs =
encodedTarget ++
(intercalate "_" $
map (filter charAllowed) strs)
where
charAllowed = isAlphaNum
encodedTarget = map (\ c -> if charAllowed c then c else '_') target
compileOptsOnly :: BenchSpace a -> BenchSpace a
compileOptsOnly x =
case loop x of
Nothing -> And []
Just b -> b
where
loop bs =
case bs of
And ls -> mayb$ And$ catMaybes$ map loop ls
Or ls -> mayb$ Or $ catMaybes$ map loop ls
Set m (CompileParam {}) -> Just bs
Set m (CmdPath {}) -> Just bs
Set _ _ -> Nothing
mayb (And []) = Nothing
mayb (Or []) = Nothing
mayb x = Just x
test1 = Or (map (Set () . RuntimeEnv "CILK_NPROCS" . show) [1..32])
test2 = Or$ map (Set () . RuntimeParam . ("-A"++)) ["1M", "2M"]
test3 = And [test1, test2]
data ParamSetting
= RuntimeParam String
| CompileParam String
| RuntimeEnv String String
| CmdPath String String
deriving (Show, Eq, Read, Ord, Generic)
data CommandDescr =
CommandDescr
{ command :: CmdSpec
, envVars :: [(String, String)]
, timeout :: Maybe Double
, workingDir :: Maybe FilePath
}
deriving (Show,Eq,Ord,Read,Generic)
deriving instance Eq CmdSpec
deriving instance Show CmdSpec
deriving instance Ord CmdSpec
deriving instance Read CmdSpec
data RunResult =
RunCompleted { realtime :: Double
, productivity :: Maybe Double
}
| RunTimeOut
| ExitError Int
deriving (Eq,Show)
data SubProcess =
SubProcess
{ wait :: IO RunResult
, process_out :: Strm.InputStream B.ByteString
, process_err :: Strm.InputStream B.ByteString
}
instance Out ParamSetting
instance Out FilePredicate
instance Out DefaultParamMeaning
instance Out a => Out (BenchSpace a)
instance Out a => Out (Benchmark a)
instance (Out k, Out v) => Out (M.Map k v) where
docPrec n m = docPrec n $ M.toList m
doc = docPrec 0
newtype LineHarvester = LineHarvester (B.ByteString -> Maybe Double)
instance Show LineHarvester where
show _ = "<LineHarvester>"
data BenchmarkResult =
BenchmarkResult
{ _PROGNAME :: String
, _VARIANT :: String
, _ARGS :: [String]
, _HOSTNAME :: String
, _RUNID :: String
, _THREADS :: Int
, _DATETIME :: String
, _MINTIME :: Double
, _MEDIANTIME :: Double
, _MAXTIME :: Double
, _MINTIME_PRODUCTIVITY :: Maybe Double
, _MEDIANTIME_PRODUCTIVITY :: Maybe Double
, _MAXTIME_PRODUCTIVITY :: Maybe Double
, _ALLTIMES :: String
, _TRIALS :: Int
, _COMPILER :: String
, _COMPILE_FLAGS :: String
, _RUNTIME_FLAGS :: String
, _ENV_VARS :: String
, _BENCH_VERSION :: String
, _BENCH_FILE :: String
, _UNAME :: String
, _PROCESSOR :: String
, _TOPOLOGY :: String
, _GIT_BRANCH :: String
, _GIT_HASH :: String
, _GIT_DEPTH :: Int
, _WHO :: String
, _ETC_ISSUE :: String
, _LSPCI :: String
, _FULL_LOG :: String
}
emptyBenchmarkResult :: BenchmarkResult
emptyBenchmarkResult = BenchmarkResult
{ _PROGNAME = ""
, _VARIANT = ""
, _ARGS = []
, _HOSTNAME = ""
, _RUNID = ""
, _THREADS = 0
, _DATETIME = ""
, _MINTIME = 0.0
, _MEDIANTIME = 0.0
, _MAXTIME = 0.0
, _MINTIME_PRODUCTIVITY = Nothing
, _MEDIANTIME_PRODUCTIVITY = Nothing
, _MAXTIME_PRODUCTIVITY = Nothing
, _ALLTIMES = ""
, _TRIALS = 1
, _COMPILER = ""
, _COMPILE_FLAGS = ""
, _RUNTIME_FLAGS = ""
, _ENV_VARS = ""
, _BENCH_VERSION = ""
, _BENCH_FILE = ""
, _UNAME = ""
, _PROCESSOR = ""
, _TOPOLOGY = ""
, _GIT_BRANCH = ""
, _GIT_HASH = ""
, _GIT_DEPTH = 1
, _WHO = ""
, _ETC_ISSUE = ""
, _LSPCI = ""
, _FULL_LOG = ""
}