https://github.com/tfausak/tfausak.github.io/issues/153

.gitignore

/.stack-work/
/output/
/results.csv
/stack.yaml.lock

deriving-benchmark.cabal

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

deriving-benchmark.hs

-- 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"]
    )
  ]

run.sh

#! /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

stack.yaml

resolver: lts-15.13
compiler: ghc-8.10.1