{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Development.Benchmark.Rules
(
buildRules, MkBuildRules(..), OutputFolder, ProjectRoot,
benchRules, MkBenchRules(..), BenchProject(..), ProfilingMode(..),
csvRules,
svgRules,
heapProfileRules,
phonyRules,
allTargetsForExample,
GetExample(..), GetExamples(..),
IsExample(..), RuleResultForExample,
GetExperiments(..),
GetVersions(..),
GetCommitId(..),
GetBuildSystem(..),
GetConfigurations(..), Configuration(..),
BuildSystem(..), findGhcForBuildSystem,
Escaped(..), Unescaped(..), escapeExperiment, unescapeExperiment,
GitCommit
) where
import Control.Applicative
import Control.Lens (preview, view, (^.))
import Control.Monad
import qualified Control.Monad.State as S
import Data.Aeson (FromJSON (..),
ToJSON (..),
Value (..), object,
(.!=), (.:?), (.=))
import Data.Aeson.Lens (AsJSON (_JSON),
_Object, _String)
import Data.ByteString.Lazy (ByteString)
import Data.Char (isDigit)
import Data.List (find, isInfixOf,
stripPrefix,
transpose)
import Data.List.Extra (lower)
import Data.Maybe (fromMaybe)
import Data.String (fromString)
import Data.Text (Text)
import qualified Data.Text as T
import Development.Shake
import Development.Shake.Classes (Binary, Hashable,
NFData, Typeable)
import GHC.Exts (IsList (toList),
fromList)
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import qualified Graphics.Rendering.Chart.Backend.Diagrams as E
import qualified Graphics.Rendering.Chart.Easy as E
import Numeric.Natural
import System.Directory (createDirectoryIfMissing,
findExecutable,
renameFile)
import System.FilePath
import System.Time.Extra (Seconds)
import qualified Text.ParserCombinators.ReadP as P
import Text.Printf
import Text.Read (Read (..), get,
readMaybe,
readP_to_Prec)
newtype GetExperiments = GetExperiments () deriving newtype (Get GetExperiments
[GetExperiments] -> Put
GetExperiments -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GetExperiments] -> Put
$cputList :: [GetExperiments] -> Put
get :: Get GetExperiments
$cget :: Get GetExperiments
put :: GetExperiments -> Put
$cput :: GetExperiments -> Put
Binary, GetExperiments -> GetExperiments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetExperiments -> GetExperiments -> Bool
$c/= :: GetExperiments -> GetExperiments -> Bool
== :: GetExperiments -> GetExperiments -> Bool
$c== :: GetExperiments -> GetExperiments -> Bool
Eq, Eq GetExperiments
Int -> GetExperiments -> Int
GetExperiments -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GetExperiments -> Int
$chash :: GetExperiments -> Int
hashWithSalt :: Int -> GetExperiments -> Int
$chashWithSalt :: Int -> GetExperiments -> Int
Hashable, GetExperiments -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetExperiments -> ()
$crnf :: GetExperiments -> ()
NFData, Int -> GetExperiments -> ShowS
[GetExperiments] -> ShowS
GetExperiments -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetExperiments] -> ShowS
$cshowList :: [GetExperiments] -> ShowS
show :: GetExperiments -> String
$cshow :: GetExperiments -> String
showsPrec :: Int -> GetExperiments -> ShowS
$cshowsPrec :: Int -> GetExperiments -> ShowS
Show)
newtype GetVersions = GetVersions () deriving newtype (Get GetVersions
[GetVersions] -> Put
GetVersions -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GetVersions] -> Put
$cputList :: [GetVersions] -> Put
get :: Get GetVersions
$cget :: Get GetVersions
put :: GetVersions -> Put
$cput :: GetVersions -> Put
Binary, GetVersions -> GetVersions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetVersions -> GetVersions -> Bool
$c/= :: GetVersions -> GetVersions -> Bool
== :: GetVersions -> GetVersions -> Bool
$c== :: GetVersions -> GetVersions -> Bool
Eq, Eq GetVersions
Int -> GetVersions -> Int
GetVersions -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GetVersions -> Int
$chash :: GetVersions -> Int
hashWithSalt :: Int -> GetVersions -> Int
$chashWithSalt :: Int -> GetVersions -> Int
Hashable, GetVersions -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetVersions -> ()
$crnf :: GetVersions -> ()
NFData, Int -> GetVersions -> ShowS
[GetVersions] -> ShowS
GetVersions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetVersions] -> ShowS
$cshowList :: [GetVersions] -> ShowS
show :: GetVersions -> String
$cshow :: GetVersions -> String
showsPrec :: Int -> GetVersions -> ShowS
$cshowsPrec :: Int -> GetVersions -> ShowS
Show)
newtype GetParent = GetParent Text deriving newtype (Get GetParent
[GetParent] -> Put
GetParent -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GetParent] -> Put
$cputList :: [GetParent] -> Put
get :: Get GetParent
$cget :: Get GetParent
put :: GetParent -> Put
$cput :: GetParent -> Put
Binary, GetParent -> GetParent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetParent -> GetParent -> Bool
$c/= :: GetParent -> GetParent -> Bool
== :: GetParent -> GetParent -> Bool
$c== :: GetParent -> GetParent -> Bool
Eq, Eq GetParent
Int -> GetParent -> Int
GetParent -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GetParent -> Int
$chash :: GetParent -> Int
hashWithSalt :: Int -> GetParent -> Int
$chashWithSalt :: Int -> GetParent -> Int
Hashable, GetParent -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetParent -> ()
$crnf :: GetParent -> ()
NFData, Int -> GetParent -> ShowS
[GetParent] -> ShowS
GetParent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetParent] -> ShowS
$cshowList :: [GetParent] -> ShowS
show :: GetParent -> String
$cshow :: GetParent -> String
showsPrec :: Int -> GetParent -> ShowS
$cshowsPrec :: Int -> GetParent -> ShowS
Show)
newtype GetCommitId = GetCommitId String deriving newtype (Get GetCommitId
[GetCommitId] -> Put
GetCommitId -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GetCommitId] -> Put
$cputList :: [GetCommitId] -> Put
get :: Get GetCommitId
$cget :: Get GetCommitId
put :: GetCommitId -> Put
$cput :: GetCommitId -> Put
Binary, GetCommitId -> GetCommitId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCommitId -> GetCommitId -> Bool
$c/= :: GetCommitId -> GetCommitId -> Bool
== :: GetCommitId -> GetCommitId -> Bool
$c== :: GetCommitId -> GetCommitId -> Bool
Eq, Eq GetCommitId
Int -> GetCommitId -> Int
GetCommitId -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GetCommitId -> Int
$chash :: GetCommitId -> Int
hashWithSalt :: Int -> GetCommitId -> Int
$chashWithSalt :: Int -> GetCommitId -> Int
Hashable, GetCommitId -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetCommitId -> ()
$crnf :: GetCommitId -> ()
NFData, Int -> GetCommitId -> ShowS
[GetCommitId] -> ShowS
GetCommitId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCommitId] -> ShowS
$cshowList :: [GetCommitId] -> ShowS
show :: GetCommitId -> String
$cshow :: GetCommitId -> String
showsPrec :: Int -> GetCommitId -> ShowS
$cshowsPrec :: Int -> GetCommitId -> ShowS
Show)
newtype GetBuildSystem = GetBuildSystem () deriving newtype (Get GetBuildSystem
[GetBuildSystem] -> Put
GetBuildSystem -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GetBuildSystem] -> Put
$cputList :: [GetBuildSystem] -> Put
get :: Get GetBuildSystem
$cget :: Get GetBuildSystem
put :: GetBuildSystem -> Put
$cput :: GetBuildSystem -> Put
Binary, GetBuildSystem -> GetBuildSystem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBuildSystem -> GetBuildSystem -> Bool
$c/= :: GetBuildSystem -> GetBuildSystem -> Bool
== :: GetBuildSystem -> GetBuildSystem -> Bool
$c== :: GetBuildSystem -> GetBuildSystem -> Bool
Eq, Eq GetBuildSystem
Int -> GetBuildSystem -> Int
GetBuildSystem -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GetBuildSystem -> Int
$chash :: GetBuildSystem -> Int
hashWithSalt :: Int -> GetBuildSystem -> Int
$chashWithSalt :: Int -> GetBuildSystem -> Int
Hashable, GetBuildSystem -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetBuildSystem -> ()
$crnf :: GetBuildSystem -> ()
NFData, Int -> GetBuildSystem -> ShowS
[GetBuildSystem] -> ShowS
GetBuildSystem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBuildSystem] -> ShowS
$cshowList :: [GetBuildSystem] -> ShowS
show :: GetBuildSystem -> String
$cshow :: GetBuildSystem -> String
showsPrec :: Int -> GetBuildSystem -> ShowS
$cshowsPrec :: Int -> GetBuildSystem -> ShowS
Show)
newtype GetExample = GetExample String deriving newtype (Get GetExample
[GetExample] -> Put
GetExample -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GetExample] -> Put
$cputList :: [GetExample] -> Put
get :: Get GetExample
$cget :: Get GetExample
put :: GetExample -> Put
$cput :: GetExample -> Put
Binary, GetExample -> GetExample -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetExample -> GetExample -> Bool
$c/= :: GetExample -> GetExample -> Bool
== :: GetExample -> GetExample -> Bool
$c== :: GetExample -> GetExample -> Bool
Eq, Eq GetExample
Int -> GetExample -> Int
GetExample -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GetExample -> Int
$chash :: GetExample -> Int
hashWithSalt :: Int -> GetExample -> Int
$chashWithSalt :: Int -> GetExample -> Int
Hashable, GetExample -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetExample -> ()
$crnf :: GetExample -> ()
NFData, Int -> GetExample -> ShowS
[GetExample] -> ShowS
GetExample -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetExample] -> ShowS
$cshowList :: [GetExample] -> ShowS
show :: GetExample -> String
$cshow :: GetExample -> String
showsPrec :: Int -> GetExample -> ShowS
$cshowsPrec :: Int -> GetExample -> ShowS
Show)
newtype GetExamples = GetExamples () deriving newtype (Get GetExamples
[GetExamples] -> Put
GetExamples -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GetExamples] -> Put
$cputList :: [GetExamples] -> Put
get :: Get GetExamples
$cget :: Get GetExamples
put :: GetExamples -> Put
$cput :: GetExamples -> Put
Binary, GetExamples -> GetExamples -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetExamples -> GetExamples -> Bool
$c/= :: GetExamples -> GetExamples -> Bool
== :: GetExamples -> GetExamples -> Bool
$c== :: GetExamples -> GetExamples -> Bool
Eq, Eq GetExamples
Int -> GetExamples -> Int
GetExamples -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GetExamples -> Int
$chash :: GetExamples -> Int
hashWithSalt :: Int -> GetExamples -> Int
$chashWithSalt :: Int -> GetExamples -> Int
Hashable, GetExamples -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetExamples -> ()
$crnf :: GetExamples -> ()
NFData, Int -> GetExamples -> ShowS
[GetExamples] -> ShowS
GetExamples -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetExamples] -> ShowS
$cshowList :: [GetExamples] -> ShowS
show :: GetExamples -> String
$cshow :: GetExamples -> String
showsPrec :: Int -> GetExamples -> ShowS
$cshowsPrec :: Int -> GetExamples -> ShowS
Show)
newtype GetConfigurations = GetConfigurations () deriving newtype (Get GetConfigurations
[GetConfigurations] -> Put
GetConfigurations -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GetConfigurations] -> Put
$cputList :: [GetConfigurations] -> Put
get :: Get GetConfigurations
$cget :: Get GetConfigurations
put :: GetConfigurations -> Put
$cput :: GetConfigurations -> Put
Binary, GetConfigurations -> GetConfigurations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetConfigurations -> GetConfigurations -> Bool
$c/= :: GetConfigurations -> GetConfigurations -> Bool
== :: GetConfigurations -> GetConfigurations -> Bool
$c== :: GetConfigurations -> GetConfigurations -> Bool
Eq, Eq GetConfigurations
Int -> GetConfigurations -> Int
GetConfigurations -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GetConfigurations -> Int
$chash :: GetConfigurations -> Int
hashWithSalt :: Int -> GetConfigurations -> Int
$chashWithSalt :: Int -> GetConfigurations -> Int
Hashable, GetConfigurations -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetConfigurations -> ()
$crnf :: GetConfigurations -> ()
NFData, Int -> GetConfigurations -> ShowS
[GetConfigurations] -> ShowS
GetConfigurations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetConfigurations] -> ShowS
$cshowList :: [GetConfigurations] -> ShowS
show :: GetConfigurations -> String
$cshow :: GetConfigurations -> String
showsPrec :: Int -> GetConfigurations -> ShowS
$cshowsPrec :: Int -> GetConfigurations -> ShowS
Show)
type instance RuleResult GetExperiments = [Unescaped String]
type instance RuleResult GetVersions = [GitCommit]
type instance RuleResult GetParent = Text
type instance RuleResult GetCommitId = String
type instance RuleResult GetBuildSystem = BuildSystem
type RuleResultForExample e =
( RuleResult GetExample ~ Maybe e
, RuleResult GetExamples ~ [e]
, IsExample e)
data Configuration = Configuration {Configuration -> String
confName :: String, Configuration -> ByteString
confValue :: ByteString}
deriving (Get Configuration
[Configuration] -> Put
Configuration -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Configuration] -> Put
$cputList :: [Configuration] -> Put
get :: Get Configuration
$cget :: Get Configuration
put :: Configuration -> Put
$cput :: Configuration -> Put
Binary, Configuration -> Configuration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Configuration -> Configuration -> Bool
$c/= :: Configuration -> Configuration -> Bool
== :: Configuration -> Configuration -> Bool
$c== :: Configuration -> Configuration -> Bool
Eq, forall x. Rep Configuration x -> Configuration
forall x. Configuration -> Rep Configuration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Configuration x -> Configuration
$cfrom :: forall x. Configuration -> Rep Configuration x
Generic, Eq Configuration
Int -> Configuration -> Int
Configuration -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Configuration -> Int
$chash :: Configuration -> Int
hashWithSalt :: Int -> Configuration -> Int
$chashWithSalt :: Int -> Configuration -> Int
Hashable, Configuration -> ()
forall a. (a -> ()) -> NFData a
rnf :: Configuration -> ()
$crnf :: Configuration -> ()
NFData, Int -> Configuration -> ShowS
[Configuration] -> ShowS
Configuration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Configuration] -> ShowS
$cshowList :: [Configuration] -> ShowS
show :: Configuration -> String
$cshow :: Configuration -> String
showsPrec :: Int -> Configuration -> ShowS
$cshowsPrec :: Int -> Configuration -> ShowS
Show, Typeable)
type instance RuleResult GetConfigurations = [Configuration]
class (Binary e, Eq e, Hashable e, NFData e, Show e, Typeable e) => IsExample e where
getExampleName :: e -> String
allTargetsForExample :: IsExample e => ProfilingMode -> FilePath -> e -> Action [FilePath]
allTargetsForExample :: forall e.
IsExample e =>
ProfilingMode -> String -> e -> Action [String]
allTargetsForExample ProfilingMode
prof String
baseFolder e
ex = do
[Unescaped String]
experiments <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ () -> GetExperiments
GetExperiments ()
[GitCommit]
versions <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ () -> GetVersions
GetVersions ()
[Configuration]
configurations <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ () -> GetConfigurations
GetConfigurations ()
let buildFolder :: String
buildFolder = String
baseFolder String -> ShowS
</> ProfilingMode -> String
profilingPath ProfilingMode
prof
return $
[String
buildFolder String -> ShowS
</> forall e. IsExample e => e -> String
getExampleName e
ex String -> ShowS
</> String
"results.csv"]
forall a. [a] -> [a] -> [a]
++ [ String
buildFolder String -> ShowS
</> forall e. IsExample e => e -> String
getExampleName e
ex String -> ShowS
</> forall a. Escaped a -> a
escaped (Unescaped String -> Escaped String
escapeExperiment Unescaped String
e) String -> ShowS
<.> String
"svg"
| Unescaped String
e <- [Unescaped String]
experiments
]
forall a. [a] -> [a] -> [a]
++ [ String
buildFolder String -> ShowS
</>
forall e. IsExample e => e -> String
getExampleName e
ex String -> ShowS
</>
Text -> String
T.unpack (GitCommit -> Text
humanName GitCommit
ver) String -> ShowS
</>
String
confName String -> ShowS
</>
forall a. Escaped a -> a
escaped (Unescaped String -> Escaped String
escapeExperiment Unescaped String
e) String -> ShowS
<.>
String
mode
| Unescaped String
e <- [Unescaped String]
experiments,
GitCommit
ver <- [GitCommit]
versions,
Configuration{String
confName :: String
$sel:confName:Configuration :: Configuration -> String
confName} <- [Configuration]
configurations,
String
mode <- [String
"svg", String
"diff.svg"] forall a. [a] -> [a] -> [a]
++ [String
"heap.svg" | ProfilingMode
prof forall a. Eq a => a -> a -> Bool
/= ProfilingMode
NoProfiling]
]
allBinaries :: FilePath -> String -> Action [FilePath]
allBinaries :: String -> String -> Action [String]
allBinaries String
buildFolder String
executableName = do
[GitCommit]
versions <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ () -> GetVersions
GetVersions ()
return $
[ String
buildFolder String -> ShowS
</> String
"binaries" String -> ShowS
</> Text -> String
T.unpack (GitCommit -> Text
humanName GitCommit
ver) String -> ShowS
</> String
executableName
| GitCommit
ver <- [GitCommit]
versions]
phonyRules
:: (Traversable t, IsExample e)
=> String
-> String
-> ProfilingMode
-> FilePath
-> t e
-> Rules ()
phonyRules :: forall (t :: * -> *) e.
(Traversable t, IsExample e) =>
String -> String -> ProfilingMode -> String -> t e -> Rules ()
phonyRules String
prefix String
executableName ProfilingMode
prof String
buildFolder t e
examples = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t e
examples forall a b. (a -> b) -> a -> b
$ \e
ex ->
HasCallStack => String -> Action () -> Rules ()
phony (String
prefix forall a. Semigroup a => a -> a -> a
<> forall e. IsExample e => e -> String
getExampleName e
ex) forall a b. (a -> b) -> a -> b
$ HasCallStack => [String] -> Action ()
need forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
forall e.
IsExample e =>
ProfilingMode -> String -> e -> Action [String]
allTargetsForExample ProfilingMode
prof String
buildFolder e
ex
HasCallStack => String -> Action () -> Rules ()
phony (String
prefix forall a. Semigroup a => a -> a -> a
<> String
"all") forall a b. (a -> b) -> a -> b
$ do
t [String]
exampleTargets <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM t e
examples forall a b. (a -> b) -> a -> b
$ \e
ex ->
forall e.
IsExample e =>
ProfilingMode -> String -> e -> Action [String]
allTargetsForExample ProfilingMode
prof String
buildFolder e
ex
HasCallStack => [String] -> Action ()
need forall a b. (a -> b) -> a -> b
$ (String
buildFolder String -> ShowS
</> ProfilingMode -> String
profilingPath ProfilingMode
prof String -> ShowS
</> String
"results.csv")
forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [String]
exampleTargets
HasCallStack => String -> Action () -> Rules ()
phony (String
prefix forall a. Semigroup a => a -> a -> a
<> String
"all-binaries") forall a b. (a -> b) -> a -> b
$ HasCallStack => [String] -> Action ()
need forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> Action [String]
allBinaries String
buildFolder String
executableName
type OutputFolder = FilePath
type ProjectRoot = FilePath
data MkBuildRules buildSystem = MkBuildRules
{
forall buildSystem.
MkBuildRules buildSystem -> buildSystem -> String -> IO String
findGhc :: buildSystem -> FilePath -> IO FilePath
, forall buildSystem. MkBuildRules buildSystem -> String
executableName :: String
, forall buildSystem. MkBuildRules buildSystem -> Action ()
projectDepends :: Action ()
, forall buildSystem.
MkBuildRules buildSystem
-> buildSystem -> String -> String -> Action ()
buildProject :: buildSystem
-> ProjectRoot
-> OutputFolder
-> Action ()
}
buildRules :: FilePattern -> MkBuildRules BuildSystem -> Rules ()
buildRules :: String -> MkBuildRules BuildSystem -> Rules ()
buildRules String
build MkBuildRules{String
Action ()
BuildSystem -> String -> IO String
BuildSystem -> String -> String -> Action ()
buildProject :: BuildSystem -> String -> String -> Action ()
projectDepends :: Action ()
executableName :: String
findGhc :: BuildSystem -> String -> IO String
$sel:buildProject:MkBuildRules :: forall buildSystem.
MkBuildRules buildSystem
-> buildSystem -> String -> String -> Action ()
$sel:projectDepends:MkBuildRules :: forall buildSystem. MkBuildRules buildSystem -> Action ()
$sel:executableName:MkBuildRules :: forall buildSystem. MkBuildRules buildSystem -> String
$sel:findGhc:MkBuildRules :: forall buildSystem.
MkBuildRules buildSystem -> buildSystem -> String -> IO String
..} = do
String
build String -> ShowS
-/- String
"binaries/*/commitid" HasCallStack => String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
Action ()
alwaysRerun
let [String
_,String
_,String
ver,String
_] = String -> [String]
splitDirectories String
out
Maybe GitCommit
mbEntry <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
ver) forall b c a. (b -> c) -> (a -> b) -> a -> c
. GitCommit -> Text
humanName) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle (() -> GetVersions
GetVersions ())
let gitThing :: String
gitThing :: String
gitThing = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
ver (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. GitCommit -> Text
gitName) Maybe GitCommit
mbEntry
Stdout String
commitid <- forall r.
(HasCallStack, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [] String
"git" [String
"rev-list", String
"-n", String
"1", String
gitThing]
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
String -> String -> m ()
writeFileChanged String
out forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init String
commitid
forall a. Double -> Rules a -> Rules a
priority Double
10 forall a b. (a -> b) -> a -> b
$ [ String
build String -> ShowS
-/- String
"binaries/HEAD/" forall a. Semigroup a => a -> a -> a
<> String
executableName
, String
build String -> ShowS
-/- String
"binaries/HEAD/ghc.path"
]
HasCallStack => [String] -> ([String] -> Action ()) -> Rules ()
&%> \[String
out, String
ghcpath] -> do
Action ()
projectDepends
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ ShowS
dropFileName String
out
BuildSystem
buildSystem <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ () -> GetBuildSystem
GetBuildSystem ()
BuildSystem -> String -> String -> Action ()
buildProject BuildSystem
buildSystem String
"." (ShowS
takeDirectory String
out)
String
ghcLoc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ BuildSystem -> String -> IO String
findGhc BuildSystem
buildSystem String
"."
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
String -> String -> m ()
writeFile' String
ghcpath String
ghcLoc
[String
build String -> ShowS
-/- String
"binaries/*/" forall a. Semigroup a => a -> a -> a
<> String
executableName
,String
build String -> ShowS
-/- String
"binaries/*/ghc.path"
] HasCallStack => [String] -> ([String] -> Action ()) -> Rules ()
&%> \[String
out, String
ghcPath] -> do
let [String
_, String
_binaries, String
ver, String
_] = String -> [String]
splitDirectories String
out
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ ShowS
dropFileName String
out
String
commitid <- HasCallStack => String -> Action String
readFile' forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
out String -> ShowS
</> String
"commitid"
forall args. (HasCallStack, CmdArguments args, Unit args) => args
cmd_ forall a b. (a -> b) -> a -> b
$ String
"git worktree add bench-temp-" forall a. [a] -> [a] -> [a]
++ String
ver forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
commitid
BuildSystem
buildSystem <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ () -> GetBuildSystem
GetBuildSystem ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Action a -> IO b -> Action a
actionFinally (forall args. (HasCallStack, CmdArguments args, Unit args) => args
cmd_ (String
"git worktree remove bench-temp-" forall a. Semigroup a => a -> a -> a
<> String
ver forall a. Semigroup a => a -> a -> a
<> String
" --force" :: String)) forall a b. (a -> b) -> a -> b
$ do
String
ghcLoc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ BuildSystem -> String -> IO String
findGhc BuildSystem
buildSystem String
ver
BuildSystem -> String -> String -> Action ()
buildProject BuildSystem
buildSystem (String
"bench-temp-" forall a. Semigroup a => a -> a -> a
<> String
ver) (String
".." String -> ShowS
</> ShowS
takeDirectory String
out)
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
String -> String -> m ()
writeFile' String
ghcPath String
ghcLoc
data MkBenchRules buildSystem example = forall setup. MkBenchRules
{
()
setupProject :: Action setup
, ()
benchProject :: setup -> buildSystem -> [CmdOption] -> BenchProject example -> Action ()
, forall buildSystem example.
MkBenchRules buildSystem example
-> buildSystem -> String -> [CmdOption] -> example -> Action ()
warmupProject :: buildSystem -> FilePath -> [CmdOption] -> example -> Action ()
, forall buildSystem example.
MkBenchRules buildSystem example -> String
executableName :: String
, forall buildSystem example.
MkBenchRules buildSystem example -> Natural
parallelism :: Natural
}
data BenchProject example = BenchProject
{ forall example. BenchProject example -> String
outcsv :: FilePath
, forall example. BenchProject example -> String
exePath :: FilePath
, :: [String]
, forall example. BenchProject example -> example
example :: example
, forall example. BenchProject example -> Escaped String
experiment :: Escaped String
, forall example. BenchProject example -> ByteString
configuration :: ByteString
}
data ProfilingMode = NoProfiling | CheapHeapProfiling Seconds
deriving (ProfilingMode -> ProfilingMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilingMode -> ProfilingMode -> Bool
$c/= :: ProfilingMode -> ProfilingMode -> Bool
== :: ProfilingMode -> ProfilingMode -> Bool
$c== :: ProfilingMode -> ProfilingMode -> Bool
Eq)
profilingP :: String -> Maybe ProfilingMode
profilingP :: String -> Maybe ProfilingMode
profilingP String
"unprofiled" = forall a. a -> Maybe a
Just ProfilingMode
NoProfiling
profilingP String
inp | Just String
delay <- forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"profiled-" String
inp, Just Double
i <- forall a. Read a => String -> Maybe a
readMaybe String
delay = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> ProfilingMode
CheapHeapProfiling Double
i
profilingP String
_ = forall a. Maybe a
Nothing
profilingPath :: ProfilingMode -> FilePath
profilingPath :: ProfilingMode -> String
profilingPath ProfilingMode
NoProfiling = String
"unprofiled"
profilingPath (CheapHeapProfiling Double
i) = String
"profiled-" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Double
i
benchRules :: RuleResultForExample example => FilePattern -> MkBenchRules BuildSystem example -> Rules ()
benchRules :: forall example.
RuleResultForExample example =>
String -> MkBenchRules BuildSystem example -> Rules ()
benchRules String
build MkBenchRules{Natural
String
Action setup
setup
-> BuildSystem -> [CmdOption] -> BenchProject example -> Action ()
BuildSystem -> String -> [CmdOption] -> example -> Action ()
parallelism :: Natural
executableName :: String
warmupProject :: BuildSystem -> String -> [CmdOption] -> example -> Action ()
benchProject :: setup
-> BuildSystem -> [CmdOption] -> BenchProject example -> Action ()
setupProject :: Action setup
$sel:parallelism:MkBenchRules :: forall buildSystem example.
MkBenchRules buildSystem example -> Natural
$sel:executableName:MkBenchRules :: forall buildSystem example.
MkBenchRules buildSystem example -> String
$sel:warmupProject:MkBenchRules :: forall buildSystem example.
MkBenchRules buildSystem example
-> buildSystem -> String -> [CmdOption] -> example -> Action ()
$sel:benchProject:MkBenchRules :: ()
$sel:setupProject:MkBenchRules :: ()
..} = do
Resource
benchResource <- String -> Int -> Rules Resource
newResource String
"ghcide-bench" (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
parallelism)
String
build String -> ShowS
-/- String
"binaries/*/*.warmup" HasCallStack => String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
let [String
_, String
_, String
ver, String
exampleName] = String -> [String]
splitDirectories (ShowS
dropExtension String
out)
let exePath :: String
exePath = String
build String -> ShowS
</> String
"binaries" String -> ShowS
</> String
ver String -> ShowS
</> String
executableName
ghcPath :: String
ghcPath = String
build String -> ShowS
</> String
"binaries" String -> ShowS
</> String
ver String -> ShowS
</> String
"ghc.path"
HasCallStack => [String] -> Action ()
need [String
exePath, String
ghcPath]
BuildSystem
buildSystem <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ () -> GetBuildSystem
GetBuildSystem ()
example
example <- forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unknown example " forall a. Semigroup a => a -> a -> a
<> String
exampleName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle (String -> GetExample
GetExample String
exampleName)
let exeExtraArgs :: [a]
exeExtraArgs = []
outcsv :: String
outcsv = String
""
experiment :: Escaped String
experiment = forall a. a -> Escaped a
Escaped String
"hover"
forall a. Resource -> Int -> Action a -> Action a
withResource Resource
benchResource Int
1 forall a b. (a -> b) -> a -> b
$ BuildSystem -> String -> [CmdOption] -> example -> Action ()
warmupProject BuildSystem
buildSystem String
exePath
[ Bool -> CmdOption
EchoStdout Bool
False,
String -> CmdOption
FileStdout String
out,
String -> CmdOption
RemEnv String
"NIX_GHC_LIBDIR",
String -> CmdOption
RemEnv String
"GHC_PACKAGE_PATH",
[String] -> [String] -> CmdOption
AddPath [ShowS
takeDirectory String
ghcPath, String
"."] []
]
example
example
forall a. Double -> Rules a -> Rules a
priority Double
0 forall a b. (a -> b) -> a -> b
$
[ String
build String -> ShowS
-/- String
"*/*/*/*/*.csv",
String
build String -> ShowS
-/- String
"*/*/*/*/*.gcStats.log",
String
build String -> ShowS
-/- String
"*/*/*/*/*.output.log",
String
build String -> ShowS
-/- String
"*/*/*/*/*.eventlog",
String
build String -> ShowS
-/- String
"*/*/*/*/*.hp"
] HasCallStack => [String] -> ([String] -> Action ()) -> Rules ()
&%> \[String
outcsv, String
outGc, String
outLog, String
outEventlog, String
outHp] -> do
let [String
_, String
flavour, String
exampleName, String
ver, String
conf, String
exp] = String -> [String]
splitDirectories String
outcsv
prof :: ProfilingMode
prof = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Not a valid profiling mode: " forall a. Semigroup a => a -> a -> a
<> String
flavour) forall a b. (a -> b) -> a -> b
$ String -> Maybe ProfilingMode
profilingP String
flavour
example
example <- forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unknown example " forall a. Semigroup a => a -> a -> a
<> String
exampleName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle (String -> GetExample
GetExample String
exampleName)
BuildSystem
buildSystem <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ () -> GetBuildSystem
GetBuildSystem ()
[Configuration]
configurations <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ () -> GetConfigurations
GetConfigurations ()
setup
setupRes <- Action setup
setupProject
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ ShowS
dropFileName String
outcsv
let exePath :: String
exePath = String
build String -> ShowS
</> String
"binaries" String -> ShowS
</> String
ver String -> ShowS
</> String
executableName
exeExtraArgs :: [String]
exeExtraArgs =
[ String
"+RTS"
, String
"-l"
, String
"-ol" forall a. Semigroup a => a -> a -> a
<> String
outEventlog
, String
"-S" forall a. Semigroup a => a -> a -> a
<> String
outGc]
forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[[ String
"-h"
, String
"-i" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Double
i
, String
"-po" forall a. Semigroup a => a -> a -> a
<> String
outHp
, String
"-qg"]
| CheapHeapProfiling Double
i <- [ProfilingMode
prof]]
forall a. [a] -> [a] -> [a]
++ [String
"-RTS"]
ghcPath :: String
ghcPath = String
build String -> ShowS
</> String
"binaries" String -> ShowS
</> String
ver String -> ShowS
</> String
"ghc.path"
warmupPath :: String
warmupPath = String
build String -> ShowS
</> String
"binaries" String -> ShowS
</> String
ver String -> ShowS
</> String
exampleName String -> ShowS
<.> String
"warmup"
experiment :: Escaped String
experiment = forall a. a -> Escaped a
Escaped forall a b. (a -> b) -> a -> b
$ ShowS
dropExtension String
exp
Just Configuration{String
ByteString
confValue :: ByteString
confName :: String
$sel:confValue:Configuration :: Configuration -> ByteString
$sel:confName:Configuration :: Configuration -> String
..} = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Configuration{String
confName :: String
$sel:confName:Configuration :: Configuration -> String
confName} -> String
confName forall a. Eq a => a -> a -> Bool
== String
conf) [Configuration]
configurations
configuration :: ByteString
configuration = ByteString
confValue
HasCallStack => [String] -> Action ()
need [String
exePath, String
ghcPath, String
warmupPath]
String
ghcPath <- HasCallStack => String -> Action String
readFile' String
ghcPath
forall a. Resource -> Int -> Action a -> Action a
withResource Resource
benchResource Int
1 forall a b. (a -> b) -> a -> b
$ do
setup
-> BuildSystem -> [CmdOption] -> BenchProject example -> Action ()
benchProject setup
setupRes BuildSystem
buildSystem
[ Bool -> CmdOption
EchoStdout Bool
False,
String -> CmdOption
FileStdout String
outLog,
String -> CmdOption
RemEnv String
"NIX_GHC_LIBDIR",
String -> CmdOption
RemEnv String
"GHC_PACKAGE_PATH",
[String] -> [String] -> CmdOption
AddPath [ShowS
takeDirectory String
ghcPath, String
"."] []
]
BenchProject {example
String
[String]
ByteString
Escaped String
configuration :: ByteString
experiment :: Escaped String
exeExtraArgs :: [String]
exePath :: String
example :: example
outcsv :: String
$sel:configuration:BenchProject :: ByteString
$sel:experiment:BenchProject :: Escaped String
$sel:example:BenchProject :: example
$sel:exeExtraArgs:BenchProject :: [String]
$sel:exePath:BenchProject :: String
$sel:outcsv:BenchProject :: String
..}
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ case ProfilingMode
prof of
ProfilingMode
NoProfiling -> String -> String -> IO ()
writeFile String
outHp String
dummyHp
ProfilingMode
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
[String]
csvContents <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
outcsv
let header :: String
header = forall a. [a] -> a
head [String]
csvContents
results :: [String]
results = forall a. [a] -> [a]
tail [String]
csvContents
header' :: String
header' = String
header forall a. Semigroup a => a -> a -> a
<> String
", maxResidency, allocatedBytes"
[String]
results' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
results forall a b. (a -> b) -> a -> b
$ \String
row -> do
(Int
maxResidency, Int
allocations) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(String -> (Int, Int)
parseMaxResidencyAndAllocations forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
outGc)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%s, %s, %s" String
row (Int -> String
showMB Int
maxResidency) (Int -> String
showMB Int
allocations)
let csvContents' :: [String]
csvContents' = String
header' forall a. a -> [a] -> [a]
: [String]
results'
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
String -> [String] -> m ()
writeFileLines String
outcsv [String]
csvContents'
where
showMB :: Int -> String
showMB :: Int -> String
showMB Int
x = forall a. Show a => a -> String
show (Int
x forall a. Integral a => a -> a -> a
`div` Int
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
20::Int)) forall a. Semigroup a => a -> a -> a
<> String
"MB"
parseMaxResidencyAndAllocations :: String -> (Int, Int)
parseMaxResidencyAndAllocations :: String -> (Int, Int)
parseMaxResidencyAndAllocations String
input =
(String -> Int
f String
"maximum residency", String -> Int
f String
"bytes allocated in the heap")
where
inps :: [String]
inps = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
input
f :: String -> Int
f String
label = case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String
label forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) [String]
inps of
Just String
l -> forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
l
Maybe String
Nothing -> -Int
1
csvRules :: forall example . RuleResultForExample example => FilePattern -> Rules ()
csvRules :: forall example. RuleResultForExample example => String -> Rules ()
csvRules String
build = do
String
build String -> ShowS
-/- String
"*/*/*/*/results.csv" HasCallStack => String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
[Unescaped String]
experiments <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ () -> GetExperiments
GetExperiments ()
let allResultFiles :: [String]
allResultFiles = [ShowS
takeDirectory String
out String -> ShowS
</> forall a. Escaped a -> a
escaped (Unescaped String -> Escaped String
escapeExperiment Unescaped String
e) String -> ShowS
<.> String
"csv" | Unescaped String
e <- [Unescaped String]
experiments]
[[String]]
allResults <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse HasCallStack => String -> Action [String]
readFileLines [String]
allResultFiles
let header :: String
header = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [[String]]
allResults
results :: [[String]]
results = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
tail [[String]]
allResults
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
String -> String -> m ()
writeFileChanged String
out forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ String
header forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
results
String
build String -> ShowS
-/- String
"*/*/*/results.csv" HasCallStack => String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
[String]
configurations <- forall a b. (a -> b) -> [a] -> [b]
map Configuration -> String
confName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle (() -> GetConfigurations
GetConfigurations ())
let allResultFiles :: [String]
allResultFiles = [ShowS
takeDirectory String
out String -> ShowS
</> String
c String -> ShowS
</> String
"results.csv" | String
c <- [String]
configurations ]
[[String]]
allResults <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse HasCallStack => String -> Action [String]
readFileLines [String]
allResultFiles
let header :: String
header = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [[String]]
allResults
results :: [[String]]
results = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
tail [[String]]
allResults
header' :: String
header' = String
"configuration, " forall a. Semigroup a => a -> a -> a
<> String
header
results' :: [[String]]
results' = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String
v -> forall a b. (a -> b) -> [a] -> [b]
map (\String
l -> String
v forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> String
l)) [String]
configurations [[String]]
results
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
String -> String -> m ()
writeFileChanged String
out forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ String
header' forall a. a -> [a] -> [a]
: forall a. [[a]] -> [a]
interleave [[String]]
results'
String
build String -> ShowS
-/- String
"*/*/results.csv" HasCallStack => String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
[String]
versions <- forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. GitCommit -> Text
humanName) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle (() -> GetVersions
GetVersions ())
let allResultFiles :: [String]
allResultFiles = [ShowS
takeDirectory String
out String -> ShowS
</> String
v String -> ShowS
</> String
"results.csv" | String
v <- [String]
versions]
[[String]]
allResults <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse HasCallStack => String -> Action [String]
readFileLines [String]
allResultFiles
let header :: String
header = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [[String]]
allResults
results :: [[String]]
results = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
tail [[String]]
allResults
header' :: String
header' = String
"version, " forall a. Semigroup a => a -> a -> a
<> String
header
results' :: [[String]]
results' = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String
v -> forall a b. (a -> b) -> [a] -> [b]
map (\String
l -> String
v forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> String
l)) [String]
versions [[String]]
results
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
String -> String -> m ()
writeFileChanged String
out forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ String
header' forall a. a -> [a] -> [a]
: forall a. [[a]] -> [a]
interleave [[String]]
results'
String
build String -> ShowS
-/- String
"*/results.csv" HasCallStack => String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
[String]
examples <- forall a b. (a -> b) -> [a] -> [b]
map (forall e. IsExample e => e -> String
getExampleName @example) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle (() -> GetExamples
GetExamples ())
let allResultFiles :: [String]
allResultFiles = [ShowS
takeDirectory String
out String -> ShowS
</> String
e String -> ShowS
</> String
"results.csv" | String
e <- [String]
examples]
[[String]]
allResults <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse HasCallStack => String -> Action [String]
readFileLines [String]
allResultFiles
let header :: String
header = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [[String]]
allResults
results :: [[String]]
results = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
tail [[String]]
allResults
header' :: String
header' = String
"example, " forall a. Semigroup a => a -> a -> a
<> String
header
results' :: [[String]]
results' = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String
e -> forall a b. (a -> b) -> [a] -> [b]
map (\String
l -> String
e forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> String
l)) [String]
examples [[String]]
results
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
String -> String -> m ()
writeFileChanged String
out forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ String
header' forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
results'
svgRules :: FilePattern -> Rules ()
svgRules :: String -> Rules ()
svgRules String
build = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, HasCallStack) =>
(q -> Action a) -> Rules (q -> Action a)
addOracle forall a b. (a -> b) -> a -> b
$ \(GetParent Text
name) -> Text -> [GitCommit] -> Text
findPrev Text
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle (() -> GetVersions
GetVersions ())
forall a. Double -> Rules a -> Rules a
priority Double
1 forall a b. (a -> b) -> a -> b
$
String
build String -> ShowS
-/- String
"*/*/*/*/*.svg" HasCallStack => String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
let [String
_, String
_, String
_example, String
ver, String
conf, String
_exp] = String -> [String]
splitDirectories String
out
RunLog
runLog <- HasCallStack => Escaped String -> String -> String -> Action RunLog
loadRunLog (forall a. a -> Escaped a
Escaped forall a b. (a -> b) -> a -> b
$ String -> ShowS
replaceExtension String
out String
"csv") String
ver String
conf
let diagram :: Diagram
diagram = TraceMetric -> [RunLog] -> String -> Diagram
Diagram TraceMetric
Live [RunLog
runLog] String
title
title :: String
title = String
ver forall a. Semigroup a => a -> a -> a
<> String
" live bytes over time"
Bool -> Diagram -> String -> Action ()
plotDiagram Bool
True Diagram
diagram String
out
forall a. Double -> Rules a -> Rules a
priority Double
2 forall a b. (a -> b) -> a -> b
$
String
build String -> ShowS
-/- String
"*/*/*/*/*.diff.svg" HasCallStack => String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
let [String
b, String
flav, String
example, String
ver, String
conf, String
exp_] = String -> [String]
splitDirectories String
out
exp :: Escaped String
exp = forall a. a -> Escaped a
Escaped forall a b. (a -> b) -> a -> b
$ ShowS
dropExtension2 String
exp_
String
prev <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ Text -> GetParent
GetParent forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
ver
RunLog
runLog <- HasCallStack => Escaped String -> String -> String -> Action RunLog
loadRunLog (forall a. a -> Escaped a
Escaped forall a b. (a -> b) -> a -> b
$ String -> ShowS
replaceExtension (ShowS
dropExtension String
out) String
"csv") String
ver String
conf
RunLog
runLogPrev <- HasCallStack => Escaped String -> String -> String -> Action RunLog
loadRunLog (forall a. a -> Escaped a
Escaped forall a b. (a -> b) -> a -> b
$ [String] -> String
joinPath [String
b,String
flav, String
example, String
prev, String
conf, String -> ShowS
replaceExtension (ShowS
dropExtension String
exp_) String
"csv"]) String
prev String
conf
let diagram :: Diagram
diagram = TraceMetric -> [RunLog] -> String -> Diagram
Diagram TraceMetric
Live [RunLog
runLog, RunLog
runLogPrev] String
title
title :: String
title = forall a. Show a => a -> String
show (Escaped String -> Unescaped String
unescapeExperiment Escaped String
exp) forall a. Semigroup a => a -> a -> a
<> String
" - live bytes over time compared"
Bool -> Diagram -> String -> Action ()
plotDiagram Bool
True Diagram
diagram String
out
String
build String -> ShowS
-/- String
"*/*/*/*.svg" HasCallStack => String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
let exp :: Escaped String
exp = forall a. a -> Escaped a
Escaped forall a b. (a -> b) -> a -> b
$ ShowS
dropExtension forall a b. (a -> b) -> a -> b
$ ShowS
takeFileName String
out
[String
b, String
flav, String
example, String
ver] = String -> [String]
splitDirectories String
out
[GitCommit]
versions <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ () -> GetVersions
GetVersions ()
[Configuration]
configurations <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ () -> GetConfigurations
GetConfigurations ()
[RunLog]
runLogs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Configuration]
configurations forall a b. (a -> b) -> a -> b
$ \Configuration{String
confName :: String
$sel:confName:Configuration :: Configuration -> String
confName} -> do
HasCallStack => Escaped String -> String -> String -> Action RunLog
loadRunLog (forall a. a -> Escaped a
Escaped forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
out String -> ShowS
</> String
confName String -> ShowS
</> String -> ShowS
replaceExtension (ShowS
takeFileName String
out) String
"csv") String
ver String
confName
let diagram :: Diagram
diagram = TraceMetric -> [RunLog] -> String -> Diagram
Diagram TraceMetric
Live [RunLog]
runLogs String
title
title :: String
title = forall a. Show a => a -> String
show (Escaped String -> Unescaped String
unescapeExperiment Escaped String
exp) forall a. Semigroup a => a -> a -> a
<> String
" - live bytes over time"
Bool -> Diagram -> String -> Action ()
plotDiagram Bool
False Diagram
diagram String
out
String
build String -> ShowS
-/- String
"*/*/*.svg" HasCallStack => String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
let exp :: Escaped String
exp = forall a. a -> Escaped a
Escaped forall a b. (a -> b) -> a -> b
$ ShowS
dropExtension forall a b. (a -> b) -> a -> b
$ ShowS
takeFileName String
out
[GitCommit]
versions <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ () -> GetVersions
GetVersions ()
[Configuration]
configurations <- forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ () -> GetConfigurations
GetConfigurations ()
[[RunLog]]
runLogs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a. (a -> Bool) -> [a] -> [a]
filter GitCommit -> Bool
include [GitCommit]
versions) forall a b. (a -> b) -> a -> b
$ \GitCommit
v ->
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Configuration]
configurations forall a b. (a -> b) -> a -> b
$ \Configuration{String
confName :: String
$sel:confName:Configuration :: Configuration -> String
confName} -> do
let v' :: String
v' = Text -> String
T.unpack (GitCommit -> Text
humanName GitCommit
v)
HasCallStack => Escaped String -> String -> String -> Action RunLog
loadRunLog (forall a. a -> Escaped a
Escaped forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
out String -> ShowS
</> String
v' String -> ShowS
</> String
confName String -> ShowS
</> String -> ShowS
replaceExtension (ShowS
takeFileName String
out) String
"csv") String
v' String
confName
let diagram :: Diagram
diagram = TraceMetric -> [RunLog] -> String -> Diagram
Diagram TraceMetric
Live (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[RunLog]]
runLogs) String
title
title :: String
title = forall a. Show a => a -> String
show (Escaped String -> Unescaped String
unescapeExperiment Escaped String
exp) forall a. Semigroup a => a -> a -> a
<> String
" - live bytes over time"
Bool -> Diagram -> String -> Action ()
plotDiagram Bool
False Diagram
diagram String
out
heapProfileRules :: FilePattern -> Rules ()
heapProfileRules :: String -> Rules ()
heapProfileRules String
build = do
forall a. Double -> Rules a -> Rules a
priority Double
3 forall a b. (a -> b) -> a -> b
$
String
build String -> ShowS
-/- String
"*/*/*/*/*.heap.svg" HasCallStack => String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
let hpFile :: String
hpFile = ShowS
dropExtension2 String
out String -> ShowS
<.> String
"hp"
HasCallStack => [String] -> Action ()
need [String
hpFile]
forall args. (HasCallStack, CmdArguments args, Unit args) => args
cmd_ (String
"hp2pretty" :: String) [String
hpFile]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
renameFile (ShowS
dropExtension String
hpFile String -> ShowS
<.> String
"svg") String
out
dropExtension2 :: FilePath -> FilePath
dropExtension2 :: ShowS
dropExtension2 = ShowS
dropExtension forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
dropExtension
data BuildSystem = Cabal | Stack
deriving (BuildSystem -> BuildSystem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildSystem -> BuildSystem -> Bool
$c/= :: BuildSystem -> BuildSystem -> Bool
== :: BuildSystem -> BuildSystem -> Bool
$c== :: BuildSystem -> BuildSystem -> Bool
Eq, ReadPrec [BuildSystem]
ReadPrec BuildSystem
Int -> ReadS BuildSystem
ReadS [BuildSystem]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BuildSystem]
$creadListPrec :: ReadPrec [BuildSystem]
readPrec :: ReadPrec BuildSystem
$creadPrec :: ReadPrec BuildSystem
readList :: ReadS [BuildSystem]
$creadList :: ReadS [BuildSystem]
readsPrec :: Int -> ReadS BuildSystem
$creadsPrec :: Int -> ReadS BuildSystem
Read, Int -> BuildSystem -> ShowS
[BuildSystem] -> ShowS
BuildSystem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuildSystem] -> ShowS
$cshowList :: [BuildSystem] -> ShowS
show :: BuildSystem -> String
$cshow :: BuildSystem -> String
showsPrec :: Int -> BuildSystem -> ShowS
$cshowsPrec :: Int -> BuildSystem -> ShowS
Show, forall x. Rep BuildSystem x -> BuildSystem
forall x. BuildSystem -> Rep BuildSystem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BuildSystem x -> BuildSystem
$cfrom :: forall x. BuildSystem -> Rep BuildSystem x
Generic)
deriving (Get BuildSystem
[BuildSystem] -> Put
BuildSystem -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [BuildSystem] -> Put
$cputList :: [BuildSystem] -> Put
get :: Get BuildSystem
$cget :: Get BuildSystem
put :: BuildSystem -> Put
$cput :: BuildSystem -> Put
Binary, Eq BuildSystem
Int -> BuildSystem -> Int
BuildSystem -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: BuildSystem -> Int
$chash :: BuildSystem -> Int
hashWithSalt :: Int -> BuildSystem -> Int
$chashWithSalt :: Int -> BuildSystem -> Int
Hashable, BuildSystem -> ()
forall a. (a -> ()) -> NFData a
rnf :: BuildSystem -> ()
$crnf :: BuildSystem -> ()
NFData)
findGhcForBuildSystem :: BuildSystem -> FilePath -> IO FilePath
findGhcForBuildSystem :: BuildSystem -> String -> IO String
findGhcForBuildSystem BuildSystem
Cabal String
_cwd =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"ghc is not in the PATH") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
findExecutable String
"ghc"
findGhcForBuildSystem BuildSystem
Stack String
cwd = do
Stdout String
ghcLoc <- forall args r. (HasCallStack, CmdArguments args) => args
cmd [String -> CmdOption
Cwd String
cwd] (String
"stack exec which ghc" :: String)
forall (m :: * -> *) a. Monad m => a -> m a
return String
ghcLoc
instance FromJSON BuildSystem where
parseJSON :: Value -> Parser BuildSystem
parseJSON Value
x = String -> BuildSystem
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
lower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
x
where
fromString :: String -> BuildSystem
fromString String
"stack" = BuildSystem
Stack
fromString String
"cabal" = BuildSystem
Cabal
fromString String
other = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unknown build system: " forall a. Semigroup a => a -> a -> a
<> String
other
instance ToJSON BuildSystem where
toJSON :: BuildSystem -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
data GitCommit = GitCommit
{
GitCommit -> Text
gitName :: Text,
GitCommit -> Maybe Text
name :: Maybe Text,
GitCommit -> Maybe Text
parent :: Maybe Text,
GitCommit -> Bool
include :: Bool
}
deriving (Get GitCommit
[GitCommit] -> Put
GitCommit -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GitCommit] -> Put
$cputList :: [GitCommit] -> Put
get :: Get GitCommit
$cget :: Get GitCommit
put :: GitCommit -> Put
$cput :: GitCommit -> Put
Binary, GitCommit -> GitCommit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitCommit -> GitCommit -> Bool
$c/= :: GitCommit -> GitCommit -> Bool
== :: GitCommit -> GitCommit -> Bool
$c== :: GitCommit -> GitCommit -> Bool
Eq, Eq GitCommit
Int -> GitCommit -> Int
GitCommit -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GitCommit -> Int
$chash :: GitCommit -> Int
hashWithSalt :: Int -> GitCommit -> Int
$chashWithSalt :: Int -> GitCommit -> Int
Hashable, forall x. Rep GitCommit x -> GitCommit
forall x. GitCommit -> Rep GitCommit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GitCommit x -> GitCommit
$cfrom :: forall x. GitCommit -> Rep GitCommit x
Generic, GitCommit -> ()
forall a. (a -> ()) -> NFData a
rnf :: GitCommit -> ()
$crnf :: GitCommit -> ()
NFData, Int -> GitCommit -> ShowS
[GitCommit] -> ShowS
GitCommit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitCommit] -> ShowS
$cshowList :: [GitCommit] -> ShowS
show :: GitCommit -> String
$cshow :: GitCommit -> String
showsPrec :: Int -> GitCommit -> ShowS
$cshowsPrec :: Int -> GitCommit -> ShowS
Show)
instance FromJSON GitCommit where
parseJSON :: Value -> Parser GitCommit
parseJSON (String Text
s) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Maybe Text -> Bool -> GitCommit
GitCommit Text
s forall a. Maybe a
Nothing forall a. Maybe a
Nothing Bool
True
parseJSON o :: Value
o@(Object KeyMap Value
_) = do
let keymap :: KeyMap Value
keymap = Value
o forall s a. s -> Getting a s a -> a
^. forall t. AsValue t => Prism' t (KeyMap Value)
_Object
case forall l. IsList l => l -> [Item l]
toList KeyMap Value
keymap of
[(forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview forall t. AsValue t => Prism' t Text
_String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON -> Just Text
name, String Text
gitName)] ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Maybe Text -> Bool -> GitCommit
GitCommit Text
gitName (forall a. a -> Maybe a
Just Text
name) forall a. Maybe a
Nothing Bool
True
[(forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview forall t. AsValue t => Prism' t Text
_String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON -> Just Text
name, Object KeyMap Value
props)] ->
Text -> Maybe Text -> Maybe Text -> Bool -> GitCommit
GitCommit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value
props forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"git" forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
name
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Text
name)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
props forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"parent"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap Value
props forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"include" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
True
[Item (KeyMap Value)]
_ -> forall (f :: * -> *) a. Alternative f => f a
empty
parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty
instance ToJSON GitCommit where
toJSON :: GitCommit -> Value
toJSON GitCommit {Bool
Maybe Text
Text
include :: Bool
parent :: Maybe Text
name :: Maybe Text
gitName :: Text
$sel:parent:GitCommit :: GitCommit -> Maybe Text
$sel:name:GitCommit :: GitCommit -> Maybe Text
$sel:include:GitCommit :: GitCommit -> Bool
$sel:gitName:GitCommit :: GitCommit -> Text
..} =
case Maybe Text
name of
Maybe Text
Nothing -> Text -> Value
String Text
gitName
Just Text
n -> [(Key, Value)] -> Value
object [forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
n) forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
gitName]
humanName :: GitCommit -> Text
humanName :: GitCommit -> Text
humanName GitCommit {Bool
Maybe Text
Text
include :: Bool
parent :: Maybe Text
name :: Maybe Text
gitName :: Text
$sel:parent:GitCommit :: GitCommit -> Maybe Text
$sel:name:GitCommit :: GitCommit -> Maybe Text
$sel:include:GitCommit :: GitCommit -> Bool
$sel:gitName:GitCommit :: GitCommit -> Text
..} = forall a. a -> Maybe a -> a
fromMaybe Text
gitName Maybe Text
name
findPrev :: Text -> [GitCommit] -> Text
findPrev :: Text -> [GitCommit] -> Text
findPrev Text
name (GitCommit
x : GitCommit
y : [GitCommit]
xx)
| GitCommit -> Text
humanName GitCommit
y forall a. Eq a => a -> a -> Bool
== Text
name = GitCommit -> Text
humanName GitCommit
x
| Bool
otherwise = Text -> [GitCommit] -> Text
findPrev Text
name (GitCommit
y forall a. a -> [a] -> [a]
: [GitCommit]
xx)
findPrev Text
name [GitCommit]
_ = Text
name
data Frame = Frame
{ Frame -> Int
allocated, Frame -> Int
copied, Frame -> Int
live :: !Int,
Frame -> Double
user, Frame -> Double
elapsed, Frame -> Double
totUser, Frame -> Double
totElapsed :: !Double,
Frame -> Int
generation :: !Int
}
deriving (Int -> Frame -> ShowS
[Frame] -> ShowS
Frame -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Frame] -> ShowS
$cshowList :: [Frame] -> ShowS
show :: Frame -> String
$cshow :: Frame -> String
showsPrec :: Int -> Frame -> ShowS
$cshowsPrec :: Int -> Frame -> ShowS
Show)
instance Read Frame where
readPrec :: ReadPrec Frame
readPrec = do
ReadPrec ()
spaces
Int
allocated <- forall a. Read a => ReadPrec a
readPrec @Int forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadPrec ()
spaces
Int
copied <- forall a. Read a => ReadPrec a
readPrec @Int forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadPrec ()
spaces
Int
live <- forall a. Read a => ReadPrec a
readPrec @Int forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadPrec ()
spaces
Double
user <- forall a. Read a => ReadPrec a
readPrec @Double forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadPrec ()
spaces
Double
elapsed <- forall a. Read a => ReadPrec a
readPrec @Double forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadPrec ()
spaces
Double
totUser <- forall a. Read a => ReadPrec a
readPrec @Double forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadPrec ()
spaces
Double
totElapsed <- forall a. Read a => ReadPrec a
readPrec @Double forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadPrec ()
spaces
Int
_ <- forall a. Read a => ReadPrec a
readPrec @Int forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadPrec ()
spaces
Int
_ <- forall a. Read a => ReadPrec a
readPrec @Int forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadPrec ()
spaces
String
"(Gen: " <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
7 ReadPrec Char
get
Int
generation <- forall a. Read a => ReadPrec a
readPrec @Int
Char
')' <- ReadPrec Char
get
forall (m :: * -> *) a. Monad m => a -> m a
return Frame {Double
Int
generation :: Int
totElapsed :: Double
totUser :: Double
elapsed :: Double
user :: Double
live :: Int
copied :: Int
allocated :: Int
$sel:generation:Frame :: Int
$sel:totElapsed:Frame :: Double
$sel:totUser:Frame :: Double
$sel:elapsed:Frame :: Double
$sel:user:Frame :: Double
$sel:live:Frame :: Int
$sel:copied:Frame :: Int
$sel:allocated:Frame :: Int
..}
where
spaces :: ReadPrec ()
spaces = forall a. (Int -> ReadP a) -> ReadPrec a
readP_to_Prec forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const ReadP ()
P.skipSpaces
data RunLog = RunLog
{ RunLog -> String
runVersion :: !String,
RunLog -> String
runConfiguration :: !String,
RunLog -> [Frame]
runFrames :: ![Frame],
RunLog -> Bool
runSuccess :: !Bool,
RunLog -> Maybe Double
runFirstReponse :: !(Maybe Seconds)
}
loadRunLog :: HasCallStack => Escaped FilePath -> String -> String -> Action RunLog
loadRunLog :: HasCallStack => Escaped String -> String -> String -> Action RunLog
loadRunLog (Escaped String
csv_fp) String
ver String
conf = do
let log_fp :: String
log_fp = String -> ShowS
replaceExtension String
csv_fp String
"gcStats.log"
[String]
log <- HasCallStack => String -> Action [String]
readFileLines String
log_fp
[String]
csv <- HasCallStack => String -> Action [String]
readFileLines String
csv_fp
let frames :: [Frame]
frames =
[ Frame
f
| String
l <- [String]
log,
Just Frame
f <- [forall a. Read a => String -> Maybe a
readMaybe String
l],
Frame -> Int
generation Frame
f forall a. Eq a => a -> a -> Bool
== Int
1
]
(Bool
success, Maybe Double
firstResponse) = case forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
',') forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) [String]
csv of
[[Text]
header, [Text]
row]
| let table :: [(Text, Text)]
table = forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
header [Text]
row
timeForFirstResponse :: Maybe Seconds
timeForFirstResponse :: Maybe Double
timeForFirstResponse = forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"firstBuildTime" [(Text, Text)]
table
, Just Text
s <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"success" [(Text, Text)]
table
, Just Bool
s <- forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
s)
-> (Bool
s,Maybe Double
timeForFirstResponse)
[[Text]]
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Cannot parse: " forall a. Semigroup a => a -> a -> a
<> String
csv_fp
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> String -> [Frame] -> Bool -> Maybe Double -> RunLog
RunLog String
ver String
conf [Frame]
frames Bool
success Maybe Double
firstResponse
data TraceMetric = Allocated | Copied | Live | User | Elapsed
deriving (forall x. Rep TraceMetric x -> TraceMetric
forall x. TraceMetric -> Rep TraceMetric x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TraceMetric x -> TraceMetric
$cfrom :: forall x. TraceMetric -> Rep TraceMetric x
Generic, Int -> TraceMetric
TraceMetric -> Int
TraceMetric -> [TraceMetric]
TraceMetric -> TraceMetric
TraceMetric -> TraceMetric -> [TraceMetric]
TraceMetric -> TraceMetric -> TraceMetric -> [TraceMetric]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TraceMetric -> TraceMetric -> TraceMetric -> [TraceMetric]
$cenumFromThenTo :: TraceMetric -> TraceMetric -> TraceMetric -> [TraceMetric]
enumFromTo :: TraceMetric -> TraceMetric -> [TraceMetric]
$cenumFromTo :: TraceMetric -> TraceMetric -> [TraceMetric]
enumFromThen :: TraceMetric -> TraceMetric -> [TraceMetric]
$cenumFromThen :: TraceMetric -> TraceMetric -> [TraceMetric]
enumFrom :: TraceMetric -> [TraceMetric]
$cenumFrom :: TraceMetric -> [TraceMetric]
fromEnum :: TraceMetric -> Int
$cfromEnum :: TraceMetric -> Int
toEnum :: Int -> TraceMetric
$ctoEnum :: Int -> TraceMetric
pred :: TraceMetric -> TraceMetric
$cpred :: TraceMetric -> TraceMetric
succ :: TraceMetric -> TraceMetric
$csucc :: TraceMetric -> TraceMetric
Enum, TraceMetric
forall a. a -> a -> Bounded a
maxBound :: TraceMetric
$cmaxBound :: TraceMetric
minBound :: TraceMetric
$cminBound :: TraceMetric
Bounded, ReadPrec [TraceMetric]
ReadPrec TraceMetric
Int -> ReadS TraceMetric
ReadS [TraceMetric]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TraceMetric]
$creadListPrec :: ReadPrec [TraceMetric]
readPrec :: ReadPrec TraceMetric
$creadPrec :: ReadPrec TraceMetric
readList :: ReadS [TraceMetric]
$creadList :: ReadS [TraceMetric]
readsPrec :: Int -> ReadS TraceMetric
$creadsPrec :: Int -> ReadS TraceMetric
Read)
instance Show TraceMetric where
show :: TraceMetric -> String
show TraceMetric
Allocated = String
"Allocated bytes"
show TraceMetric
Copied = String
"Copied bytes"
show TraceMetric
Live = String
"Live bytes"
show TraceMetric
User = String
"User time"
show TraceMetric
Elapsed = String
"Elapsed time"
frameMetric :: TraceMetric -> Frame -> Double
frameMetric :: TraceMetric -> Frame -> Double
frameMetric TraceMetric
Allocated = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frame -> Int
allocated
frameMetric TraceMetric
Copied = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frame -> Int
copied
frameMetric TraceMetric
Live = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frame -> Int
live
frameMetric TraceMetric
Elapsed = Frame -> Double
elapsed
frameMetric TraceMetric
User = Frame -> Double
user
data Diagram = Diagram
{ Diagram -> TraceMetric
traceMetric :: TraceMetric,
Diagram -> [RunLog]
runLogs :: [RunLog],
Diagram -> String
title :: String
}
deriving (forall x. Rep Diagram x -> Diagram
forall x. Diagram -> Rep Diagram x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Diagram x -> Diagram
$cfrom :: forall x. Diagram -> Rep Diagram x
Generic)
plotDiagram :: Bool -> Diagram -> FilePath -> Action ()
plotDiagram :: Bool -> Diagram -> String -> Action ()
plotDiagram Bool
includeFailed t :: Diagram
t@Diagram {TraceMetric
traceMetric :: TraceMetric
$sel:traceMetric:Diagram :: Diagram -> TraceMetric
traceMetric, [RunLog]
runLogs :: [RunLog]
$sel:runLogs:Diagram :: Diagram -> [RunLog]
runLogs} String
out = do
let extract :: Frame -> Double
extract = TraceMetric -> Frame -> Double
frameMetric TraceMetric
traceMetric
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall r.
(Default r, ToRenderable r) =>
FileOptions -> String -> EC r () -> IO ()
E.toFile forall a. Default a => a
E.def String
out forall a b. (a -> b) -> a -> b
$ do
forall x y. Lens' (Layout x y) String
E.layout_title forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
E..= Diagram -> String
title Diagram
t
forall l. [AlphaColour Double] -> EC l ()
E.setColors [AlphaColour Double]
myColors
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [RunLog]
runLogs forall a b. (a -> b) -> a -> b
$ \RunLog
rl ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
includeFailed Bool -> Bool -> Bool
|| RunLog -> Bool
runSuccess RunLog
rl) forall a b. (a -> b) -> a -> b
$ do
~(AlphaColour Double
c:[AlphaColour Double]
_) <- forall a l. State CState a -> EC l a
E.liftCState forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
E.view Lens' CState [AlphaColour Double]
E.colors)
forall (p :: * -> * -> *) x y.
ToPlot p =>
EC (Layout x y) (p x y) -> EC (Layout x y) ()
E.plot forall a b. (a -> b) -> a -> b
$ do
PlotLines Double Double
lplot <- forall x y l. String -> [[(x, y)]] -> EC l (PlotLines x y)
E.line
(RunLog -> String
runVersion RunLog
rl forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ RunLog -> String
runConfiguration RunLog
rl forall a. [a] -> [a] -> [a]
++ if RunLog -> Bool
runSuccess RunLog
rl then String
"" else String
" (FAILED)")
[ [ (Frame -> Double
totElapsed Frame
f, Frame -> Double
extract Frame
f)
| Frame
f <- RunLog -> [Frame]
runFrames RunLog
rl
]
]
return (PlotLines Double Double
lplot forall a b. a -> (a -> b) -> b
E.& forall x y. Lens' (PlotLines x y) LineStyle
E.plot_lines_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LineStyle Double
E.line_width forall a s t. Num a => ASetter s t a a -> a -> s -> t
E.*~ Double
2)
case RunLog -> Maybe Double
runFirstReponse RunLog
rl of
Just Double
t -> forall (p :: * -> * -> *) x y.
ToPlot p =>
EC (Layout x y) (p x y) -> EC (Layout x y) ()
E.plot forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall a b. String -> LineStyle -> a -> Plot a b
E.vlinePlot (String
"First build: " forall a. [a] -> [a] -> [a]
++ RunLog -> String
runVersion RunLog
rl) (LineStyle
E.defaultPlotLineStyle forall a b. a -> (a -> b) -> b
E.& Lens' LineStyle (AlphaColour Double)
E.line_color forall s t a b. ASetter s t a b -> b -> s -> t
E..~ AlphaColour Double
c) Double
t
Maybe Double
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
newtype Escaped a = Escaped {forall a. Escaped a -> a
escaped :: a}
newtype Unescaped a = Unescaped {forall a. Unescaped a -> a
unescaped :: a}
deriving newtype (Int -> Unescaped a -> ShowS
[Unescaped a] -> ShowS
Unescaped a -> String
forall a. Show a => Int -> Unescaped a -> ShowS
forall a. Show a => [Unescaped a] -> ShowS
forall a. Show a => Unescaped a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unescaped a] -> ShowS
$cshowList :: forall a. Show a => [Unescaped a] -> ShowS
show :: Unescaped a -> String
$cshow :: forall a. Show a => Unescaped a -> String
showsPrec :: Int -> Unescaped a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Unescaped a -> ShowS
Show, Value -> Parser [Unescaped a]
Value -> Parser (Unescaped a)
forall a. FromJSON a => Value -> Parser [Unescaped a]
forall a. FromJSON a => Value -> Parser (Unescaped a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Unescaped a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [Unescaped a]
parseJSON :: Value -> Parser (Unescaped a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (Unescaped a)
FromJSON, [Unescaped a] -> Encoding
[Unescaped a] -> Value
Unescaped a -> Encoding
Unescaped a -> Value
forall a. ToJSON a => [Unescaped a] -> Encoding
forall a. ToJSON a => [Unescaped a] -> Value
forall a. ToJSON a => Unescaped a -> Encoding
forall a. ToJSON a => Unescaped a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Unescaped a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [Unescaped a] -> Encoding
toJSONList :: [Unescaped a] -> Value
$ctoJSONList :: forall a. ToJSON a => [Unescaped a] -> Value
toEncoding :: Unescaped a -> Encoding
$ctoEncoding :: forall a. ToJSON a => Unescaped a -> Encoding
toJSON :: Unescaped a -> Value
$ctoJSON :: forall a. ToJSON a => Unescaped a -> Value
ToJSON, Unescaped a -> Unescaped a -> Bool
forall a. Eq a => Unescaped a -> Unescaped a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unescaped a -> Unescaped a -> Bool
$c/= :: forall a. Eq a => Unescaped a -> Unescaped a -> Bool
== :: Unescaped a -> Unescaped a -> Bool
$c== :: forall a. Eq a => Unescaped a -> Unescaped a -> Bool
Eq, Unescaped a -> ()
forall a. NFData a => Unescaped a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Unescaped a -> ()
$crnf :: forall a. NFData a => Unescaped a -> ()
NFData, Get (Unescaped a)
[Unescaped a] -> Put
Unescaped a -> Put
forall a. Binary a => Get (Unescaped a)
forall a. Binary a => [Unescaped a] -> Put
forall a. Binary a => Unescaped a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Unescaped a] -> Put
$cputList :: forall a. Binary a => [Unescaped a] -> Put
get :: Get (Unescaped a)
$cget :: forall a. Binary a => Get (Unescaped a)
put :: Unescaped a -> Put
$cput :: forall a. Binary a => Unescaped a -> Put
Binary, Int -> Unescaped a -> Int
Unescaped a -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall {a}. Hashable a => Eq (Unescaped a)
forall a. Hashable a => Int -> Unescaped a -> Int
forall a. Hashable a => Unescaped a -> Int
hash :: Unescaped a -> Int
$chash :: forall a. Hashable a => Unescaped a -> Int
hashWithSalt :: Int -> Unescaped a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> Unescaped a -> Int
Hashable)
escapeExperiment :: Unescaped String -> Escaped String
escapeExperiment :: Unescaped String -> Escaped String
escapeExperiment = forall a. a -> Escaped a
Escaped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Unescaped a -> a
unescaped
where
f :: Char -> Char
f Char
' ' = Char
'_'
f Char
other = Char
other
unescapeExperiment :: Escaped String -> Unescaped String
unescapeExperiment :: Escaped String -> Unescaped String
unescapeExperiment = forall a. a -> Unescaped a
Unescaped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Escaped a -> a
escaped
where
f :: Char -> Char
f Char
'_' = Char
' '
f Char
other = Char
other
(-/-) :: FilePattern -> FilePattern -> FilePattern
String
a -/- :: String -> ShowS
-/- String
b = String
a forall a. Semigroup a => a -> a -> a
<> String
"/" forall a. Semigroup a => a -> a -> a
<> String
b
interleave :: [[a]] -> [a]
interleave :: forall a. [[a]] -> [a]
interleave = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose
myColors :: [E.AlphaColour Double]
myColors :: [AlphaColour Double]
myColors = forall a b. (a -> b) -> [a] -> [b]
map forall a. Num a => Colour a -> AlphaColour a
E.opaque
[ forall a. (Ord a, Floating a) => Colour a
E.blue
, forall a. (Ord a, Floating a) => Colour a
E.green
, forall a. (Ord a, Floating a) => Colour a
E.red
, forall a. (Ord a, Floating a) => Colour a
E.orange
, forall a. (Ord a, Floating a) => Colour a
E.yellow
, forall a. (Ord a, Floating a) => Colour a
E.violet
, forall a. Num a => Colour a
E.black
, forall a. (Ord a, Floating a) => Colour a
E.gold
, forall a. (Ord a, Floating a) => Colour a
E.brown
, forall a. (Ord a, Floating a) => Colour a
E.hotpink
, forall a. (Ord a, Floating a) => Colour a
E.aliceblue
, forall a. (Ord a, Floating a) => Colour a
E.aqua
, forall a. (Ord a, Floating a) => Colour a
E.beige
, forall a. (Ord a, Floating a) => Colour a
E.bisque
, forall a. (Ord a, Floating a) => Colour a
E.blueviolet
, forall a. (Ord a, Floating a) => Colour a
E.burlywood
, forall a. (Ord a, Floating a) => Colour a
E.cadetblue
, forall a. (Ord a, Floating a) => Colour a
E.chartreuse
, forall a. (Ord a, Floating a) => Colour a
E.coral
, forall a. (Ord a, Floating a) => Colour a
E.crimson
, forall a. (Ord a, Floating a) => Colour a
E.darkblue
, forall a. (Ord a, Floating a) => Colour a
E.darkgray
, forall a. (Ord a, Floating a) => Colour a
E.darkgreen
, forall a. (Ord a, Floating a) => Colour a
E.darkkhaki
, forall a. (Ord a, Floating a) => Colour a
E.darkmagenta
, forall a. (Ord a, Floating a) => Colour a
E.deeppink
, forall a. (Ord a, Floating a) => Colour a
E.dodgerblue
, forall a. (Ord a, Floating a) => Colour a
E.firebrick
, forall a. (Ord a, Floating a) => Colour a
E.forestgreen
, forall a. (Ord a, Floating a) => Colour a
E.fuchsia
, forall a. (Ord a, Floating a) => Colour a
E.greenyellow
, forall a. (Ord a, Floating a) => Colour a
E.lightsalmon
, forall a. (Ord a, Floating a) => Colour a
E.seagreen
, forall a. (Ord a, Floating a) => Colour a
E.olive
, forall a. (Ord a, Floating a) => Colour a
E.sandybrown
, forall a. (Ord a, Floating a) => Colour a
E.sienna
, forall a. (Ord a, Floating a) => Colour a
E.peru
]
dummyHp :: String
dummyHp :: String
dummyHp =
String
"JOB \"ghcide\" \
\DATE \"Sun Jan 31 09:30 2021\" \
\SAMPLE_UNIT \"seconds\" \
\VALUE_UNIT \"bytes\" \
\BEGIN_SAMPLE 0.000000 \
\END_SAMPLE 0.000000"