diff --git a/registry-hedgehog.cabal b/registry-hedgehog.cabal --- a/registry-hedgehog.cabal +++ b/registry-hedgehog.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: d6259c5709d061f685f6bf9248c96be009efecfc81c474288825777d0b48c3b3 +-- hash: caafc927ce38215ca10339479333651c7cf8ccfd5f25036542303ba286c1c3f6 name: registry-hedgehog -version: 0.1.1.1 +version: 0.2.0.0 synopsis: utilities to work with Hedgehog generators and `registry` description: This library provides some functions to extract generators from a "Registry" and make stateful modifications of that Registry to precisely control the generation of data category: Control @@ -36,14 +36,14 @@ build-depends: base >=4.7 && <5 , containers >=0.2 && <1 - , hedgehog >=0.6 && <1 + , hedgehog >=1.0 && <2 , mmorph >=1 && <2 , multimap >=1 && <2 , protolude >=0.2 && <0.3 , registry >=0.1.4 && <2 , tasty >=1 && <2 , tasty-discover >=2 && <5 - , tasty-hedgehog >=0.1 && <1 + , tasty-hedgehog >=0.3 && <0.4 , tasty-th >=0.1 && <1 , template-haskell >=2.13 && <3.0 , text >=1 && <2 @@ -69,8 +69,7 @@ base >=4.7 && <5 , containers >=0.2 && <1 , generic-lens - , hedgehog >=0.6 && <1 - , hedgehog-corpus + , hedgehog >=1.0 && <2 , mmorph , multimap >=1 && <2 , protolude >=0.2 && <0.3 diff --git a/src/Data/Registry/Hedgehog.hs b/src/Data/Registry/Hedgehog.hs --- a/src/Data/Registry/Hedgehog.hs +++ b/src/Data/Registry/Hedgehog.hs @@ -78,7 +78,7 @@ -- | Lift a Gen a into GenIO a to be added to a registry genVal :: forall a . (Typeable a) => Gen a -> Typed (GenIO a) -genVal g = fun (Gen.lift g) +genVal g = fun (liftGen g) -- | Extract a generator from a registry -- We use makeUnsafe assuming that the registry has been checked before @@ -95,7 +95,7 @@ -- | Set a specific generator on the registry the value of a generator in a given registry setGen :: forall a ins out . (Typeable a) => Gen a -> Registry ins out -> Registry ins out -setGen = setGenIO . Gen.lift +setGen = setGenIO . liftGen setGenIO :: forall a ins out . (Typeable a) => GenIO a -> Registry ins out -> Registry ins out setGenIO genA = tweakUnsafe @(GenIO a) (const genA) @@ -106,7 +106,7 @@ -- | Specialize a generator in a given context specializeGen :: forall a b ins out . (Typeable a, Typeable b, Contains (GenIO a) out) => Gen b -> Registry ins out -> Registry ins out -specializeGen g = specializeGenIO @a (Gen.lift g) +specializeGen g = specializeGenIO @a (liftGen g) -- | Specialize a generator in a given context specializeGenIO :: forall a b ins out . (Typeable a, Typeable b, Contains (GenIO a) out) => GenIO b -> Registry ins out -> Registry ins out diff --git a/src/Data/Registry/Internal/Hedgehog.hs b/src/Data/Registry/Internal/Hedgehog.hs --- a/src/Data/Registry/Internal/Hedgehog.hs +++ b/src/Data/Registry/Internal/Hedgehog.hs @@ -16,23 +16,28 @@ , distinctWith -- utilities +, liftGen , sampleIO ) where -import Control.Monad.Trans.Maybe +import Control.Monad.Morph import Data.IORef -import Data.Maybe as Maybe +import Data.Maybe as Maybe import Hedgehog -import Hedgehog.Gen as Gen -import Hedgehog.Internal.Gen as Gen -import Hedgehog.Internal.Seed as Seed (random) -import Hedgehog.Internal.Tree as Tree (Node (..), Tree (..)) -import Prelude (show, (!!)) -import Protolude as P +import Hedgehog.Gen as Gen +import Hedgehog.Internal.Gen as Gen +import Hedgehog.Internal.Seed as Seed (random) +import Hedgehog.Internal.Tree as Tree (NodeT (..), runTreeT) +import Prelude (show, (!!)) +import Protolude as P -- | All the generators we use are lifted into GenIO to allow some generators to be stateful type GenIO = GenT IO +-- | Lift a pure generator into another monad like IO +liftGen :: (Monad m) => Gen a -> GenT m a +liftGen = hoist (pure . runIdentity) + -- * CHOOSING VALUES DETERMINISTICALLY -- | Given a choosing strategy pick a generator @@ -85,7 +90,7 @@ distinctWith :: (MonadIO m, Eq a) => IORef [a] -> GenT m a -> GenT m a distinctWith ref g = GenT $ \size seed -> do as <- liftIO $ readIORef ref - a <- runGenT size seed $ (Gen.filter (not . flip elem as)) g + a <- runGenT size seed $ (Gen.filterT (not . flip elem as)) g liftIO $ writeIORef ref (a:as) pure a @@ -100,7 +105,7 @@ panic "Hedgehog.Gen.sample: too many discards, could not generate a sample" else do seed <- Seed.random - r <- evalGenIO 30 seed gen + NodeT r _ <- runTreeT $ evalGenT 30 seed gen case r of Nothing -> loop (n - 1) @@ -108,11 +113,3 @@ pure a in loop (100 :: Int) - --- | Runs a generator in IO, to get a value -evalGenIO :: Size -> Seed -> GenIO a -> IO (Maybe a) -evalGenIO size seed g = do - r <- runMaybeT . runTree $ runGenT size seed g - pure $ case r of - Nothing -> Nothing - Just (Node a _) -> Just a diff --git a/test/Test/Data/Registry/Generators.hs b/test/Test/Data/Registry/Generators.hs --- a/test/Test/Data/Registry/Generators.hs +++ b/test/Test/Data/Registry/Generators.hs @@ -11,12 +11,12 @@ import Data.Registry.Hedgehog import Data.Registry.Hedgehog.TH import Data.Registry.TH -import Hedgehog.Gen as Gen hiding (lift, print) -import Hedgehog.Internal.Gen hiding (lift, print) +import Hedgehog.Gen as Gen hiding (print) +import Hedgehog.Internal.Gen hiding (print) import Hedgehog.Range import Protolude hiding (list) import Test.Data.Registry.Company -import Test.Tasty.Hedgehogx hiding (lift) +import Test.Tasty.Hedgehogx registry = genFun Company diff --git a/test/Test/Data/Registry/HedgehogSpec.hs b/test/Test/Data/Registry/HedgehogSpec.hs --- a/test/Test/Data/Registry/HedgehogSpec.hs +++ b/test/Test/Data/Registry/HedgehogSpec.hs @@ -11,12 +11,12 @@ import Data.Registry import Data.Registry.Hedgehog import qualified Data.Text as T (length, take, toUpper) -import Hedgehog.Internal.Gen hiding (lift, print) +import Hedgehog.Internal.Gen hiding (print) import Hedgehog.Range import Protolude hiding (list) import Test.Data.Registry.Company import Test.Data.Registry.Generators -import Test.Tasty.Hedgehogx hiding (lift) +import Test.Tasty.Hedgehogx -- * This specification shows the usage of several features of this library -- First of all you will notice that if you run `stack test`