packages feed

prop-unit 0.1.4 → 1.0.2

raw patch · 6 files changed

Files

prop-unit.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.39.1. -- -- see: https://github.com/sol/hpack  name:           prop-unit-version:        0.1.4+version:        1.0.2 synopsis:       Conveniences for using Hedgehog as a unit test runner description:    Please see the README on GitHub at <https://github.com/ejconlon/prop-unit#readme> category:       Testing@@ -27,6 +27,9 @@ library   exposed-modules:       PropUnit+      PropUnit.Hedgehog+      PropUnit.Hedgehog.Gen+      PropUnit.Hedgehog.Range   other-modules:       Paths_prop_unit   hs-source-dirs:@@ -34,6 +37,7 @@   default-extensions:       BangPatterns       ConstraintKinds+      DataKinds       DeriveAnyClass       DeriveFunctor       DeriveFoldable@@ -60,9 +64,9 @@   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds -fwrite-ide-info -hiedir=.hie   build-depends:       base >=4.12 && <5-    , hedgehog >=1.4 && <1.6+    , hedgehog >=1.4 && <1.8     , tasty >=1.4 && <1.6-    , tasty-hedgehog ==1.4.*+    , tasty-hedgehog >=1.4 && <1.6   default-language: Haskell2010  test-suite prop-unit-test@@ -75,6 +79,7 @@   default-extensions:       BangPatterns       ConstraintKinds+      DataKinds       DeriveAnyClass       DeriveFunctor       DeriveFoldable@@ -101,9 +106,9 @@   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds -fwrite-ide-info -hiedir=.hie -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.12 && <5-    , hedgehog >=1.4 && <1.6+    , containers+    , hedgehog >=1.4 && <1.8     , prop-unit-    , tasty-    , tasty-hedgehog ==1.4.*-    , tasty-hunit+    , tasty >=1.4 && <1.6+    , tasty-hedgehog >=1.4 && <1.6   default-language: Haskell2010
src/PropUnit.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE UndecidableInstances #-}+ module PropUnit   ( DependencyType (..)   , Gen@@ -7,6 +9,7 @@   , Range   , TestLimit   , TestName+  , TestT   , TestTree   , (===)   , (/==)@@ -20,10 +23,25 @@   , testGroup   , testMain   , withResource+  , GenDefault (..)+  , genDefaultTag+  , genDefaultIntegral+  , genDefaultEnum+  , genDefaultList+  , genDefaultString+  , genDefaultGeneric+  , StdTag   ) where +import Control.Applicative ((<|>)) import Control.Monad (when)+import Data.Int (Int16, Int32, Int64, Int8)+import Data.Proxy (Proxy (..))+import Data.Word (Word16, Word32, Word64, Word8)+import GHC.Exts (IsList (..), IsString (..))+import GHC.Generics (Generic (..), K1 (..), M1 (..), U1 (..), (:*:) (..), (:+:) (..))+import GHC.TypeLits (KnownNat, Nat, natVal) import Hedgehog   ( DiscardLimit   , Gen@@ -34,9 +52,11 @@   , ShrinkLimit   , ShrinkRetries   , TestLimit+  , TestT   , assert   , forAll   , property+  , test   , withDiscards   , withRetries   , withShrinks@@ -44,20 +64,23 @@   , (/==)   , (===)   )+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range import System.Environment (lookupEnv, setEnv) import System.IO (BufferMode (..), hSetBuffering, stderr, stdout) import Test.Tasty (DependencyType (..), TestName, TestTree, after, defaultMain, testGroup, withResource) import Test.Tasty.Hedgehog (testProperty) -unitProperty :: PropertyT IO () -> Property+unitProperty :: TestT IO () -> Property unitProperty =   withTests (1 :: TestLimit)     . withDiscards (1 :: DiscardLimit)     . withShrinks (0 :: ShrinkLimit)     . withRetries (0 :: ShrinkRetries)     . property+    . test -testUnit :: TestName -> PropertyT IO () -> TestTree+testUnit :: TestName -> TestT IO () -> TestTree testUnit name = testProperty name . unitProperty  testProp :: TestName -> TestLimit -> PropertyT IO () -> TestTree@@ -82,3 +105,148 @@ testMain f = do   lim <- setupTests   defaultMain (f lim)++class GenDefault tag a where+  -- | Default generator for @a@+  --+  -- The type-level @tag@ allows types @a@ to have multiple defaults.+  genDefault :: Proxy tag -> Gen a++-- | DerivingVia wrapper for types with default instances under other tags+newtype ViaTag tag' a = ViaTag {unViaTag :: a}++instance (GenDefault tag' a) => GenDefault tag (ViaTag tag' a) where+  genDefault _ = fmap ViaTag (genDefault @tag' Proxy)++genDefaultTag :: forall tag a tag'. (GenDefault tag' a) => Proxy tag' -> Proxy tag -> Gen a+genDefaultTag _ _ = fmap (unViaTag @tag' @a) (genDefault (Proxy @tag))++-- | DerivingVia wrapper for Integral types+newtype ViaIntegral a = ViaIntegral {unViaIntegral :: a}++instance (Integral a, Bounded a) => GenDefault tag (ViaIntegral a) where+  genDefault _ = fmap ViaIntegral (Gen.integral (Range.constantFrom 0 minBound maxBound))++genDefaultIntegral :: forall tag a. (Integral a, Bounded a) => Proxy tag -> Gen a+genDefaultIntegral _ = fmap (unViaIntegral @a) (genDefault (Proxy @tag))++-- | DerivingVia wrapper for Enum types+newtype ViaEnum a = ViaEnum {unViaEnum :: a}++instance (Enum a, Bounded a) => GenDefault tag (ViaEnum a) where+  genDefault _ = fmap ViaEnum Gen.enumBounded++genDefaultEnum :: forall tag a. (Enum a, Bounded a) => Proxy tag -> Gen a+genDefaultEnum _ = fmap (unViaEnum @a) (genDefault (Proxy @tag))++-- | DerivingVia wrapper for FromList types+newtype ViaList a (mn :: Nat) (mx :: Nat) = ViaList {unViaList :: a}++instance (IsList a, GenDefault tag (Item a), KnownNat mn, KnownNat mx) => GenDefault tag (ViaList a mn mx) where+  genDefault p =+    let bn = fromInteger (natVal (Proxy @mn))+        bx = fromInteger (natVal (Proxy @mx))+    in  fmap (ViaList . fromList) (Gen.list (Range.constant bn bx) (genDefault p))++genDefaultList+  :: forall tag a mn mx+   . (IsList a, KnownNat mn, KnownNat mx, GenDefault tag (Item a))+  => Proxy mn+  -> Proxy mx+  -> Proxy tag+  -> Gen a+genDefaultList _ _ _ = fmap (unViaList @a @mn @mx) (genDefault (Proxy @tag))++-- | DerivingVia wrapper for FromString types+newtype ViaString s (mn :: Nat) (mx :: Nat) = ViaString {unViaString :: s}++instance (IsString s, GenDefault tag Char, KnownNat mn, KnownNat mx) => GenDefault tag (ViaString s mn mx) where+  genDefault p =+    let bn = fromInteger (natVal (Proxy @mn))+        bx = fromInteger (natVal (Proxy @mx))+    in  fmap (ViaString . fromString) (Gen.list (Range.constant bn bx) (genDefault p))++genDefaultString+  :: forall tag a mn mx+   . (IsString a, KnownNat mn, KnownNat mx, GenDefault tag Char)+  => Proxy mn+  -> Proxy mx+  -> Proxy tag+  -> Gen a+genDefaultString _ _ _ = fmap (unViaString @a @mn @mx) (genDefault (Proxy @tag))++class GGenDefault tag f where+  ggenDefault :: Proxy tag -> Gen (f a)++instance GGenDefault tag U1 where+  ggenDefault _ = pure U1++instance (GGenDefault tag a) => GGenDefault tag (M1 i c a) where+  ggenDefault = fmap M1 . ggenDefault++instance (GGenDefault tag a, GGenDefault tag b) => GGenDefault tag (a :*: b) where+  ggenDefault p = liftA2 (:*:) (ggenDefault p) (ggenDefault p)++instance (GGenDefault tag a, GGenDefault tag b) => GGenDefault tag (a :+: b) where+  ggenDefault p = fmap L1 (ggenDefault p) <|> fmap R1 (ggenDefault p)++instance (GenDefault tag a) => GGenDefault tag (K1 i a) where+  ggenDefault = fmap K1 . genDefault++-- | DerivingVia wrapper for Generic types+newtype ViaGeneric tag a = ViaGeneric {unViaGeneric :: a}++instance (Generic a, GGenDefault tag (Rep a)) => GenDefault tag (ViaGeneric tag a) where+  genDefault = fmap (ViaGeneric . to) . ggenDefault++genDefaultGeneric :: forall tag a. (Generic a, GGenDefault tag (Rep a)) => Proxy tag -> Gen a+genDefaultGeneric _ = fmap (unViaGeneric @tag @a) (genDefault (Proxy @tag))++-- | Type tag for these "standard" default generators.+-- You can use this tag directly or choose type-by-type with 'genDefaultTag'.+data StdTag++instance GenDefault StdTag () where genDefault = genDefaultEnum++instance GenDefault StdTag Bool where genDefault = genDefaultEnum++instance GenDefault StdTag Char where genDefault = genDefaultEnum++instance GenDefault StdTag Int where genDefault = genDefaultIntegral++instance GenDefault StdTag Int8 where genDefault = genDefaultIntegral++instance GenDefault StdTag Int16 where genDefault = genDefaultIntegral++instance GenDefault StdTag Int32 where genDefault = genDefaultIntegral++instance GenDefault StdTag Int64 where genDefault = genDefaultIntegral++instance GenDefault StdTag Word where genDefault = genDefaultIntegral++instance GenDefault StdTag Word8 where genDefault = genDefaultIntegral++instance GenDefault StdTag Word16 where genDefault = genDefaultIntegral++instance GenDefault StdTag Word32 where genDefault = genDefaultIntegral++instance GenDefault StdTag Word64 where genDefault = genDefaultIntegral++instance (GenDefault StdTag a) => GenDefault StdTag (Maybe a) where genDefault = genDefaultGeneric++instance (GenDefault StdTag a, GenDefault StdTag b) => GenDefault StdTag (Either a b) where+  genDefault = genDefaultGeneric++instance (GenDefault StdTag a, GenDefault StdTag b) => GenDefault StdTag (a, b) where genDefault = genDefaultGeneric++instance (GenDefault StdTag a, GenDefault StdTag b, GenDefault StdTag c) => GenDefault StdTag (a, b, c) where+  genDefault = genDefaultGeneric++instance (GenDefault StdTag a, GenDefault StdTag b, GenDefault StdTag c, GenDefault StdTag d) => GenDefault StdTag (a, b, c, d) where+  genDefault = genDefaultGeneric++instance+  (GenDefault StdTag a, GenDefault StdTag b, GenDefault StdTag c, GenDefault StdTag d, GenDefault StdTag e)+  => GenDefault StdTag (a, b, c, d, e)+  where+  genDefault = genDefaultGeneric
+ src/PropUnit/Hedgehog.hs view
@@ -0,0 +1,7 @@+-- | Full re-export of Hedgehog+module PropUnit.Hedgehog+  ( module Hedgehog+  )+where++import Hedgehog
+ src/PropUnit/Hedgehog/Gen.hs view
@@ -0,0 +1,7 @@+-- | Full re-export of Hedgehog.Gen+module PropUnit.Hedgehog.Gen+  ( module Hedgehog.Gen+  )+where++import Hedgehog.Gen
+ src/PropUnit/Hedgehog/Range.hs view
@@ -0,0 +1,7 @@+-- | Full re-export of Hedgehog.Range+module PropUnit.Hedgehog.Range+  ( module Hedgehog.Range+  )+where++import Hedgehog.Range
test/Main.hs view
@@ -1,8 +1,34 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE UndecidableInstances #-}+ module Main (main) where -import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range-import PropUnit (TestLimit, TestTree, forAll, testGroup, testMain, testProp, testUnit, (===))+import Control.Monad (replicateM)+import Data.Proxy (Proxy (..))+import qualified Data.Set as Set+import GHC.Exts (IsList, IsString)+import GHC.Generics (Generic)+import PropUnit+  ( GenDefault (..)+  , StdTag+  , TestLimit+  , TestTree+  , assert+  , forAll+  , genDefaultEnum+  , genDefaultGeneric+  , genDefaultList+  , genDefaultString+  , genDefaultTag+  , testGroup+  , testMain+  , testProp+  , testUnit+  , (===)+  )+import PropUnit.Hedgehog (Gen)+import qualified PropUnit.Hedgehog.Gen as Gen+import qualified PropUnit.Hedgehog.Range as Range  testAsUnit :: TestTree testAsUnit = testUnit "as unit" $ do@@ -15,10 +41,73 @@   x <- forAll (Gen.int (Range.constant 1 10))   abs x * abs x === x * x +testBasic :: TestLimit -> TestTree+testBasic lim =+  testGroup+    "basic"+    [ testAsUnit+    , testAsProp lim+    ]++data Tag++instance GenDefault Tag Int where genDefault = genDefaultTag (Proxy @StdTag)++instance GenDefault Tag Char where genDefault = genDefaultTag (Proxy @StdTag)++newtype AList a = AList [a]+  deriving newtype (Eq, Ord, Show, IsList)++instance (GenDefault Tag a) => GenDefault Tag (AList a) where genDefault = genDefaultList (Proxy @0) (Proxy @2)++newtype AString = AString String+  deriving newtype (Eq, Ord, Show, IsString)++instance GenDefault Tag AString where genDefault = genDefaultString (Proxy @0) (Proxy @2)++data Choice = ChoiceA | ChoiceB+  deriving stock (Eq, Ord, Show, Enum, Bounded)++instance GenDefault Tag Choice where genDefault = genDefaultEnum++instance (GenDefault Tag a) => GenDefault Tag (Maybe a) where genDefault = genDefaultGeneric++data Record = Record !Int !(Maybe Record)+  deriving stock (Eq, Ord, Show, Generic)++instance GenDefault Tag Record where genDefault = genDefaultGeneric++data GenCase where+  GenCase :: (Ord a) => String -> Gen a -> GenCase++genDefaultByProxy :: (GenDefault Tag a) => Proxy a -> Gen a+genDefaultByProxy _ = genDefault (Proxy @Tag)++mkGenCase :: (Ord a, GenDefault Tag a) => String -> Proxy a -> GenCase+mkGenCase name = GenCase name . genDefaultByProxy++genCases :: [GenCase]+genCases =+  [ mkGenCase "Int" (Proxy @Int)+  , mkGenCase "Char" (Proxy @Char)+  , mkGenCase "Choice" (Proxy @Choice)+  , mkGenCase "AList" (Proxy @(AList Char))+  , mkGenCase "AString" (Proxy @AString)+  , mkGenCase "Record" (Proxy @Record)+  ]++testGenCase :: GenCase -> TestTree+testGenCase (GenCase name gen) = testUnit name $ do+  xs <- fmap Set.fromList (replicateM 10 (Gen.sample gen))+  assert (Set.size xs > 1)++testDerive :: TestTree+testDerive = testGroup "derive" (fmap testGenCase genCases)+ main :: IO () main = testMain $ \lim ->   testGroup     "PropUnit"-    [ testAsUnit-    , testAsProp lim+    [ testBasic lim+    , testDerive     ]