{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Test.Hspec.Core.Annotations (
  Annotations
, setValue
, getValue
) where

import           Prelude ()
import           Test.Hspec.Core.Compat

import           Data.Typeable
import           Data.Dynamic
import           Data.Map (Map)
import qualified Data.Map as Map

newtype Annotations = Annotations (Map TypeRep Dynamic)
  deriving (
#if MIN_VERSION_base(4,11,0)
  NonEmpty Annotations -> Annotations
Annotations -> Annotations -> Annotations
(Annotations -> Annotations -> Annotations)
-> (NonEmpty Annotations -> Annotations)
-> (forall b. Integral b => b -> Annotations -> Annotations)
-> Semigroup Annotations
forall b. Integral b => b -> Annotations -> Annotations
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Annotations -> Annotations -> Annotations
<> :: Annotations -> Annotations -> Annotations
$csconcat :: NonEmpty Annotations -> Annotations
sconcat :: NonEmpty Annotations -> Annotations
$cstimes :: forall b. Integral b => b -> Annotations -> Annotations
stimes :: forall b. Integral b => b -> Annotations -> Annotations
Semigroup,
#endif
  Semigroup Annotations
Annotations
Semigroup Annotations =>
Annotations
-> (Annotations -> Annotations -> Annotations)
-> ([Annotations] -> Annotations)
-> Monoid Annotations
[Annotations] -> Annotations
Annotations -> Annotations -> Annotations
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Annotations
mempty :: Annotations
$cmappend :: Annotations -> Annotations -> Annotations
mappend :: Annotations -> Annotations -> Annotations
$cmconcat :: [Annotations] -> Annotations
mconcat :: [Annotations] -> Annotations
Monoid)

setValue :: Typeable value => value -> Annotations -> Annotations
setValue :: forall value. Typeable value => value -> Annotations -> Annotations
setValue value
value (Annotations Map TypeRep Dynamic
values) = Map TypeRep Dynamic -> Annotations
Annotations (Map TypeRep Dynamic -> Annotations)
-> Map TypeRep Dynamic -> Annotations
forall a b. (a -> b) -> a -> b
$ TypeRep -> Dynamic -> Map TypeRep Dynamic -> Map TypeRep Dynamic
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (value -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf value
value) (value -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn value
value) Map TypeRep Dynamic
values

getValue :: forall value. Typeable value => Annotations -> Maybe value
getValue :: forall value. Typeable value => Annotations -> Maybe value
getValue (Annotations Map TypeRep Dynamic
values) = TypeRep -> Map TypeRep Dynamic -> Maybe Dynamic
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (value -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (value
forall a. HasCallStack => a
undefined :: value)) Map TypeRep Dynamic
values Maybe Dynamic -> (Dynamic -> Maybe value) -> Maybe value
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dynamic -> Maybe value
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic