mirror of
https://github.com/anoma/juvix.git
synced 2024-12-14 17:32:00 +03:00
125 lines
3.5 KiB
Haskell
125 lines
3.5 KiB
Haskell
module Main where
|
|
|
|
import Base
|
|
import Criterion.Main
|
|
import Criterion.Main.Options hiding (config)
|
|
import Criterion.Types
|
|
import Data.Text qualified as Text
|
|
import Development.Shake hiding ((<//>))
|
|
import Juvix.Prelude.Base
|
|
import Juvix.Prelude.Path as Path hiding (doesFileExist, (-<.>))
|
|
import Juvix.Prelude.Path qualified as Path
|
|
import Statistics.Types
|
|
import Suites
|
|
|
|
main :: IO ()
|
|
main = shakeArgs opts compileRules
|
|
where
|
|
opts :: ShakeOptions
|
|
opts = shakeOptions
|
|
|
|
compileRules :: Rules ()
|
|
compileRules = do
|
|
phony "clean" $ do
|
|
putInfo ("Deleting " <> toFilePath resultsDir)
|
|
removePathForcibly resultsDir
|
|
forM_ suites suiteRules
|
|
|
|
suiteRules :: Suite -> Rules ()
|
|
suiteRules s = do
|
|
forM_ (s ^. suiteVariants) (variantRules s)
|
|
csvRules s
|
|
plotRules s
|
|
|
|
multiRecipe :: [Path Abs File] -> Action () -> Rules ()
|
|
multiRecipe out howto = map toFilePath out &%> const howto
|
|
|
|
recipe :: Path Abs File -> Action () -> Rules ()
|
|
recipe out howto = toFilePath out %> const howto
|
|
|
|
variantRules :: Suite -> Variant -> Rules ()
|
|
variantRules s v = do
|
|
action $ do
|
|
whenM
|
|
(doesFileExist (toFilePath srcFile))
|
|
(need [toFilePath exeFile])
|
|
|
|
recipe exeFile $ do
|
|
need [toFilePath srcFile]
|
|
ensureDir outDir
|
|
(v ^. variantBuild) args
|
|
where
|
|
args :: BuildArgs
|
|
args =
|
|
BuildArgs
|
|
{ _buildSrc = srcFile,
|
|
_buildOutDir = outDir
|
|
}
|
|
lang :: Lang
|
|
lang = v ^. variantLanguage
|
|
srcFile :: Path Abs File
|
|
srcFile =
|
|
addExtension'
|
|
(langExtension lang)
|
|
(suiteSrcDir s <//> langPath lang <//> suiteBaseFile s)
|
|
exeFile :: Path Abs File
|
|
exeFile = outDir <//> replaceExtensions' (v ^. variantExtensions) (filename srcFile)
|
|
outDir :: Path Abs Dir
|
|
outDir = variantBinDir s v
|
|
|
|
plotRules :: Suite -> Rules ()
|
|
plotRules s = do
|
|
let csv :: Path Abs File = suiteCsvFile s
|
|
svg :: Path Abs File = suiteSvgFile s
|
|
out :: Path Abs File = suitePlotFile s
|
|
want [toFilePath svg]
|
|
multiRecipe [svg] $ do
|
|
need [toFilePath csv, toFilePath gnuplotFile]
|
|
ensureDir (parent svg)
|
|
command_
|
|
[]
|
|
"gnuplot"
|
|
( gpArg "name" (s ^. suiteTitle)
|
|
++ gpArg "outfile" (toFilePath out)
|
|
++ gpArg "csvfile" (toFilePath csv)
|
|
++ [toFilePath gnuplotFile]
|
|
)
|
|
where
|
|
gpArg :: String -> String -> [String]
|
|
gpArg arg val = ["-e", arg <> "='" <> val <> "'"]
|
|
|
|
csvRules :: Suite -> Rules ()
|
|
csvRules s =
|
|
recipe csv $ do
|
|
need [toFilePath (variantBinFile s v) | v <- s ^. suiteVariants]
|
|
ensureDir (parent csv)
|
|
whenM (Path.doesFileExist csv) (removeFile csv)
|
|
liftIO (runMode (Run (config s) Glob []) (fromSuite s) >> addColorColumn)
|
|
where
|
|
csv :: Path Abs File = suiteCsvFile s
|
|
addColorColumn :: IO ()
|
|
addColorColumn = do
|
|
header :| rows <- nonEmpty' . Text.lines <$> readFile (toFilePath csv)
|
|
let rows' =
|
|
[ showColour (v ^. variantColor) <> "," <> r
|
|
| (v, r) <- zipExact (s ^. suiteVariants) rows
|
|
]
|
|
header' = "Color," <> header
|
|
writeFile (toFilePath csv) (Text.unlines (header' : rows'))
|
|
|
|
fromSuite :: Suite -> [Benchmark]
|
|
fromSuite s = map go (s ^. suiteVariants)
|
|
where
|
|
go :: Variant -> Benchmark
|
|
go v = bench title (nfIO ((v ^. variantRun) (variantBinFile s v)))
|
|
where
|
|
title :: String
|
|
title = show (v ^. variantLanguage) <> maybe "" (" " <>) (v ^. variantTitle)
|
|
|
|
config :: Suite -> Config
|
|
config s =
|
|
defaultConfig
|
|
{ csvFile = Just (toFilePath (suiteCsvFile s)),
|
|
confInterval = cl90
|
|
}
|