Add field to Result which allows storage of arbitrary data

core/Test/Tasty/Core.hs

@@ -3,11 +3,17 @@
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Test.Tasty.Core
   ( FailureReason(..)
   , Outcome(..)
   , Time
   , Result(..)
+  , SomeExtraData(..)
+  , attachExtraData
+  , lookupExtraData
   , resultSuccessful
   , exceptionResult
   , Progress(..)
@@ -120,11 +126,38 @@ data Result = Result
     -- Usually this is set to 'noResultDetails', which does nothing.
     --
     -- @since 1.3.1
+  , resultExtraData :: Map.Map TypeRep SomeExtraData
+    -- ^ Any extra data attached to result of test evaluation
+    --
+    -- @since NEXTVERSION
   }
   deriving
   ( Show -- ^ @since 1.2
   )
 
+-- | @Dynamic@-like wrapper for data of arbitrary type but it carries
+--   additional type class dictionaries.
+data SomeExtraData where
+  SomeExtraData :: (Typeable a, Show a, Read a, Eq a) => a -> SomeExtraData
+
+deriving instance Show SomeExtraData
+
+
+-- | Lookup values of given type o
+--
+-- @since NEXTVERSION
+lookupExtraData :: forall a. Typeable a => Result -> Maybe a
+lookupExtraData r = do
+  SomeExtraData a <- typeOf (undefined :: a) `Map.lookup` resultExtraData r
+  cast a
+
+-- | Attach value of arbitrary type to result of execution
+--
+-- @since NEXTVERSION
+attachExtraData :: (Typeable a, Show a, Read a, Eq a) => a -> Result -> Result
+attachExtraData a r =
+  r { resultExtraData = Map.insert (typeOf a) (SomeExtraData a) (resultExtraData r) }
+
 {- Note [Skipped tests]
    ~~~~~~~~~~~~~~~~~~~~
    There are two potential ways to represent the tests that are skipped
@@ -164,6 +197,7 @@ exceptionResult e = Result
   , resultShortDescription = "FAIL"
   , resultTime = 0
   , resultDetailsPrinter = noResultDetails
+  , resultExtraData = mempty
   }
 
 -- | Test progress information.

core/Test/Tasty/Providers.hs

@@ -35,6 +35,7 @@ testPassed desc = Result
   , resultShortDescription = "OK"
   , resultTime = 0
   , resultDetailsPrinter = noResultDetails
+  , resultExtraData = mempty
   }
 
 -- | 'Result' of a failed test.
@@ -49,6 +50,7 @@ testFailed desc = Result
   , resultShortDescription = "FAIL"
   , resultTime = 0
   , resultDetailsPrinter = noResultDetails
+  , resultExtraData = mempty
   }
 
 -- | 'Result' of a failed test with custom details printer

core/Test/Tasty/Run.hs

@@ -194,6 +194,7 @@ executeTest action statusVar timeoutOpt hideProgressOpt inits fins = mask $ \res
             , resultShortDescription = "TIMEOUT"
             , resultTime = fromIntegral t
             , resultDetailsPrinter = noResultDetails
+            , resultExtraData = mempty
             }
       -- If compiled with unbounded-delays then t' :: Integer, otherwise t' :: Int
       let t' = fromInteger (min (max 0 t) (toInteger (maxBound :: Int64)))
@@ -490,6 +491,7 @@ resolveDeps tests = maybeCheckCycles $ do
           , resultShortDescription = "SKIP"
           , resultTime = 0
           , resultDetailsPrinter = noResultDetails
+          , resultExtraData = mempty
           }
       }
   return (TestAction { testAction = action, .. }, (testPath, dep_paths))

core/Test/Tasty/Runners.hs

@@ -35,6 +35,8 @@ module Test.Tasty.Runners
     -- * Running tests
   , Status(..)
   , Result(..)
+  , attachExtraData
+  , lookupExtraData
   , Outcome(..)
   , FailureReason(..)
   , resultSuccessful