registry-hedgehog 0.3.0.0 → 0.4.0.0
raw patch · 11 files changed
+56/−50 lines, 11 filesdep ~protoludedep ~registrysetup-changed
Dependency ranges changed: protolude, registry
Files
- Setup.hs +1/−1
- registry-hedgehog.cabal +5/−5
- src/Data/Registry/Hedgehog.hs +7/−7
- src/Data/Registry/Hedgehog/TH.hs +5/−3
- src/Data/Registry/Internal/Hedgehog.hs +1/−0
- src/Data/Registry/Internal/TH.hs +13/−11
- src/Test/Tasty/Hedgehogx.hs +5/−0
- test/Test/Data/Registry/Generators.hs +4/−9
- test/Test/Data/Registry/HedgehogSpec.hs +6/−6
- test/Test/Tutorial/Exercise1.hs +6/−5
- test/Test/Tutorial/Exercise2.hs +3/−3
Setup.hs view
@@ -1,4 +1,4 @@-import Distribution.Simple+import Distribution.Simple main :: IO () main = defaultMain
registry-hedgehog.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 5172e9a2dee2ae8064a8ddd51dbad2923b92ace8e8141381ba7b40be413c7bdb+-- hash: 036db94cca530b2d314b5b42f37b5843436c26f4be294c28f33f663be555e541 name: registry-hedgehog-version: 0.3.0.0+version: 0.4.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@@ -40,8 +40,8 @@ , hedgehog >=1.0 && <2 , mmorph >=1 && <2 , multimap >=1 && <2- , protolude >=0.2 && <0.3- , registry >=0.1.4 && <2+ , protolude >=0.3 && <0.4+ , registry >=0.2 && <0.3 , tasty >=1 && <2 , tasty-discover >=2 && <5 , tasty-hedgehog >=1.0 && <2.0@@ -80,7 +80,7 @@ , hedgehog >=1.0 && <2 , mmorph , multimap >=1 && <2- , protolude >=0.2 && <0.3+ , protolude >=0.3 && <0.4 , registry , registry-hedgehog , tasty
src/Data/Registry/Hedgehog.hs view
@@ -82,11 +82,11 @@ -- | Extract a generator from a registry -- We use makeUnsafe assuming that the registry has been checked before genWith :: forall a ins out. (Typeable a) => Registry ins out -> GenIO a-genWith = makeUnsafe @(GenIO a)+genWith = make @(GenIO a) -- | Modify the value of a generator in a given registry tweakGen :: forall a ins out. (Typeable a) => (a -> a) -> Registry ins out -> Registry ins out-tweakGen f = tweakUnsafe @(GenIO a) (\genA -> f <$> genA)+tweakGen f = tweak @(GenIO a) (f <$>) -- | Modify the registry for a given generator in a State monad tweakGenS :: forall a m ins out. (Typeable a, MonadState (Registry ins out) m) => (a -> a) -> m ()@@ -97,7 +97,7 @@ 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)+setGenIO genA = tweak @(GenIO a) (const genA) -- | Set a specific generator on the registry the value of a generator in a given registry in a State monad setGenS :: forall a m ins out. (Typeable a, MonadState (Registry ins out) m) => Gen a -> m ()@@ -117,7 +117,7 @@ -- | Modify a generator modifyGenS :: forall a ins out. (Typeable a) => (GenIO a -> GenIO a) -> PropertyT (StateT (Registry ins out) IO) ()-modifyGenS f = modify (tweakUnsafe @(GenIO a) f)+modifyGenS f = modify (tweak @(GenIO a) f) -- | Filter a generator filterGenS :: forall a ins out. (Typeable a) => (a -> Bool) -> PropertyT (StateT (Registry ins out) IO) ()@@ -136,7 +136,7 @@ -- extract a generator for one element only let genA = genWith @a r in -- add that element in front of a list of generated elements- tweakUnsafe @(GenIO [a]) (\genAs -> (:) <$> genA <*> genAs) r+ tweak @(GenIO [a]) (\genAs -> (:) <$> genA <*> genAs) r -- | Make sure there is always one element of a given type in a list of elements in a State monad makeNonEmptyS :: forall a m ins out. (Typeable a, MonadState (Registry ins out) m) => m ()@@ -220,7 +220,7 @@ setDistinct = setDistinctWithRef @a (unsafePerformIO $ newIORef []) setDistinctWithRef :: forall a ins out. (Eq a, Typeable a, Contains (GenIO a) out) => IORef [a] -> Registry ins out -> Registry ins out-setDistinctWithRef ref r = setGenIO (distinctWith ref (makeFast @(GenIO a) r)) r+setDistinctWithRef ref r = setGenIO (distinctWith ref (make @(GenIO a) r)) r -- | Generate distinct values for a specific data type {-# NOINLINE setDistinctS #-}@@ -235,7 +235,7 @@ setDistinctFor = setDistinctForWithRef @a @b (unsafePerformIO $ newIORef []) setDistinctForWithRef :: forall a b ins out. (Typeable a, Contains (GenIO a) out, Eq b, Typeable b, Contains (GenIO b) out) => IORef [b] -> Registry ins out -> Registry ins out-setDistinctForWithRef ref r = specializeGenIO @a (distinctWith ref (makeFast @(GenIO b) r)) r+setDistinctForWithRef ref r = specializeGenIO @a (distinctWith ref (make @(GenIO b) r)) r -- | Generate distinct values for a specific data type, when used inside another data type {-# NOINLINE setDistinctForS #-}
src/Data/Registry/Hedgehog/TH.hs view
@@ -1,10 +1,9 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TemplateHaskell #-} module Data.Registry.Hedgehog.TH where import Control.Monad.Fail (fail)+import Data.Registry import Data.Registry.Internal.TH import Language.Haskell.TH import Language.Haskell.TH.Syntax@@ -18,7 +17,7 @@ -- <: genFun (tag @"temporary" Temporary) -- -- genEmployeeStatus :: GenIO Chooser -> GenIO (Tag "permanent" EmployeeStatus) -> GenIO (Tag "temporary" EmployeeStatus) -> GenIO EmployeeStatus--- genEmployeeStatus chooser g1 g2 = chooseOne chooser [fmap unTagg1, fmap unTag g2]+-- genEmployeeStatus chooser g1 g2 = chooseOne chooser [fmap unTag1, fmap unTag g2] makeGenerators :: Name -> ExpQ makeGenerators genType = do info <- reify genType@@ -30,3 +29,6 @@ other -> do qReport True ("can only create generators for an ADT, got: " <> show other) fail "generators creation failed"++emptyRegistry :: Registry '[] '[]+emptyRegistry = mempty
src/Data/Registry/Internal/Hedgehog.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE PartialTypeSignatures #-} module Data.Registry.Internal.Hedgehog
src/Data/Registry/Internal/TH.hs view
@@ -6,7 +6,7 @@ import Control.Monad.Fail (fail) import Data.Registry.Internal.Hedgehog-import Data.Text (splitOn, toLower)+import Data.Text (splitOn) import Language.Haskell.TH import Language.Haskell.TH.Syntax import Protolude hiding (Type)@@ -54,7 +54,7 @@ constructorParameterName :: Con -> Q Name constructorParameterName constructor = do name <- constructorName constructor- pure $ mkName (toS $ toLower name)+ pure $ mkName (toLower <$> toS name) -- | Extract the last name of a constructor constructorName :: Con -> Q Text@@ -78,21 +78,23 @@ qReport True ("we can only create generators for normal constructors and records, got: " <> show other) fail "generators creation failed" --- | runQ [| fun g <: genFun e <: genFun f|]--- InfixE (Just (AppE (VarE Data.Registry.Registry.fun) (UnboundVarE g))) (VarE <:) (Just (InfixE (Just (AppE (VarE Data.Registry.Hedgehog.genFun) (UnboundVarE e)))--- (VarE Data.Registry.Registry.<:) (Just (AppE (VarE Data.Registry.Hedgehog.genFun) (UnboundVarE f)))))+-- | runQ [| fun g +: genFun e +: genFun f|]+-- InfixE (Just (AppE (VarE Data.Registry.Registry.fun) (UnboundVarE g))) (VarE +:) (Just (InfixE (Just (AppE (VarE Data.Registry.Hedgehog.genFun) (UnboundVarE e)))+-- (VarE Data.Registry.Registry.+:) (Just (AppE (VarE Data.Registry.Hedgehog.genFun) (UnboundVarE f))))) assembleGeneratorsToRegistry :: Exp -> [Exp] -> ExpQ assembleGeneratorsToRegistry _ [] = fail "generators creation failed" assembleGeneratorsToRegistry selectorGenerator [g] =- let r = appendExpressions (genFunOf (pure g)) (funOf (pure selectorGenerator))- in appendExpressions r (genFunOf (varE (mkName "choiceChooser")))+ app (genFunOf (pure g)) $+ app (funOf (pure selectorGenerator)) $+ app (genFunOf (varE (mkName "choiceChooser"))) (varE (mkName "emptyRegistry"))+-- assembleGeneratorsToRegistry selectorGenerator (g : gs) =- appendExpressions (genFunOf (pure g)) (assembleGeneratorsToRegistry selectorGenerator gs)+ app (genFunOf (pure g)) (assembleGeneratorsToRegistry selectorGenerator gs) -appendExpressions :: ExpQ -> ExpQ -> ExpQ-appendExpressions e1 e2 =- infixE (Just e1) (varE (mkName "<:")) (Just e2)+app :: ExpQ -> ExpQ -> ExpQ+app e1 e2 =+ infixE (Just e1) (varE (mkName "+:")) (Just e2) genFunOf :: ExpQ -> ExpQ genFunOf = appE (varE (mkName "genFun"))
src/Test/Tasty/Hedgehogx.hs view
@@ -14,18 +14,23 @@ ( module Hedgehog, module Tasty, module Test.Tasty.HedgehogTest,+ -- * Tests definition prop, test,+ -- * Tests settings minTestsOk, noShrink, withSeed,+ -- * Running tests run, runOnly,+ -- * Assertions gotException,+ -- * Display printDifference, display,
test/Test/Data/Registry/Generators.hs view
@@ -10,7 +10,6 @@ import Data.Registry import Data.Registry.Hedgehog import Data.Registry.Hedgehog.TH-import Data.Registry.TH import Hedgehog.Gen as Gen hiding (print) import Hedgehog.Internal.Gen hiding (print) import Hedgehog.Range@@ -20,14 +19,14 @@ registry = genFun Company+ <: fun (listOf @Department) <: genFun Department+ <: fun (listOf @Employee) <: genFun Employee -- we can generate data for different constructors in an ADT with some Template Haskell <: $(makeGenerators ''EmployeeStatus)- -- we can generate Lists or Maybe of elements- <: fun (listOf @Department)- <: fun (listOf @Employee) <: fun (maybeOf @Int)+ -- we can generate Lists or Maybe of elements <: genVal genInt <: genVal genText @@ -41,10 +40,6 @@ -- See the gory details of why this is necessary: https://gitlab.haskell.org/ghc/ghc/issues/9813 $(return []) --- | Check that the registry is complete. This speeds up compilation when there are lots of generators-generators :: Registry _ _-generators = $(checkRegistry 'registry)- -- | We create a forall function using all the generators forall :: forall a. _ => PropertyT IO a-forall = withFrozenCallStack $ forAllT (genWith @a generators)+forall = withFrozenCallStack $ forAllT (genWith @a registry)
test/Test/Data/Registry/HedgehogSpec.hs view
@@ -83,7 +83,7 @@ n <- forAll (integral (linear 1 3)) (n >= 1) === True --- * USING GENERATORS+-- * USING registry test_company_1 = prop "a company can be used for testing" $ do@@ -100,14 +100,14 @@ test_small_company = prop "a small company has just one department and one employee" $- runS generators $ do+ runS registry $ do setSmallCompany company <- forallS @Company length (departments company) === 1 let Just d = head $ departments company length (employees d) === 1 --- * We can also specialize some generators in a given context+-- * We can also specialize some registry in a given context -- For example we might want to generate shorter department names even -- if Department is using Text values. To do this we specialize the Text@@ -119,7 +119,7 @@ test_with_better_department_name = noShrink $ prop "a department must have a short capitalized name" $- runS generators $ do+ runS registry $ do setSmallCompany setDepartmentName company <- forallS @Company@@ -135,7 +135,7 @@ test_cycle_constructors = prop "we can cycle deterministically across all the constructors of a data type" $- runS generators $ do+ runS registry $ do setCycleChooserS @EmployeeStatus -- uncomment to check -- collect =<< forallS @EmployeeStatus@@ -144,7 +144,7 @@ -- We can also make sure we generate distinct values for a given type test_distinct_values = prop "we can generate distinct values for a given data type when used in a specific context" $- runS generators $ do+ runS registry $ do setDistinctForS @Department @Text -- uncomment to check -- collect =<< departmentName <$> forallS @Department
test/Test/Tutorial/Exercise1.hs view
@@ -16,11 +16,12 @@ registry :: Registry _ _ registry = genFun Company- <: genFun Department- <: genFun Employee- <: genVal genEmployeeStatus- <: genVal genInt- <: genVal genText+ +: genFun Department+ +: genFun Employee+ +: genVal genEmployeeStatus+ +: genVal genInt+ +: genVal genText+ +: mempty genInt :: Gen Int genInt = integral (linear 1 3)
test/Test/Tutorial/Exercise2.hs view
@@ -17,12 +17,12 @@ registry :: Registry _ _ registry = genFun Company+ <: fun (listOf @Department) <: genFun Department- <: genFun Employee <: fun (listOf @Employee)- <: fun (listOf @Department)- <: fun (maybeOf @Int)+ <: genFun Employee <: genVal genEmployeeStatus+ <: fun (maybeOf @Int) <: genVal genInt <: genVal genText