registry-hedgehog 0.2.1.0 → 0.2.1.1

raw patch · 10 files changed

+335/−9 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• registry-hedgehog.cabal +10/−3
• src/Test/Tasty/Hedgehogx.hs +1/−2
• test/Test/Data/Registry/HedgehogSpec.hs +99/−4
• test/Test/Tutorial/DataModel.hs +25/−0
• test/Test/Tutorial/Exercise1.hs +36/−0
• test/Test/Tutorial/Exercise2.hs +47/−0
• test/Test/Tutorial/Exercise3.hs +26/−0
• test/Test/Tutorial/Exercise4.hs +29/−0
• test/Test/Tutorial/Exercise5.hs +35/−0
• test/Test/Tutorial/Exercise6.hs +27/−0

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack ----- hash: 59c5449086a8961a437bf9bc91bda342652afd55b95b175fbf240a9f0c5537f8+-- hash: 8e9ef405c71b1f7fffa4735a082d31c503420e8345fd885ef0408becd6689cc4  name:           registry-hedgehog-version:        0.2.1.0+version:        0.2.1.1 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@@ -60,6 +60,13 @@       Test.Data.Registry.Company       Test.Data.Registry.Generators       Test.Data.Registry.HedgehogSpec+      Test.Tutorial.DataModel+      Test.Tutorial.Exercise1+      Test.Tutorial.Exercise2+      Test.Tutorial.Exercise3+      Test.Tutorial.Exercise4+      Test.Tutorial.Exercise5+      Test.Tutorial.Exercise6       Paths_registry_hedgehog   hs-source-dirs:       test

@@ -34,7 +34,6 @@ import qualified Hedgehog             as Hedgehog ((===)) import           Hedgehog.Gen         as Hedgehog hiding (discard, print) import           Prelude              (String)-import qualified Prelude              as Prelude import           Protolude            hiding (SrcLoc, empty, toList, (.&.)) import           System.Environment import           Test.Tasty           as Tasty@@ -199,7 +198,7 @@   run tests `finally` unsetEnv "TASTY_PATTERN"  -- | Typeclass to unify a simple test in a file like test_simple :: TestTree---   and all the tests retrieved by tasty-discovery which have the type :: IO TestTree  +--   and all the tests retrieved by tasty-discovery which have the type :: IO TestTree class Runnable t where   runIt :: t -> IO TestTree 

@@ -1,28 +1,39 @@-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE PartialTypeSignatures #-}-{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE PartialTypeSignatures      #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}  module Test.Data.Registry.HedgehogSpec where +import           Control.Monad.Morph (hoist)+import           Data.IORef import           Data.Registry import           Data.Registry.Hedgehog-import qualified Data.Text                     as T (length, take, toUpper) import           Hedgehog.Internal.Gen         hiding (print) import           Hedgehog.Range+import           Hedgehog.Gen as Gen import           Protolude                     hiding (list)+import           System.IO.Unsafe import           Test.Data.Registry.Company import           Test.Data.Registry.Generators import           Test.Tasty.Hedgehogx+import           Hedgehog.Internal.Seed as Seed (random)+import           Hedgehog.Internal.Tree as Tree (NodeT (..), runTreeT) +import qualified Data.Text as T+import qualified Data.Text.IO as T -- * This specification shows the usage of several features of this library --   First of all you will notice that if you run `stack test` --   all the properties of this file will be grouped under the Test.Data.Registry.HedgehogSpec test group  -- * DECLARING PROPERTIES +genWord :: MonadIO m => GenT m Text+genWord = do+  ws <- T.lines <$> liftIO (T.readFile "/usr/share/dict/words")+  Gen.element ws+ test_a_simple_test =   test "make a simple assertion, tested only once" $     1 === 1@@ -104,3 +115,87 @@    -- uncomment to check    -- collect =<< departmentName <$> forallS @Department    success+++test_ints_generator =+  prop "we can generate ints" $ do+   n <- forAllT distinctInt+   n === n -- collect n++test_fresh = minTestsOk 10000 $+  prop "we can generate terms with fresh ids" $ do+    -- let termGenerator = genTerm :: GenT (StateT Int Identity) Term+    m <- forAll $ runStateGen genTerm+    -- collect m+    m === m++genFixedText :: (MonadGen m) => m Text+genFixedText = pure "xxx"++genTerm :: (MonadGen m, Fresh m) => m Term+genTerm = Gen.recursive Gen.choice [genValue genFixedText] [Gen.subtermM2 genTerm genTerm makeExp]++genValue :: (MonadGen m, Fresh m) => m Text -> m Term+genValue g = do+  t <- g+  makeValue t++data Term =+    Value Int Text+  | Exp Int Term Term+  deriving (Eq, Show)++makeValue :: (Monad m, Fresh m) => Text -> m Term+makeValue t = do+  n <- fresh+  pure (Value n t)++makeExp :: (Monad m, Fresh m) => Term -> Term -> m Term+makeExp t1 t2 = do+  n <- fresh+  pure (Exp n t1 t2)++class Fresh m where+  fresh :: m Int++runFresh :: (Show a) => GenT (State Int) a -> PropertyT IO a+runFresh = forAll . runStateGen++runStateGen :: (Show a) => GenT (State Int) a -> Gen a+runStateGen = hoist (pure . flip evalState 0  )++instance Fresh (GenT (State Int)) where+  fresh = do+    n <- get+    put (n + 1)+    pure n++-- | Sample GenT IO values+sampleGenIO :: GenT IO a -> IO a+sampleGenIO gen =+    let+      loop n =+        if n <= 0 then+          panic "Hedgehog.Gen.sample: too many discards, could not generate a sample"+        else do+          seed <- Seed.random+          NodeT r _  <- runTreeT $ evalGenT 30 seed gen+          case r of+            Nothing ->+              loop (n - 1)+            Just a ->+              pure a+    in+      loop (100 :: Int)++{-# NOINLINE distinctInt #-}+distinctInt :: GenIO Int+distinctInt = unsafePerformIO $ do+  ref <- newIORef (0 :: Int)+  pure $ distinctIntGenerator ref++distinctIntGenerator :: IORef Int -> GenIO Int+distinctIntGenerator ref = do+  i <- lift $ readIORef ref+  lift $ writeIORef ref (i + 1)+  pure i

@@ -0,0 +1,25 @@+module Test.Tutorial.DataModel where++import           Protolude++data Company = Company {+  companyName :: Text+, departments :: [Department]+} deriving (Eq, Show)++data Department = Department {+  departmentName :: Text+, employees      :: [Employee]+} deriving (Eq, Show)++data Employee = Employee {+  employeeName   :: Text+, employeeStatus :: EmployeeStatus+, salary         :: Int+, bonus          :: Maybe Int+} deriving (Eq, Show)++data EmployeeStatus =+   Permanent+ | Temporary Int -- number of days+ deriving (Eq, Show)

@@ -0,0 +1,36 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}++module Test.Tutorial.Exercise1 where++import           Data.Registry+import           Data.Registry.Hedgehog+import           Hedgehog                hiding (test)+import           Hedgehog.Gen+import           Hedgehog.Range+import           Protolude+import           Test.Tutorial.DataModel++registry :: Registry _ _+registry =+     genFun Company+  <: genFun Department+  <: genFun Employee+  <: genVal genEmployeeStatus+  <: genVal genInt+  <: genVal genText++genInt :: Gen Int+genInt = integral (linear 1 3)++genText :: Gen Text+genText = text (linear 1 10) alpha++genEmployeeStatus :: Gen EmployeeStatus+genEmployeeStatus = pure Permanent++-- this does not compile the registry is not complete+-- makeCompanyGen :: GenIO Company+-- makeCompanyGen = make @(GenIO Company) registry

@@ -0,0 +1,47 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}++module Test.Tutorial.Exercise2 where++import           Data.Registry+import           Data.Registry.Hedgehog+import           Hedgehog                hiding (test)+import           Hedgehog.Gen+import           Hedgehog.Range+import           Protolude+import           Test.Tasty.Hedgehogx+import           Test.Tutorial.DataModel++registry :: Registry _ _+registry =+     genFun Company+  <: genFun Department+  <: genFun Employee+  <: fun    (listOf @Employee)+  <: fun    (listOf @Department)+  <: fun    (maybeOf @Int)+  <: genVal genEmployeeStatus+  <: genVal genInt+  <: genVal genText++genInt :: Gen Int+genInt = integral (linear 1 3)++genText :: Gen Text+genText = text (linear 1 10) alpha++genEmployeeStatus :: Gen EmployeeStatus+genEmployeeStatus = pure Permanent++-- this compiles ok now+makeCompanyGen :: GenIO Company+makeCompanyGen = make @(GenIO Company) registry++forall :: forall a . (Typeable a, Show a) => PropertyT IO a+forall = forAllT $ genWith @a registry++test_company = test "make a company" $ do+  _ <- forall @Company+  success

@@ -0,0 +1,26 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}++module Test.Tutorial.Exercise3 where++import           Data.Registry+import           Data.Registry.Hedgehog+import           Data.Registry.Hedgehog.TH+import           Hedgehog                hiding (test)+import           Protolude+import           Test.Tasty.Hedgehogx+import           Test.Tutorial.DataModel+import           Test.Tutorial.Exercise2 (registry)++registry3 :: Registry _ _+registry3 = $(makeGenerators ''EmployeeStatus) <: registry++forall :: forall a . (Typeable a, Show a) => PropertyT IO a+forall = forAllT $ genWith @a registry3++test_employee_status = prop "make an employee status" $ do+  status <- forall @EmployeeStatus+  collect status

@@ -0,0 +1,29 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}++module Test.Tutorial.Exercise4 where++import           Data.Registry+import           Data.Registry.Hedgehog+import           Data.Text                as T+import           Hedgehog                 hiding (test)+import           Protolude+import           Test.Tasty.Hedgehogx+import           Test.Tutorial.DataModel+import           Test.Tutorial.Exercise2 (genText)+import           Test.Tutorial.Exercise3 (registry3)++registry12 :: Registry _ _+registry12 = specializeGen @Department genDepartmentName $ registry3++genDepartmentName :: Gen Text+genDepartmentName = T.take 5 . T.toUpper <$> genText++forall :: forall a . (Typeable a, Show a) => PropertyT IO a+forall = forAllT $ genWith @a registry12++test_deparment_name = prop "make a department" $ do+  department <- forall @Department+  collect (departmentName department)

@@ -0,0 +1,35 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}++module Test.Tutorial.Exercise5 where++import           Data.Registry+import           Data.Text as T+import           Data.Registry.Hedgehog+import           Hedgehog                 hiding (test)+import           Protolude+import           Test.Tasty.Hedgehogx+import           Test.Tutorial.DataModel+import           Test.Tutorial.Exercise2 (genText)+import           Test.Tutorial.Exercise3 (registry3)+import           Test.Tutorial.Exercise4 (genDepartmentName)++runGens = runS registry3++genEmployeeName :: Gen Text+genEmployeeName = T.take 10 . T.toLower <$> genText++setDepartmentName = specializeGenS @Department genDepartmentName+setEmployeeName   = specializeGenS @Employee genEmployeeName++setOneDepartment = addFunS $ listOfMinMax @Department 1 1+setOneEmployee   = addFunS $ listOfMinMax @Employee 1 1+setSmallCompany = setOneEmployee >> setOneDepartment++test_small_company = prop "make a small company" $ runGens $ do+  setSmallCompany+  setEmployeeName+  setDepartmentName+  collect =<< forallS @Company

@@ -0,0 +1,27 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}++module Test.Tutorial.Exercise6 where++import           Data.Registry.Hedgehog+import           Data.Text                 as T+import           Hedgehog                  hiding (test)+import           Protolude+import           Test.Tasty.Hedgehogx+import           Test.Tutorial.DataModel+import           Test.Tutorial.Exercise5++test_another_small_company = prop "make a small company" $ runGens $ do+  setSmallCompany+  setEmployeeName+  setDepartmentName+  setGenS @Int (pure 1)+  setDistinctForS @Department @Text++  collect =<< forallS @Company++  setCycleChooserS @EmployeeStatus+  collect =<< forallS @EmployeeStatus