diff --git a/graph-trace.cabal b/graph-trace.cabal
--- a/graph-trace.cabal
+++ b/graph-trace.cabal
@@ -1,6 +1,6 @@
 cabal-version:      2.4
 name:               graph-trace
-version:            0.1.0.0
+version:            0.1.0.1
 
 synopsis:
   Trace the call graph of a program
@@ -25,7 +25,7 @@
 copyright:     Copyright (C) 2022 Aaron Allen
 category: tooling, debug, development, graph, plugin
 extra-source-files: CHANGELOG.md
-tested-with: GHC==9.2.1, GHC==9.0.1, GHC==8.10.7
+tested-with: GHC==9.2.1, GHC==9.0.1, GHC==9.0.2, GHC==8.10.7
 
 library
   default-language: Haskell2010
@@ -38,6 +38,7 @@
     Graph.Trace.Internal.Instrument
     Graph.Trace.Internal.Predicates
     Graph.Trace.Internal.RuntimeRep
+    Graph.Trace.Internal.TH
   build-depends: base >= 4.9 && < 5
                , ghc >= 8.0.0 && < 9.4.0
                , ghc-prim
diff --git a/src/Graph/Trace/Internal/RuntimeRep.hs b/src/Graph/Trace/Internal/RuntimeRep.hs
--- a/src/Graph/Trace/Internal/RuntimeRep.hs
+++ b/src/Graph/Trace/Internal/RuntimeRep.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 #if MIN_VERSION_ghc(9,0,0)
@@ -16,8 +17,11 @@
 import           GHC.Types (Multiplicity(..))
 #endif
 
+import           Graph.Trace.Internal.TH (allRuntimeReps, makeInstancesForRep)
+
 -- | Levity polymorphic id function. Doesn't cover all runtime reps, in
--- particular unboxed products and sums. Handles linearity as well.
+-- particular unboxed products and sums with more than 2 elements. Handles
+-- linearity as well.
 #if MIN_VERSION_ghc(9,0,0)
 class LPId (r :: RuntimeRep) (m :: Multiplicity) where
   lpId :: forall (a :: TYPE r). a %m -> a
@@ -26,96 +30,5 @@
   lpId :: forall (a :: TYPE r). a -> a
 #endif
 
-#if MIN_VERSION_ghc(9,0,0)
-instance LPId LiftedRep One where
-  lpId x = x
-instance LPId LiftedRep Many where
-  lpId x = x
-instance LPId UnliftedRep One where
-  lpId x = x
-instance LPId UnliftedRep Many where
-  lpId x = x
-instance LPId IntRep One where
-  lpId x = x
-instance LPId IntRep Many where
-  lpId x = x
-instance LPId Int8Rep One where
-  lpId x = x
-instance LPId Int8Rep Many where
-  lpId x = x
-instance LPId Int16Rep One where
-  lpId x = x
-instance LPId Int16Rep Many where
-  lpId x = x
-instance LPId Int32Rep One where
-  lpId x = x
-instance LPId Int32Rep Many where
-  lpId x = x
-instance LPId Int64Rep One where
-  lpId x = x
-instance LPId Int64Rep Many where
-  lpId x = x
-instance LPId WordRep One where
-  lpId x = x
-instance LPId WordRep Many where
-  lpId x = x
-instance LPId Word8Rep One where
-  lpId x = x
-instance LPId Word8Rep Many where
-  lpId x = x
-instance LPId Word16Rep One where
-  lpId x = x
-instance LPId Word16Rep Many where
-  lpId x = x
-instance LPId Word32Rep One where
-  lpId x = x
-instance LPId Word32Rep Many where
-  lpId x = x
-instance LPId Word64Rep One where
-  lpId x = x
-instance LPId Word64Rep Many where
-  lpId x = x
-instance LPId AddrRep One where
-  lpId x = x
-instance LPId AddrRep Many where
-  lpId x = x
-instance LPId FloatRep One where
-  lpId x = x
-instance LPId FloatRep Many where
-  lpId x = x
-instance LPId DoubleRep One where
-  lpId x = x
-instance LPId DoubleRep Many where
-  lpId x = x
-#else
-instance LPId LiftedRep where
-  lpId = id
-instance LPId UnliftedRep where
-  lpId x = x
-instance LPId IntRep where
-  lpId x = x
-instance LPId Int8Rep where
-  lpId x = x
-instance LPId Int16Rep where
-  lpId x = x
-instance LPId Int32Rep where
-  lpId x = x
-instance LPId Int64Rep where
-  lpId x = x
-instance LPId WordRep where
-  lpId x = x
-instance LPId Word8Rep where
-  lpId x = x
-instance LPId Word16Rep where
-  lpId x = x
-instance LPId Word32Rep where
-  lpId x = x
-instance LPId Word64Rep where
-  lpId x = x
-instance LPId AddrRep where
-  lpId x = x
-instance LPId FloatRep where
-  lpId x = x
-instance LPId DoubleRep where
-  lpId x = x
-#endif
+
+$(concat <$> traverse (makeInstancesForRep ''LPId 'lpId) allRuntimeReps)
diff --git a/src/Graph/Trace/Internal/TH.hs b/src/Graph/Trace/Internal/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Graph/Trace/Internal/TH.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DataKinds #-}
+module Graph.Trace.Internal.TH
+  ( makeInstancesForRep
+  , allRuntimeReps
+  ) where
+
+import           Control.Monad
+import           Data.Traversable
+import           GHC.Exts
+#if MIN_VERSION_ghc(9,0,0)
+import           GHC.Types (Multiplicity(..))
+#endif
+import           Language.Haskell.TH
+
+-- | A splice for generating instances for a given RuntimeRep
+makeInstancesForRep :: Name -> Name -> Q Type -> Q [InstanceDec]
+makeInstancesForRep cls meth rep = do
+  let instTypes =
+#if MIN_VERSION_ghc(9,0,0)
+        [ conT cls `appT` rep `appT` [t| One |]
+        , conT cls `appT` rep `appT` [t| Many |]
+        ]
+#else
+        [ conT cls `appT` rep ]
+#endif
+  for instTypes $ \instType -> do
+    x <- newName "x"
+    instanceD (pure []) instType
+      [ funD meth [clause [varP x] (normalB $ varE x) []] ]
+
+-- | RuntimeReps to generate instances for
+runtimeReps :: [Q Type]
+runtimeReps =
+  [ [t| LiftedRep   |]
+  , [t| UnliftedRep |]
+  , [t| IntRep      |]
+  , [t| Int8Rep     |]
+  , [t| Int16Rep    |]
+  , [t| Int32Rep    |]
+  , [t| Int64Rep    |]
+  , [t| WordRep     |]
+  , [t| Word8Rep    |]
+  , [t| Word16Rep   |]
+  , [t| Word32Rep   |]
+  , [t| Word64Rep   |]
+  , [t| AddrRep     |]
+  , [t| FloatRep    |]
+  , [t| DoubleRep   |]
+  ]
+
+tupleReps :: [[Q Type]]
+tupleReps = do
+  len <- [0..2]
+  replicateM len runtimeReps
+
+unboxedTupleReps :: [Q Type]
+unboxedTupleReps = map go tupleReps where
+  go tupleRep = do
+    tys <- sequence tupleRep
+    let list = foldr (AppT . AppT PromotedConsT) PromotedNilT tys
+    conT 'TupleRep `appT` pure list
+
+unboxedSumReps :: [Q Type]
+unboxedSumReps = map go tupleReps where
+  go tupleRep = do
+    tys <- sequence tupleRep
+    let list = foldr (AppT . AppT PromotedConsT) PromotedNilT tys
+    conT 'SumRep `appT` pure list
+
+-- Does not include SIMD vectors b/c they are platform dependent
+allRuntimeReps :: [Q Type]
+allRuntimeReps = runtimeReps <> unboxedTupleReps <> unboxedSumReps
diff --git a/src/Graph/Trace/Internal/Trace.hs b/src/Graph/Trace/Internal/Trace.hs
--- a/src/Graph/Trace/Internal/Trace.hs
+++ b/src/Graph/Trace/Internal/Trace.hs
@@ -20,7 +20,7 @@
 
 import           Control.Concurrent.MVar
 import           Control.Monad
-import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString.Builder as BSB
 import qualified Data.ByteString.Lazy.Char8 as BSL8
 import           GHC.Exts
 import           GHC.Stack (callStack, popCallStack)
@@ -42,12 +42,12 @@
       (callStackToCallSite . popCallStack $ popCallStack callStack)
 
 writeEventToLog :: Event -> IO ()
--- forcing msg is required here since the file MVar could be entagled with it
 writeEventToLog event = seq fileLock $
   withMVar fileLock $ \h ->
-    BSL.hPut h . (<> "\n") $ eventToLogStr event
+    BSB.hPutBuilder h . (<> "\n") $ eventToLogStr event
 
 unsafeWriteTrace :: DebugIP => String -> a -> a
+-- forcing msg is required here since the file MVar could be entagled with it
 unsafeWriteTrace !msg thing =
   unsafePerformIO $ do
     case mkTraceEvent msg of
@@ -107,14 +107,13 @@
       | omitTraces (propagation ip) -> lpId
       | otherwise ->
         let !() = unsafePerformIO $ do
-              withMVar fileLock $ \h -> do
-                let ev = EntryEvent
-                           (currentTag ip)
-                           (previousTag ip)
-                           (definitionSite ip)
-                           -- need to call popCallStack here to get actual call site
-                           (callStackToCallSite $ popCallStack callStack)
-                BSL.hPut h . (<> "\n") $ eventToLogStr ev
+              let ev = EntryEvent
+                         (currentTag ip)
+                         (previousTag ip)
+                         (definitionSite ip)
+                         -- need to call popCallStack here to get actual call site
+                         (callStackToCallSite $ popCallStack callStack)
+              writeEventToLog ev
          in lpId
 {-# NOINLINE entry  #-}
 
diff --git a/src/Graph/Trace/Internal/Types.hs b/src/Graph/Trace/Internal/Types.hs
--- a/src/Graph/Trace/Internal/Types.hs
+++ b/src/Graph/Trace/Internal/Types.hs
@@ -30,7 +30,7 @@
   ) where
 
 import qualified Data.ByteString.Lazy as BSL
-import qualified Data.ByteString.Lazy.Char8 as BSL8
+import qualified Data.ByteString.Builder as BSB
 import           GHC.Stack
 import           GHC.TypeLits
 import qualified Language.Haskell.TH.Syntax as TH
@@ -105,41 +105,39 @@
         }
     _ -> Nothing
 
+sep :: BSB.Builder
+sep = BSB.char8 '§'
+
 -- | Serialize an Event. The § character is used as both a separator and
 -- terminator. Don't use this character in trace messages, it will break!
-eventToLogStr :: Event -> BSL.ByteString
-eventToLogStr (EntryEvent current mPrevious mDefSite mCallSite) =
-  BSL8.intercalate "§"
-    [ "entry"
-    , keyStr current
-    , BSL8.pack . show $ invocationId current
-    , maybe "" keyStr mPrevious
-    , maybe "" (BSL8.pack . show . invocationId) mPrevious
-    , srcCodeLocToLogStr mDefSite
-    , srcCodeLocToLogStr mCallSite
-    ] <> "§"
-eventToLogStr (TraceEvent current message mCallSite) =
-  BSL8.intercalate "§"
-    [ "trace"
-    , keyStr current
-    , BSL8.pack . show $ invocationId current
-    , message
-    , srcCodeLocToLogStr mCallSite
-    ] <> "§"
+eventToLogStr :: Event -> BSB.Builder
+eventToLogStr (EntryEvent current mPrevious mDefSite mCallSite)
+   = BSB.stringUtf8 "entry" <> sep
+  <> keyStr current <> sep
+  <> BSB.wordDec (invocationId current) <> sep
+  <> foldMap keyStr mPrevious <> sep
+  <> foldMap (BSB.wordDec . invocationId) mPrevious <> sep
+  <> srcCodeLocToLogStr mDefSite <> sep
+  <> srcCodeLocToLogStr mCallSite <> sep
+eventToLogStr (TraceEvent current message mCallSite)
+   = BSB.stringUtf8 "trace" <> sep
+  <> keyStr current <> sep
+  <> BSB.wordDec (invocationId current) <> sep
+  <> BSB.lazyByteString message <> sep
+  <> srcCodeLocToLogStr mCallSite <> sep
 
-srcCodeLocToLogStr :: Maybe SrcCodeLoc -> BSL.ByteString
-srcCodeLocToLogStr mLoc =
-  BSL8.intercalate "§"
-    [ foldMap (BSL8.pack . srcModule) mLoc
-    , foldMap (BSL8.pack . show . srcLine) mLoc
-    , foldMap (BSL8.pack . show . srcCol) mLoc
-    ]
+srcCodeLocToLogStr :: Maybe SrcCodeLoc -> BSB.Builder
+srcCodeLocToLogStr mLoc
+   = foldMap (BSB.stringUtf8 . srcModule) mLoc <> sep
+  <> foldMap (BSB.intDec . srcLine) mLoc <> sep
+  <> foldMap (BSB.intDec . srcCol) mLoc
 
-keyStr :: DebugTag -> BSL.ByteString
+keyStr :: DebugTag -> BSB.Builder
 keyStr
-  = either
-      BSL8.pack
-      BSL8.pack
+  = BSB.stringUtf8
+  . either
+      id
+      id
   . debugKey
 
 data DebugNames =
