registry-hedgehog 0.7.1.1 → 0.7.2.0

raw patch · 7 files changed

+22/−49 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• registry-hedgehog.cabal +2/−2
• src/Data/Registry/Hedgehog.hs +3/−3
• src/Data/Registry/Hedgehog/TH.hs +4/−14
• src/Data/Registry/Internal/TH.hs +11/−23
• test/Test/Data/Registry/Generators.hs +1/−1
• test/Test/Tutorial/Exercise2.hs +1/−1
• test/Test/Tutorial/Exercise3.hs +0/−5

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: c15e9873202c179e28188b26aa5f7b4d24bf6069049df537ef5a4da733a4adfa+-- hash: 2bfe939d8ce493f2e69d9924c0319a069110da1a4cfad251f46bcd81ee5b25a0  name:           registry-hedgehog-version:        0.7.1.1+version:        0.7.2.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

@@ -164,11 +164,11 @@  -- | Make sure there is always one element of a given type in a list of elements makeNonEmpty :: forall (a :: Type) ins out. (Typeable a) => Registry ins out -> Registry ins out-makeNonEmpty r = do+makeNonEmpty r =   -- extract a generator for one element only   let genA = genWith @a r-  -- add that element in front of a list of generated elements-  tweak @(Gen [a]) (\genAs -> (:) <$> genA <*> genAs) r+   in -- add that element in front of a list of generated elements+      tweak @(Gen [a]) (\genAs -> (:) <$> genA <*> genAs) r  -- * CONTAINERS COMBINATORS 

@@ -1,10 +1,6 @@ {-# LANGUAGE DataKinds #-} -module Data.Registry.Hedgehog.TH-  ( GeneratorOptions (..),-    module Data.Registry.Hedgehog.TH,-  )-where+module Data.Registry.Hedgehog.TH where  import Control.Monad.Fail (fail) import Data.Registry@@ -13,12 +9,6 @@ import Language.Haskell.TH.Syntax import Protolude -makeGenerators :: Name -> ExpQ-makeGenerators = makeGeneratorsWith defaultGeneratorOptions--makeGeneratorsUnchecked :: Name -> ExpQ-makeGeneratorsUnchecked = makeGeneratorsWith defaultGeneratorOptions {checked = False}- -- | Make a registry containing generators for an ADT --   We  want to generate the following --@@ -28,8 +18,8 @@ -- -- genEmployeeStatus :: Gen Chooser -> Gen (Tag "permanent" EmployeeStatus) -> Gen (Tag "temporary" EmployeeStatus) -> Gen EmployeeStatus -- genEmployeeStatus chooser g1 g2 = chooseOne chooser [fmap unTag1, fmap unTag g2]-makeGeneratorsWith :: GeneratorOptions -> Name -> ExpQ-makeGeneratorsWith options genType = do+makeGenerators :: Name -> ExpQ+makeGenerators genType = do   info <- reify genType   case info of     TyConI (NewtypeD _context _name _typeVars _kind constructor _deriving) -> do@@ -41,7 +31,7 @@     TyConI (DataD _context name _typeVars _kind constructors _deriving) -> do       selector <- makeSelectGenerator name constructors       generators <- traverse makeConstructorGenerator constructors-      assembleGeneratorsToRegistry options selector generators+      assembleGeneratorsToRegistry selector generators     other -> do       qReport True ("can not create generators for this kind of data type at the moment. Got: " <> show other)       fail "generators creation failed"

@@ -13,18 +13,6 @@ import Protolude hiding (Type) import Prelude (last) --- | Options for changing the generated TH code---    if checked = True then we use the <: operator which checks input---    otherwise we use the <+ operator which doesn't check inputs-newtype GeneratorOptions = GeneratorOptions-  { checked :: Bool-  }-  deriving (Eq, Show)---- | By default we want to typecheck the generators-defaultGeneratorOptions :: GeneratorOptions-defaultGeneratorOptions = GeneratorOptions True- -- | Create a generator for selecting between constructors of an ADT --   One parameter is a Gen Chooser in order to be able to later on --   switch the selection strategy@@ -94,22 +82,22 @@ -- | 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 :: GeneratorOptions -> Exp -> [Exp] -> ExpQ-assembleGeneratorsToRegistry options selectorGenerator generators =-  app options (funOf (pure selectorGenerator)) $-    app options (genFunOf (varE (mkName "choiceChooser"))) $-      go generators+assembleGeneratorsToRegistry :: Exp -> [Exp] -> ExpQ+assembleGeneratorsToRegistry selectorGenerator gens =+  app (funOf (pure selectorGenerator)) $+    app (genFunOf (varE (mkName "choiceChooser"))) $+      go gens   where     go [] = fail "generators creation failed"     go [g] = genFunOf (pure g)     go (g:gs) =-      app options (genFunOf (pure g)) $-        go gs+      app (genFunOf $ pure g) (go gs) -app :: GeneratorOptions -> ExpQ -> ExpQ -> ExpQ-app options e1 e2 = do-  let op = if checked options then "<:" else "<+"-  infixE (Just e1) (varE (mkName op)) (Just e2)+++app :: ExpQ -> ExpQ -> ExpQ+app e1 e2 =+  infixE (Just e1) (varE (mkName "<+")) (Just e2)  genFunOf :: ExpQ -> ExpQ genFunOf = appE (varE (mkName "genFun"))

@@ -26,7 +26,7 @@     <: $(makeGenerators ''EmployeeStatus)     <: $(makeGenerators ''DepartmentName)     <: $(makeGenerators ''EmployeeName)-    <: genMaybeOf @Int+    <: fun (maybeOf @Int)     -- we can generate Lists or Maybe of elements     <: genVal genInt     <: genVal genText

@@ -22,7 +22,7 @@     <: fun (listOf @Employee)     <: genFun Employee     <: genFun genEmployeeStatus-    <: genMaybeOf @Int+    <: fun (maybeOf @Int)     <: genVal genInt     <: genVal genText 

@@ -20,11 +20,6 @@   $(makeGenerators ''EmployeeStatus)     <: registry -registry3Unchecked :: Registry _ _-registry3Unchecked =-  $(makeGeneratorsUnchecked ''EmployeeStatus)-    <: registry- forall :: forall a. (Typeable a, Show a) => PropertyT IO a forall = withFrozenCallStack $ forAll $ genWith @a registry3