Skip to content

Instantly share code, notes, and snippets.

@tfausak

tfausak/.gitignore

Last active May 17, 2020
Embed
What would you like to do?
/.stack-work/
/output/
/results.csv
/stack.yaml.lock
name: deriving-benchmark
version: 2020.5.17
cabal-version: >= 1.2
build-type: Simple
executable deriving-benchmark
main-is: deriving-benchmark.hs
build-depends: base, containers, directory
ghc-options:
-Weverything
-Wno-implicit-prelude
-Wno-missing-deriving-strategies
-Wno-missing-exported-signatures
-Wno-missing-safe-haskell-mode
-Wno-prepositive-qualified-module
-Wno-safe
-- Data, Generic, NFData, Read, Typeable
module Main ( main ) where
import qualified Control.Monad as Monad
import qualified Data.Char as Char
import qualified Data.Graph as Graph
import qualified Data.List as List
import qualified System.Directory as Directory
import qualified System.IO as IO
generate
:: [Graph.Vertex] -- reverse top sorted
-> (Graph.Vertex -> (Type, String, [String])) -- nodeFromVertex
-> FilePath -- directory
-> (String -> [String]) -- generate header using module name
-> (Type -> String -> [String]) -- generate content using type and module name
-> IO ()
generate vertices fromVertex slug makeHeader makeContent = do
let root = "output/" <> slug
Directory.removePathForcibly root
Directory.createDirectoryIfMissing True root
do
let directory = root <> "/single"
Directory.createDirectory directory
IO.withFile (directory <> "/Rattletrap.hs") IO.WriteMode $ \ handle -> do
IO.hPutStr handle . unlines $ makeHeader "Rattletrap"
mapM_
( IO.hPutStr handle
. unlines
. (\ (x, y, _) -> makeContent x y)
. fromVertex
)
vertices
do
let directory = root <> "/multiple"
Directory.createDirectory directory
writeFile (directory <> "/Rattletrap.hs")
"module Rattletrap where import Replay"
Monad.forM_ vertices $ \ vertex -> do
let
(node, key, keys) = fromVertex vertex
path = directory <> "/" <> key <> ".hs"
IO.withFile path IO.WriteMode $ \ handle -> do
IO.hPutStr handle . unlines $ makeHeader key
IO.hPutStr handle . unlines $ fmap (mappend "import ") keys
IO.hPutStr handle . unlines $ makeContent node key
main :: IO ()
main = do
let
(graph, fromVertex, _fromKey) = Graph.graphFromEdges types
vertices = reverse $ Graph.topSort graph
generate vertices fromVertex "json-generic"
(\ key ->
[ "{-# OPTIONS_GHC -Wno-tabs #-}"
, "{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-}"
, "module " <> key <> " where"
, "import Data.Aeson (FromJSON, ToJSON)"
, "import Data.Int (Int8, Int32, Int64)"
, "import Data.Text (Text)"
, "import Data.Word (Word8, Word16, Word32, Word64)"
, "import GHC.Generics (Generic)"
])
(\ node _ ->
[ ""
, typeDeclaration node
, "\tderiving (FromJSON, Generic, ToJSON)"
])
generate vertices fromVertex "json-template"
(\ key ->
[ "{-# OPTIONS_GHC -Wno-tabs #-}"
, "{-# LANGUAGE TemplateHaskell #-}"
, "module " <> key <> " where"
, "import Data.Aeson.TH (defaultOptions, deriveJSON)"
, "import Data.Int (Int8, Int32, Int64)"
, "import Data.Text (Text)"
, "import Data.Word (Word8, Word16, Word32, Word64)"
])
(\ node key ->
[ ""
, typeDeclaration node
, ""
, "$(deriveJSON defaultOptions ''" <> key <> ")"
])
generate vertices fromVertex "base-automatic"
(\ key ->
[ "{-# OPTIONS_GHC -Wno-tabs #-}"
, "module " <> key <> " where"
, "import Data.Int (Int8, Int32, Int64)"
, "import Data.Text (Text)"
, "import Data.Word (Word8, Word16, Word32, Word64)"
])
(\ node _ ->
[ ""
, typeDeclaration node
, "\tderiving (Eq, Ord, Show)"
])
generate vertices fromVertex "base-manual"
(\ key ->
[ "{-# OPTIONS_GHC -Wno-tabs #-}"
, "module " <> key <> " where"
, "import Data.Int (Int8, Int32, Int64)"
, "import Data.Text (Text)"
, "import Data.Word (Word8, Word16, Word32, Word64)"
])
(\ node _ ->
[ ""
, typeDeclaration node
, ""
, eqInstance node
, ""
, ordInstance node
, ""
, showInstance node
])
generate vertices fromVertex "json-manual"
(\ key ->
[ "{-# OPTIONS_GHC -Wno-tabs #-}"
, "module " <> key <> " where"
, "import Data.Aeson"
, "import Data.Int (Int8, Int32, Int64)"
, "import Data.Text (Text, pack)"
, "import Data.Word (Word8, Word16, Word32, Word64)"
])
(\ node _ ->
[ ""
, typeDeclaration node
, ""
, fromJsonInstance node
, ""
, toJsonInstance node
])
typeDeclaration :: Type -> String
typeDeclaration t = case t of
TypeProduct p ->
"data "
<> productName p
<> concatMap (mappend " ") (productVariables p)
<> " = "
<> productName p
<> "\n\t{ "
<>
( List.intercalate "\n\t, "
. fmap (\ f -> productFieldName p f <> " :: " <> fieldType f)
$ productFields p
)
<> "\n\t}"
TypeSum s ->
"data "
<> sumName s
<> concatMap (mappend " ") (sumVariables s)
<> "\n\t= "
<>
( List.intercalate "\n\t| "
. fmap (\ c ->
sumConstructorName s c
<> concatMap (\ x -> " (" <> x <> ")") (constructorTypes c))
$ sumConstructors s
)
TypeWrapper w ->
"newtype "
<> wrapperName w
<> concatMap (mappend " ") (wrapperVariables w)
<> " = "
<> wrapperName w
<> "\n\t{ "
<> wrapperFieldName w
<> " :: "
<> wrapperType w
<> "\n\t}"
eqInstance :: Type -> String
eqInstance t = case t of
TypeProduct p ->
instanceHead "Eq" (productName p) (productVariables p)
<> "\n\tx == y =\n\t\t"
<>
( List.intercalate " &&\n\t\t"
. fmap (\ f -> let n = productFieldName p f in
"(" <> n <> " x == " <> n <> " y)")
$ productFields p
)
TypeSum s ->
instanceHead "Eq" (sumName s) (sumVariables s)
<> "\n\tx == y = case (x, y) of\n\t\t"
<>
( List.intercalate "\n\t\t"
. fmap (\ c -> let
n = sumConstructorName s c
is = fmap show [ 1 .. length $ constructorTypes c ]
in "("
<> n
<> concatMap (mappend " x") is
<> ", "
<> n
<> concatMap (mappend " y") is
<> ") -> "
<> List.intercalate " && "
(fmap (\ i -> "(x" <> i <> " == y" <> i <> ")") is))
$ sumConstructors s
)
<> "\n\t\t_ -> False"
TypeWrapper w ->
instanceHead "Eq" (wrapperName w) (wrapperVariables w)
<> "\n\tx == y = "
<> wrapperFieldName w
<> " x == "
<> wrapperFieldName w
<> " y"
ordInstance :: Type -> String
ordInstance t = case t of
TypeProduct p ->
instanceHead "Ord" (productName p) (productVariables p)
<> "\n\tcompare x y =\n\t\t"
<>
( List.intercalate " <>\n\t\t"
. fmap (\ f -> let n = productFieldName p f in
"compare (" <> n <> " x) (" <> n <> " y)")
$ productFields p
)
TypeSum s ->
instanceHead "Ord" (sumName s) (sumVariables s)
<> "\n\tcompare x y = case (x, y) of\n\t\t"
<>
( List.intercalate "\n\t\t"
. fmap (\ c -> let
n = sumConstructorName s c
is = fmap show [ 1 .. length $ constructorTypes c ]
in "("
<> n
<> concatMap (mappend " x") is
<> ", "
<> n
<> concatMap (mappend " y") is
<> ") -> "
<> List.intercalate " <> "
(fmap (\ i -> "compare x" <> i <> " y" <> i) is))
$ sumConstructors s
)
<> "\n\t\t"
<>
( List.intercalate "\n\t\t"
. concatMap (\ c ->
[ "(" <> sumConstructorName s c <> "{}, _) -> LT"
, "(_, " <> sumConstructorName s c <> "{}) -> GT"
])
. init
$ sumConstructors s
)
TypeWrapper w ->
instanceHead "Ord" (wrapperName w) (wrapperVariables w)
<> "\n\tcompare x y = compare ("
<> wrapperFieldName w
<> " x) ("
<> wrapperFieldName w
<> " y)"
showInstance :: Type -> String
showInstance t = case t of
TypeProduct p ->
instanceHead "Show" (productName p) (productVariables p)
<> "\n\tshow x = "
<> show (productName p)
<> " <> \" { \"\n\t\t"
<>
( List.intercalate " <> \", \"\n\t\t"
. fmap (\ f -> let n = productFieldName p f in
"<> "
<> show n
<> " <> \" = \" <> show ("
<> n
<> " x)")
$ productFields p
)
<> " <> \" }\""
TypeSum s ->
instanceHead "Show" (sumName s) (sumVariables s)
<> "\n\tshow x = case x of\n\t\t"
<>
( List.intercalate "\n\t\t"
. fmap (\ c -> let
n = sumConstructorName s c
is = fmap show [ 1 .. length $ constructorTypes c ]
in n
<> concatMap (mappend " x") is
<> " -> "
<> show n
<> concatMap (\ i -> " <> \" (\" <> show x" <> i <> " <> \")\"") is)
$ sumConstructors s
)
TypeWrapper w ->
instanceHead "Show" (wrapperName w) (wrapperVariables w)
<> "\n\tshow x = show ("
<> wrapperFieldName w
<> " x)"
fromJsonInstance :: Type -> String
fromJsonInstance t = case t of
TypeProduct p ->
instanceHead "FromJSON" (productName p) (productVariables p)
<> "\n\tparseJSON = withObject "
<> show (productName p)
<> " (\\ obj -> "
<> productName p
<> "\n\t\t<$> "
<>
( List.intercalate "\n\t\t<*> "
. fmap (mappend "obj .: pack " . show . productFieldName p)
$ productFields p
)
<> ")"
TypeSum s ->
instanceHead "FromJSON" (sumName s) (sumVariables s)
<> "\n\tparseJSON = withObject "
<> show (sumName s)
<> " (\\ obj -> do\n\t\t"
<> "tag <- obj .: pack \"tag\"\n\t\t"
<> "case tag of\n\t\t\t"
<>
( List.intercalate "\n\t\t\t"
. fmap (\ c -> let n = sumConstructorName s c in
show n
<> " -> "
<> n
<> " <$> "
<> List.intercalate " <*> " (fmap
(\ i -> "obj .: pack \"x" <> show i <> "\"")
[ 1 .. length $ constructorTypes c ]))
$ sumConstructors s
)
<> "\n\t\t\t_ -> fail \"invalid\")"
TypeWrapper w ->
instanceHead "FromJSON" (wrapperName w) (wrapperVariables w)
<> "\n\tparseJSON = fmap "
<> wrapperName w
<> " . parseJSON"
toJsonInstance :: Type -> String
toJsonInstance t = case t of
TypeProduct p ->
instanceHead "ToJSON" (productName p) (productVariables p)
<> "\n\ttoJSON x = object\n\t\t[ "
<>
( List.intercalate "\n\t\t, "
. fmap (\ f -> let n = productFieldName p f in
"pack "
<> show n
<> " .= "
<> n
<> " x")
$ productFields p
)
<> "\n\t\t]"
<> "\n\ttoEncoding x = pairs\n\t\t( "
<>
( List.intercalate "\n\t\t<> "
. fmap (\ f -> let n = productFieldName p f in
"pack "
<> show n
<> " .= "
<> n
<> " x")
$ productFields p
)
<> "\n\t\t)"
TypeSum s ->
instanceHead "ToJSON" (sumName s) (sumVariables s)
<> "\n\ttoJSON x = case x of\n\t\t"
<>
( List.intercalate "\n\t\t"
. fmap (\ c -> let
n = sumConstructorName s c
is = fmap show [ 1 .. length $ constructorTypes c ]
in n
<> concatMap (mappend " x") is
<> " -> object [pack \"tag\" .= "
<> show n
<> concatMap
(\ i -> ", pack \"x" <> i <> "\" .= x" <> i)
is
<> "]")
$ sumConstructors s
)
<> "\n\ttoEncoding x = case x of\n\t\t"
<>
( List.intercalate "\n\t\t"
. fmap (\ c -> let
n = sumConstructorName s c
is = fmap show [ 1 .. length $ constructorTypes c ]
in n
<> concatMap (mappend " x") is
<> " -> pairs (pack \"tag\" .= "
<> show n
<> concatMap
(\ i -> " <> pack \"x" <> i <> "\" .= x" <> i)
is
<> ")")
$ sumConstructors s
)
TypeWrapper w ->
instanceHead "ToJSON" (wrapperName w) (wrapperVariables w)
<> "\n\ttoJSON = toJSON . "
<> wrapperFieldName w
<> "\n\ttoEncoding = toEncoding . "
<> wrapperFieldName w
productFieldName :: Product -> Field -> String
productFieldName p f = lower (productName p) <> upper (fieldName f)
sumConstructorName :: Sum -> Constructor -> String
sumConstructorName s c = sumName s <> constructorName c
wrapperFieldName :: Wrapper -> String
wrapperFieldName w = "unwrap" <> wrapperName w
instanceHead :: String -> String -> [String] -> String
instanceHead c n vs =
"instance ("
<> List.intercalate ", " (fmap (\ v -> c <> " " <> v) vs)
<> ") => "
<> c
<> " ("
<> n
<> concatMap (mappend " ") vs
<> ") where"
lower :: String -> String
lower = overHead Char.toLower
upper :: String -> String
upper = overHead Char.toUpper
overHead :: (a -> a) -> [a] -> [a]
overHead f xs = case xs of
[] -> xs
x : ys -> f x : ys
data Type
= TypeProduct Product
| TypeSum Sum
| TypeWrapper Wrapper
deriving (Eq, Show)
data Product = Product
{ productName :: String
, productVariables :: [String]
, productFields :: [Field]
} deriving (Eq, Show)
data Field = Field
{ fieldName :: String
, fieldType :: String
} deriving (Eq, Show)
data Sum = Sum
{ sumName :: String
, sumVariables :: [String]
, sumConstructors :: [Constructor]
} deriving (Eq, Show)
data Constructor = Constructor
{ constructorName :: String
, constructorTypes :: [String]
} deriving (Eq, Show)
data Wrapper = Wrapper
{ wrapperName :: String
, wrapperVariables :: [String]
, wrapperType :: String
} deriving (Eq, Show)
types :: [(Type, String, [String])]
types = List.sortOn (\ (_, key, _) -> key)
[ ( TypeProduct $ Product "Replay" []
[ Field "header" "Section Header"
, Field "content" "Section Content"
]
, "Replay"
, ["Section", "Header", "Content"]
)
, ( TypeProduct $ Product "Section" ["a"]
[ Field "size" "Word32le"
, Field "crc" "Word32le"
, Field "body" "a"
]
, "Section"
, ["Word32le"]
)
, ( TypeWrapper $ Wrapper "Word32le" [] "Word32"
, "Word32le"
, []
)
, ( TypeProduct $ Product "Header" []
[ Field "version" "Version"
, Field "label" "Str"
, Field "properties" "Dictionary Property"
]
, "Header"
, ["Version", "Str", "Dictionary", "Property"]
)
, ( TypeProduct $ Product "Version" []
[ Field "major" "Word32le"
, Field "minor" "Word32le"
, Field "patch" "Maybe Word32le"
]
, "Version"
, ["Word32le"]
)
, ( TypeWrapper $ Wrapper "Str" [] "Text"
, "Str"
, []
)
, ( TypeSum $ Sum "Dictionary" ["a"]
[ Constructor "Element" ["Str", "a", "Dictionary a"]
, Constructor "End" ["Str"]
]
, "Dictionary"
, ["Str"]
)
, ( TypeProduct $ Product "Property" []
[ Field "kind" "Str"
, Field "size" "Word64le"
, Field "value" "PropertyValue Property"
]
, "Property"
, ["Str", "Word64le", "PropertyValue"]
)
, ( TypeWrapper $ Wrapper "Word64le" [] "Word64"
, "Word64le"
, []
)
, ( TypeSum $ Sum "PropertyValue" ["a"]
[ Constructor "Array" ["List (Dictionary a)"]
, Constructor "Bool" ["Word8le"]
, Constructor "Byte" ["Str", "Maybe Str"]
, Constructor "Float" ["Float32le"]
, Constructor "Int" ["Int32le"]
, Constructor "Name" ["Str"]
, Constructor "QWord" ["Word64le"]
, Constructor "Str" ["Str"]
]
, "PropertyValue"
, ["List", "Dictionary", "Word8le", "Str", "Float32le", "Int32le", "Word64le"]
)
, ( TypeWrapper $ Wrapper "List" ["a"] "[a]"
, "List"
, []
)
, ( TypeWrapper $ Wrapper "Word8le" [] "Word8"
, "Word8le"
, []
)
, ( TypeWrapper $ Wrapper "Float32le" [] "Float"
, "Float32le"
, []
)
, ( TypeWrapper $ Wrapper "Int32le" [] "Int32"
, "Int32le"
, []
)
, ( TypeProduct $ Product "Content" []
[ Field "levels" "List Str"
, Field "keyFrames" "List KeyFrame"
, Field "streamSize" "Word32le"
, Field "frames" "[Frame]"
, Field "messages" "List Message"
, Field "marks" "List Mark"
, Field "packages" "List Str"
, Field "objects" "List Str"
, Field "names" "List Str"
, Field "classMappings" "List ClassMapping"
, Field "caches" "List Cache"
]
, "Content"
, ["List", "Str", "KeyFrame", "Word32le", "Frame", "Message", "Mark", "ClassMapping", "Cache"]
)
, ( TypeProduct $ Product "KeyFrame" []
[ Field "time" "Float32le"
, Field "frame" "Word32le"
, Field "position" "Word32le"
]
, "KeyFrame"
, ["Float32le", "Word32le"]
)
, ( TypeProduct $ Product "Message" []
[ Field "frame" "Word32le"
, Field "name" "Str"
, Field "value" "Str"
]
, "Message"
, ["Word32le", "Str"]
)
, ( TypeProduct $ Product "Mark" []
[ Field "value" "Str"
, Field "frame" "Word32le"
]
, "Mark"
, ["Str", "Word32le"]
)
, ( TypeProduct $ Product "ClassMapping" []
[ Field "name" "Str"
, Field "streamId" "Word32le"
]
, "ClassMapping"
, ["Str", "Word32le"]
)
, ( TypeProduct $ Product "Cache" []
[ Field "classId" "Word32le"
, Field "parentCacheId" "Word32le"
, Field "cacheId" "Word32le"
, Field "attributeMappings" "List AttributeMapping"
]
, "Cache"
, ["Word32le", "List", "AttributeMapping"]
)
, ( TypeProduct $ Product "AttributeMapping" []
[ Field "objectId" "Word32le"
, Field "streamId" "Word32le"
]
, "AttributeMapping"
, ["Word32le"]
)
, ( TypeProduct $ Product "Frame" []
[ Field "time" "Float32le"
, Field "delta" "Float32le"
, Field "replications" "[Replication]"
]
, "Frame"
, ["Float32le", "Replication"]
)
, ( TypeProduct $ Product "Replication" []
[ Field "actorId" "CompressedWord"
, Field "value" "ReplicationValue"
]
, "Replication"
, ["CompressedWord", "ReplicationValue"]
)
, ( TypeProduct $ Product "CompressedWord" []
[ Field "limit" "Word"
, Field "value" "Word"
]
, "CompressedWord"
, []
)
, ( TypeSum $ Sum "ReplicationValue" []
[ Constructor "Spawned" ["SpawnedReplication"]
, Constructor "Updated" ["UpdatedReplication"]
, Constructor "Destroyed" ["DestroyedReplication"]
]
, "ReplicationValue"
, ["SpawnedReplication", "UpdatedReplication", "DestroyedReplication"]
)
, ( TypeProduct $ Product "SpawnedReplication" []
[ Field "flag" "Bool"
, Field "nameIndex" "Maybe Word32le"
, Field "name" "Maybe Str"
, Field "objectId" "Word32le"
, Field "objectName" "Str"
, Field "className" "Str"
, Field "initialization" "Initialization"
]
, "SpawnedReplication"
, ["Word32le", "Str", "Initialization"]
)
, ( TypeProduct $ Product "Initialization" []
[ Field "location" "Maybe Vector"
, Field "rotation" "Maybe Int8Vector"
]
, "Initialization"
, ["Vector", "Int8Vector"]
)
, ( TypeProduct $ Product "Vector" []
[ Field "size" "CompressedWord"
, Field "bias" "Word"
, Field "x" "Int"
, Field "y" "Int"
, Field "z" "Int"
]
, "Vector"
, ["CompressedWord"]
)
, ( TypeProduct $ Product "Int8Vector" []
[ Field "x" "Maybe Int8le"
, Field "y" "Maybe Int8le"
, Field "z" "Maybe Int8le"
]
, "Int8Vector"
, ["Int8le"]
)
, ( TypeWrapper $ Wrapper "Int8le" [] "Int8"
, "Int8le"
, []
)
, ( TypeWrapper $ Wrapper "DestroyedReplication" [] "()"
, "DestroyedReplication"
, []
)
, ( TypeWrapper $ Wrapper "UpdatedReplication" [] "[Attribute]"
, "UpdatedReplication"
, ["Attribute"]
)
, ( TypeProduct $ Product "Attribute" []
[ Field "id" "CompressedWord"
, Field "name" "Str"
, Field "value" "AttributeValue"
]
, "Attribute"
, ["CompressedWord", "Str", "AttributeValue"]
)
, ( TypeSum $ Sum "AttributeValue" []
[ Constructor "AppliedDamage" ["AppliedDamageAttribute"]
, Constructor "Boolean" ["BooleanAttribute"]
, Constructor "Byte" ["ByteAttribute"]
, Constructor "CamSettings" ["CamSettingsAttribute"]
, Constructor "ClubColors" ["ClubColorsAttribute"]
, Constructor "DamageState" ["DamageStateAttribute"]
, Constructor "Demolish" ["DemolishAttribute"]
, Constructor "Enum" ["EnumAttribute"]
, Constructor "Explosion" ["ExplosionAttribute"]
, Constructor "ExtendedExplosion" ["ExtendedExplosionAttribute"]
, Constructor "FlaggedInt" ["FlaggedIntAttribute"]
, Constructor "FlaggedByte" ["FlaggedByteAttribute"]
, Constructor "Float" ["FloatAttribute"]
, Constructor "GameMode" ["GameModeAttribute"]
, Constructor "Int" ["IntAttribute"]
, Constructor "Int64" ["Int64Attribute"]
, Constructor "Loadout" ["LoadoutAttribute"]
, Constructor "LoadoutOnline" ["LoadoutOnlineAttribute"]
, Constructor "Loadouts" ["LoadoutsAttribute"]
, Constructor "LoadoutsOnline" ["LoadoutsOnlineAttribute"]
, Constructor "Location" ["LocationAttribute"]
, Constructor "MusicStinger" ["MusicStingerAttribute"]
, Constructor "PartyLeader" ["PartyLeaderAttribute"]
, Constructor "Pickup" ["PickupAttribute"]
, Constructor "PickupNew" ["PickupAttributeNew"]
, Constructor "PlayerHistoryKey" ["PlayerHistoryKeyAttribute"]
, Constructor "PrivateMatchSettings" ["PrivateMatchSettingsAttribute"]
, Constructor "QWord" ["QWordAttribute"]
, Constructor "Reservation" ["ReservationAttribute"]
, Constructor "RigidBodyState" ["RigidBodyStateAttribute"]
, Constructor "StatEvent" ["StatEventAttribute"]
, Constructor "String" ["StringAttribute"]
, Constructor "TeamPaint" ["TeamPaintAttribute"]
, Constructor "Title" ["TitleAttribute"]
, Constructor "UniqueId" ["UniqueIdAttribute"]
, Constructor "WeldedInfo" ["WeldedInfoAttribute"]
]
, "AttributeValue"
, [ "AppliedDamageAttribute"
, "BooleanAttribute"
, "ByteAttribute"
, "CamSettingsAttribute"
, "ClubColorsAttribute"
, "DamageStateAttribute"
, "DemolishAttribute"
, "EnumAttribute"
, "ExplosionAttribute"
, "ExtendedExplosionAttribute"
, "FlaggedIntAttribute"
, "FlaggedByteAttribute"
, "FloatAttribute"
, "GameModeAttribute"
, "IntAttribute"
, "Int64Attribute"
, "LoadoutAttribute"
, "LoadoutOnlineAttribute"
, "LoadoutsAttribute"
, "LoadoutsOnlineAttribute"
, "LocationAttribute"
, "MusicStingerAttribute"
, "PartyLeaderAttribute"
, "PickupAttribute"
, "PickupAttributeNew"
, "PlayerHistoryKeyAttribute"
, "PrivateMatchSettingsAttribute"
, "QWordAttribute"
, "ReservationAttribute"
, "RigidBodyStateAttribute"
, "StatEventAttribute"
, "StringAttribute"
, "TeamPaintAttribute"
, "TitleAttribute"
, "UniqueIdAttribute"
, "WeldedInfoAttribute"
]
)
, ( TypeProduct $ Product "AppliedDamageAttribute" []
[ Field "unknown1" "Word8le"
, Field "location" "Vector"
, Field "unknown3" "Int32le"
, Field "unknown4" "Int32le"
]
, "AppliedDamageAttribute"
, ["Word8le", "Vector", "Int32le"]
)
, ( TypeWrapper $ Wrapper "BooleanAttribute" [] "Bool"
, "BooleanAttribute"
, []
)
, ( TypeWrapper $ Wrapper "ByteAttribute" [] "Word8le"
, "ByteAttribute"
, ["Word8le"]
)
, ( TypeProduct $ Product "CamSettingsAttribute" []
[ Field "fov" "Float32le"
, Field "height" "Float32le"
, Field "angle" "Float32le"
, Field "distance" "Float32le"
, Field "stiffness" "Float32le"
, Field "swivelSpeed" "Float32le"
, Field "transitionSpeed" "Maybe Float32le"
]
, "CamSettingsAttribute"
, ["Float32le"]
)
, ( TypeProduct $ Product "ClubColorsAttribute" []
[ Field "blueFlag" "Bool"
, Field "blueColor" "Word8le"
, Field "orangeFlag" "Bool"
, Field "orangeColor" "Word8le"
]
, "ClubColorsAttribute"
, ["Word8le"]
)
, ( TypeProduct $ Product "DamageStateAttribute" []
[ Field "unknown1" "Word8le"
, Field "unknown2" "Bool"
, Field "unknown3" "Int32le"
, Field "unknown4" "Vector"
, Field "unknown5" "Bool"
, Field "unknown6" "Bool"
]
, "DamageStateAttribute"
, ["Word8le", "Int32le", "Vector"]
)
, ( TypeProduct $ Product "DemolishAttribute" []
[ Field "attackerFlag" "Bool"
, Field "attackerActorId" "Word32le"
, Field "victimFlag" "Bool"
, Field "victimActorId" "Word32le"
, Field "attackerVelocity" "Vector"
, Field "victimVelocity" "Vector"
]
, "DemolishAttribute"
, ["Word32le", "Word8le", "Vector"]
)
, ( TypeWrapper $ Wrapper "EnumAttribute" [] "Word16"
, "EnumAttribute"
, []
)
, ( TypeProduct $ Product "ExplosionAttribute" []
[ Field "flag" "Bool"
, Field "actorId" "Int32le"
, Field "location" "Vector"
]
, "ExplosionAttribute"
, ["Int32le", "Vector"]
)
, ( TypeProduct $ Product "ExtendedExplosionAttribute" []
[ Field "explosion" "ExplosionAttribute"
, Field "unknown" "FlaggedIntAttribute"
]
, "ExtendedExplosionAttribute"
, ["ExplosionAttribute", "FlaggedIntAttribute"]
)
, ( TypeProduct $ Product "FlaggedIntAttribute" []
[ Field "flag" "Bool"
, Field "int" "Int32le"
]
, "FlaggedIntAttribute"
, ["Int32le"]
)
, ( TypeProduct $ Product "FlaggedByteAttribute" []
[ Field "flag" "Bool"
, Field "byte" "Word8le"
]
, "FlaggedByteAttribute"
, ["Word8le"]
)
, ( TypeWrapper $ Wrapper "FloatAttribute" [] "Float32le"
, "FloatAttribute"
, ["Float32le"]
)
, ( TypeProduct $ Product "GameModeAttribute" []
[ Field "numBits" "Int"
, Field "word" "Word"
]
, "GameModeAttribute"
, []
)
, ( TypeWrapper $ Wrapper "IntAttribute" [] "Int32le"
, "IntAttribute"
, ["Int32le"]
)
, ( TypeWrapper $ Wrapper "Int64Attribute" [] "Int64le"
, "Int64Attribute"
, ["Int64le"]
)
, ( TypeWrapper $ Wrapper "Int64le" [] "Int64"
, "Int64le"
, []
)
, ( TypeProduct $ Product "LoadoutAttribute" []
[ Field "version" "Word8le"
, Field "body" "Word32le"
, Field "decal" "Word32le"
, Field "wheels" "Word32le"
, Field "rocketTrail" "Word32le"
, Field "antenna" "Word32le"
, Field "topper" "Word32le"
, Field "unknown1" "Word32le"
, Field "unknown2" "Maybe Word32le"
, Field "engineAudio" "Maybe Word32le"
, Field "trail" "Maybe Word32le"
, Field "goalExplosion" "Maybe Word32le"
, Field "banner" "Maybe Word32le"
, Field "unknown3" "Maybe Word32le"
, Field "unknown4" "Maybe Word32le"
, Field "unknown5" "Maybe Word32le"
, Field "unknown6" "Maybe Word32le"
]
, "LoadoutAttribute"
, ["Word8le", "Word32le"]
)
, ( TypeWrapper $ Wrapper "LoadoutOnlineAttribute" [] "[[ProductAttribute]]"
, "LoadoutOnlineAttribute"
, ["ProductAttribute"]
)
, ( TypeProduct $ Product "ProductAttribute" []
[ Field "unknown" "Bool"
, Field "objectId" "Word32le"
, Field "objectName" "Maybe Str"
, Field "value" "ProductAttributeValue"
]
, "ProductAttribute"
, ["Word32le", "Str", "ProductAttributeValue"]
)
, ( TypeSum $ Sum "ProductAttributeValue" []
[ Constructor "PaintedOld" ["CompressedWord"]
, Constructor "PaintedNew" ["Word32"]
, Constructor "TeamEditionOld" ["CompressedWord"]
, Constructor "TeamEditionNew" ["Word32"]
, Constructor "SpecialEdition" ["Word32"]
, Constructor "UserColorOld" ["Maybe Word32"]
, Constructor "UserColorNew" ["Word32le"]
, Constructor "TitleId" ["Str"]
]
, "ProductAttributeValue"
, ["CompressedWord", "Word32le", "Str"]
)
, ( TypeProduct $ Product "LoadoutsAttribute" []
[ Field "blue" "LoadoutAttribute"
, Field "orange" "LoadoutAttribute"
]
, "LoadoutsAttribute"
, ["LoadoutAttribute"]
)
, ( TypeProduct $ Product "LoadoutsOnlineAttribute" []
[ Field "blue" "LoadoutOnlineAttribute"
, Field "orange" "LoadoutOnlineAttribute"
, Field "unknown1" "Bool"
, Field "unknown2" "Bool"
]
, "LoadoutsOnlineAttribute"
, ["LoadoutOnlineAttribute"]
)
, ( TypeWrapper $ Wrapper "LocationAttribute" [] "Vector"
, "LocationAttribute"
, ["Vector"]
)
, ( TypeProduct $ Product "MusicStingerAttribute" []
[ Field "flag" "Bool"
, Field "cue" "Word32le"
, Field "trigger" "Word8le"
]
, "MusicStingerAttribute"
, ["Word32le", "Word8le"]
)
, ( TypeProduct $ Product "PartyLeaderAttribute" []
[ Field "systemId" "Word8le"
, Field "id" "Maybe (RemoteId, Word8le)"
]
, "PartyLeaderAttribute"
, ["Word8le", "RemoteId"]
)
, ( TypeSum $ Sum "RemoteId" []
[ Constructor "PlayStation" ["Text", "[Word8]"]
, Constructor "PsyNet" ["Either Word64le (Word64le, Word64le, Word64le, Word64le)"]
, Constructor "Splitscreen" ["Word32"]
, Constructor "Steam" ["Word64le"]
, Constructor "Switch" ["Word64le", "Word64le", "Word64le", "Word64le"]
, Constructor "Xbox" ["Word64le"]
]
, "RemoteId"
, ["Word64le"]
)
, ( TypeProduct $ Product "PickupAttribute" []
[ Field "instigatorId" "Maybe Word32le"
, Field "pickedUp" "Bool"
]
, "PickupAttribute"
, ["Word32le"]
)
, ( TypeProduct $ Product "PickupAttributeNew" []
[ Field "instigatorId" "Maybe Word32le"
, Field "pickedUp" "Word8le"
]
, "PickupAttributeNew"
, ["Word32le", "Word8le"]
)
, ( TypeWrapper $ Wrapper "PlayerHistoryKeyAttribute" [] "Word16"
, "PlayerHistoryKeyAttribute"
, []
)
, ( TypeProduct $ Product "PrivateMatchSettingsAttribute" []
[ Field "mutators" "Str"
, Field "joinableBy" "Word32le"
, Field "maxPlayers" "Word32le"
, Field "gameName" "Str"
, Field "password" "Str"
, Field "flag" "Bool"
]
, "PrivateMatchSettingsAttribute"
, ["Str", "Word32le"]
)
, ( TypeWrapper $ Wrapper "QWordAttribute" [] "Word64le"
, "QWordAttribute"
, ["Word64le"]
)
, ( TypeProduct $ Product "ReservationAttribute" []
[ Field "number" "CompressedWord"
, Field "uniqueId" "UniqueIdAttribute"
, Field "name" "Maybe Str"
, Field "unknown1" "Bool"
, Field "unknown2" "Bool"
, Field "unknown3" "Maybe Word8"
]
, "ReservationAttribute"
, ["CompressedWord", "UniqueIdAttribute", "Str"]
)
, ( TypeProduct $ Product "RigidBodyStateAttribute" []
[ Field "sleeping" "Bool"
, Field "location" "Vector"
, Field "rotation" "Rotation"
, Field "linearVelocity" "Maybe Vector"
, Field "angularVelocity" "Maybe Vector"
]
, "RigidBodyStateAttribute"
, ["Vector", "Rotation"]
)
, ( TypeSum $ Sum "Rotation" []
[ Constructor "CompressedWordVector" ["CompressedWordVector"]
, Constructor "Quaternion" ["Quaternion"]
]
, "Rotation"
, ["CompressedWordVector", "Quaternion"]
)
, ( TypeProduct $ Product "CompressedWordVector" []
[ Field "x" "CompressedWord"
, Field "y" "CompressedWord"
, Field "z" "CompressedWord"
]
, "CompressedWordVector"
, ["CompressedWord"]
)
, ( TypeProduct $ Product "Quaternion" []
[ Field "x" "Double"
, Field "y" "Double"
, Field "z" "Double"
, Field "w" "Double"
]
, "Quaternion"
, ["CompressedWord"]
)
, ( TypeProduct $ Product "StatEventAttribute" []
[ Field "unknown" "Bool"
, Field "objectId" "Int32le"
]
, "StatEventAttribute"
, ["Int32le"]
)
, ( TypeWrapper $ Wrapper "StringAttribute" [] "Str"
, "StringAttribute"
, ["Str"]
)
, ( TypeProduct $ Product "TeamPaintAttribute" []
[ Field "team" "Word8le"
, Field "primaryColor" "Word8le"
, Field "accentColor" "Word8le"
, Field "primaryFinish" "Word32le"
, Field "accentFinish" "Word32le"
]
, "TeamPaintAttribute"
, ["Word8le", "Word32le"]
)
, ( TypeProduct $ Product "TitleAttribute" []
[ Field "unknown1" "Bool"
, Field "unknown2" "Bool"
, Field "unknown3" "Word32le"
, Field "unknown4" "Word32le"
, Field "unknown5" "Word32le"
, Field "unknown6" "Word32le"
, Field "unknown7" "Word32le"
, Field "unknown8" "Bool"
]
, "TitleAttribute"
, ["Word32le"]
)
, ( TypeProduct $ Product "UniqueIdAttribute" []
[ Field "systemId" "Word8le"
, Field "remoteId" "RemoteId"
, Field "localId" "Word8le"
]
, "UniqueIdAttribute"
, ["Word8le", "RemoteId"]
)
, ( TypeProduct $ Product "WeldedInfoAttribute" []
[ Field "active" "Bool"
, Field "actorId" "Int32le"
, Field "offset" "Vector"
, Field "mass" "Float32le"
, Field "rotation" "Int8Vector"
]
, "WeldedInfoAttribute"
, ["Int32le", "Vector", "Float32le", "Int8Vector"]
)
]
#! /usr/bin/env sh
set -o errexit
stack build
rm -f -r output
stack exec deriving-benchmark
cd output
echo 'slug,amount,optimization,jobs,seconds'
for slug in *
do
(
cd "$slug"
for amount in *
do
(
cd "$amount"
for optimization in 0 1 2
do
for jobs in 1 2 4 8
do
stack exec -- time -f "$slug,$amount,$optimization,$jobs,%e" \
ghc -fforce-recomp -v0 -w Rattletrap.hs "-O$optimization" "-j$jobs"
done
done
)
done
)
done
resolver: lts-15.13
compiler: ghc-8.10.1
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment