diff --git a/Trace/Hpc/Tix.hs b/Trace/Hpc/Tix.hs
index 4418781b139101a4810096209791953d74a22c6e..8e16c91f5407a972a52269e36143798d0a0dabd5 100644
--- a/Trace/Hpc/Tix.hs
+++ b/Trace/Hpc/Tix.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE CPP #-}
 #if __GLASGOW_HASKELL__ >= 704
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Safe, DeriveGeneric, StandaloneDeriving #-}
 #elif __GLASGOW_HASKELL__ >= 702
 -- System.FilePath in filepath version 1.2.0.1 isn't marked or implied Safe,
 -- as shipped with GHC 7.2.
@@ -16,6 +16,11 @@ module Trace.Hpc.Tix(Tix(..), TixModule(..),
                      tixModuleName, tixModuleHash, tixModuleTixs,
                      readTix, writeTix, getTixFileName) where
 
+#if __GLASGOW_HASKELL__ >= 704
+import GHC.Generics (Generic)
+import Control.DeepSeq (NFData)
+#endif
+
 import System.FilePath (replaceExtension)
 
 import Trace.Hpc.Util (Hash, catchIO, readFileUtf8, writeFileUtf8)
@@ -25,6 +30,11 @@ import Trace.Hpc.Util (Hash, catchIO, readFileUtf8, writeFileUtf8)
 data Tix = Tix [TixModule]
         deriving (Read, Show, Eq)
 
+#if __GLASGOW_HASKELL__ >= 704
+deriving instance (Generic Tix)
+instance NFData Tix
+#endif
+
 data TixModule = TixModule
                  String    --  module name
                  Hash      --  hash number
@@ -32,6 +42,11 @@ data TixModule = TixModule
                  [Integer] --  actual ticks
         deriving (Read, Show, Eq)
 
+#if __GLASGOW_HASKELL__ >= 704
+deriving instance (Generic TixModule)
+instance NFData TixModule
+#endif
+
 -- TODO: Turn extractors below into proper 'TixModule' field-labels
 tixModuleName :: TixModule -> String
 tixModuleName (TixModule nm _ _ _) = nm
diff --git a/Trace/Hpc/Util.hs b/Trace/Hpc/Util.hs
index 5543e813076957aeb8c9b36d96234e854bd41f42..6b7284a394cdd59d47e3ec7571a392ec0ef23c8d 100644
--- a/Trace/Hpc/Util.hs
+++ b/Trace/Hpc/Util.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE CPP #-}
 #if __GLASGOW_HASKELL__ >= 704
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Safe, DeriveGeneric, StandaloneDeriving #-}
 #elif __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Trustworthy #-}
 #endif
@@ -22,7 +22,11 @@ module Trace.Hpc.Util
        , writeFileUtf8
        ) where
 
-import Control.DeepSeq (deepseq)
+#if __GLASGOW_HASKELL__ >= 704
+import GHC.Generics (Generic)
+#endif
+
+import Control.DeepSeq (deepseq, NFData)
 import qualified Control.Exception as Exception
 import Data.List(foldl')
 import Data.Char (ord)
@@ -81,6 +85,11 @@ class HpcHash a where
 
 newtype Hash = Hash Word32 deriving (Eq)
 
+#if __GLASGOW_HASKELL__ >= 704
+deriving instance (Generic Hash)
+instance NFData Hash
+#endif
+
 instance Read Hash where
   readsPrec p n = [ (Hash v,rest)
                   | (v,rest) <- readsPrec p n