Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add field to Result which allows storage of arbitrary data #381

Draft
wants to merge 2 commits into
base: master
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
21 changes: 21 additions & 0 deletions core/Test/Tasty/Core.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,8 @@ module Test.Tasty.Core
, Outcome(..)
, Time
, Result(..)
, attachExtraData
, lookupExtraData
, resultSuccessful
, exceptionResult
, Progress(..)
Expand All @@ -33,12 +35,14 @@ module Test.Tasty.Core
import Control.Exception
import qualified Data.Map as Map
import Data.Bifunctor (Bifunctor(second, bimap))
import Data.Foldable (asum)
import Data.List (mapAccumR)
import Data.Monoid (Any (getAny, Any))
import Data.Sequence ((|>))
import qualified Data.Sequence as Seq
import Data.Tagged
import Data.Typeable
import Data.Dynamic
import GHC.Generics
import Options.Applicative (internal)
import Test.Tasty.Options
Expand Down Expand Up @@ -120,11 +124,27 @@ data Result = Result
-- Usually this is set to 'noResultDetails', which does nothing.
--
-- @since 1.3.1
, resultExtraData :: [Dynamic]
-- ^ Any extra data attached to result of test evaluation
--
-- @since NEXTVERSION
}
deriving
( Show -- ^ @since 1.2
)

-- | Lookup values of given type o
--
-- @since NEXTVERSION
lookupExtraData :: Typeable a => Result -> Maybe a
lookupExtraData = asum . map fromDynamic . resultExtraData

-- | Attach value of arbitrary type to result of execution
--
-- @since NEXTVERSION
attachExtraData :: Typeable a => a -> Result -> Result
attachExtraData a r = r { resultExtraData = toDyn a : resultExtraData r }
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't like that you can attach multiple values of the same type here but only get one of them back. Possible suggestions:

  • Use a map from TypeRep to Dynamic so we can only have one Dynamic per type
  • Have lookupExtraData just return a list of mapMaybe fromDynamic.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is it even plausible to have multiple extra data to the same Result? I'd imagine that each result is produced by a single test provider, so resultExtraData :: Maybe Dynamic should suffice.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@ocharles re [Dynamic] vs Map TypeRep Dynamic. Both has ugly side. Here I treat list as append only map which retain history of updates and old versions are kept around for no reason. Map variant allows adding (manually) elements with non-matching TypeReps. Either way I don't feel strongly about representation. Returning list of results seems inconvenient to use.

@Bodigrim I prefer ask opposite question. Is there good reason to prohibit attaching multiple pieces of data? I don't see any. Maybe Dynamic will restrict possible uses without gaining anything out of it. It is possible to invent possible uses: two different options to generate report where each generator expects data in different format.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Dynamic is big enough already and includes any type, including lists of other Dynamic. In a certain sense even Maybe Dynamic is one element too big.

I think I'd prefer to be more explicit and unwrap Dynamic, making Result a GADT hiding type of resultExtraData :: Typeable a => a. But I'd like to hear more opinions before deciding on this.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What is benefit of single Dynamic? To it looks like a strictly worse alternative. If one has two distinct pieces of data A and B sure one may attach tuple (A,B) but then there's no way to look up only B. This proposal brings features from dynamically typed languages: ability to add arbitrary fields to objects. Here keyed by haskell types instead of strings. Having single fields seems needlessly limiting to me.

GADT is especially problematic. It's liable to cause problem with type checking, record updates, record dot.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's just a coincidence that Result does not declare instances other than Show, otherwise Dynamic would not work. I do not want to prohibit defining potential instance Eq Result and such in future.

So I think data SomeExtraInfo = forall a. (Typeable a, Ord a, Show a, NFData a) => a or similar is a better choice.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes. That's quite reasonable. I've amended PR and added Read too. There're two complications:

  1. There's no sensible implementation for Ord. We'll need to compare different types and only way to do so is via TypeRep which use some sort of hash internally so I don't think such order would be stable wrt to package/compiler versions. I'm not sure it's good idea to add such instances
  2. Adding NFData will require adding dependency on deepseq


{- Note [Skipped tests]
~~~~~~~~~~~~~~~~~~~~
There are two potential ways to represent the tests that are skipped
Expand Down Expand Up @@ -164,6 +184,7 @@ exceptionResult e = Result
, resultShortDescription = "FAIL"
, resultTime = 0
, resultDetailsPrinter = noResultDetails
, resultExtraData = []
}

-- | Test progress information.
Expand Down
2 changes: 2 additions & 0 deletions core/Test/Tasty/Providers.hs
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,7 @@ testPassed desc = Result
, resultShortDescription = "OK"
, resultTime = 0
, resultDetailsPrinter = noResultDetails
, resultExtraData = []
}

-- | 'Result' of a failed test.
Expand All @@ -49,6 +50,7 @@ testFailed desc = Result
, resultShortDescription = "FAIL"
, resultTime = 0
, resultDetailsPrinter = noResultDetails
, resultExtraData = []
}

-- | 'Result' of a failed test with custom details printer
Expand Down
2 changes: 2 additions & 0 deletions core/Test/Tasty/Run.hs
Original file line number Diff line number Diff line change
Expand Up @@ -194,6 +194,7 @@ executeTest action statusVar timeoutOpt hideProgressOpt inits fins = mask $ \res
, resultShortDescription = "TIMEOUT"
, resultTime = fromIntegral t
, resultDetailsPrinter = noResultDetails
, resultExtraData = []
}
-- If compiled with unbounded-delays then t' :: Integer, otherwise t' :: Int
let t' = fromInteger (min (max 0 t) (toInteger (maxBound :: Int64)))
Expand Down Expand Up @@ -490,6 +491,7 @@ resolveDeps tests = maybeCheckCycles $ do
, resultShortDescription = "SKIP"
, resultTime = 0
, resultDetailsPrinter = noResultDetails
, resultExtraData = []
}
}
return (TestAction { testAction = action, .. }, (testPath, dep_paths))
Expand Down
2 changes: 2 additions & 0 deletions core/Test/Tasty/Runners.hs
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,8 @@ module Test.Tasty.Runners
-- * Running tests
, Status(..)
, Result(..)
, attachExtraData
, lookupExtraData
, Outcome(..)
, FailureReason(..)
, resultSuccessful
Expand Down
Loading