diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,15 +1,24 @@ # Revision history for less-arbitrary +0.1.5.0 -- 2020-01-12 + +* Exposed Test.Arbitrary.Laws for convenient testing. +* Exposed Test.LessArbitrary.Laws for convenient testing. + 0.1.4.0 -- 2020-12-14 + * Added `HasCallStack` constraint to get better error locations. 0.1.3.0 -- 2020-12-14 + * Added `suchThat`. 0.1.2.0 -- 2020-12-13 + * Exposed `Test.LessArbitrary.Cost` module. 0.1.1.0 -- 2020-12-13 + * Moved `Cost` to `Test.LessArbitrary.Cost` module. 0.1.0.2 -- 2020-10-17 diff --git a/less-arbitrary.cabal b/less-arbitrary.cabal --- a/less-arbitrary.cabal +++ b/less-arbitrary.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 3086e65c4d07897ec67398597f75a2ce6165eb0b5419288640f12e83614b7c02 +-- hash: d5f9e640e9465775e7f4c73f8d224aa9652de30079a62e3933b7658824a22a81 name: less-arbitrary -version: 0.1.4.0 +version: 0.1.5.0 synopsis: Linear time testing with variant of Arbitrary class that always terminates. description: Ever found non-terminating Arbitrary instance? Ever wondered what would be a runtime cost of particular Arbitrary instance? @@ -40,6 +40,8 @@ exposed-modules: Test.LessArbitrary Test.LessArbitrary.Cost + Test.Arbitrary.Laws + Test.LessArbitrary.Laws other-modules: Paths_less_arbitrary hs-source-dirs: @@ -56,6 +58,7 @@ , hashable , hspec , mtl + , quickcheck-classes , random , scientific , text @@ -70,7 +73,6 @@ type: exitcode-stdio-1.0 main-is: LessArbitrary.hs other-modules: - Test.Arbitrary Paths_less_arbitrary hs-source-dirs: test/less/ diff --git a/src/Test/Arbitrary/Laws.hs b/src/Test/Arbitrary/Laws.hs new file mode 100644 --- /dev/null +++ b/src/Test/Arbitrary/Laws.hs @@ -0,0 +1,41 @@ +-- ~\~ language=Haskell filename=src/Test/Arbitrary/Laws.hs +-- ~\~ begin <>[0] +{-# language DataKinds #-} +{-# language FlexibleInstances #-} +{-# language Rank2Types #-} +{-# language MultiParamTypeClasses #-} +{-# language ScopedTypeVariables #-} +{-# language TypeOperators #-} +{-# language UndecidableInstances #-} +{-# language AllowAmbiguousTypes #-} +module Test.Arbitrary.Laws( + arbitraryLaws + ) where + +import Data.Proxy +import Test.QuickCheck +import Test.QuickCheck.Classes +import qualified Data.HashMap.Strict as Map +import Data.HashMap.Strict(HashMap) + +-- ~\~ begin <>[0] +shrinkCheck :: forall term. + (Arbitrary term + ,Eq term) + => term + -> Bool +shrinkCheck term = + term `notElem` shrink term + +arbitraryLaws :: forall ty. + (Arbitrary ty + ,Show ty + ,Eq ty) + => Proxy ty + -> Laws +arbitraryLaws (Proxy :: Proxy ty) = + Laws "arbitrary" + [("does not shrink to itself", + property (shrinkCheck :: ty -> Bool))] +-- ~\~ end +-- ~\~ end diff --git a/src/Test/LessArbitrary/Laws.hs b/src/Test/LessArbitrary/Laws.hs new file mode 100644 --- /dev/null +++ b/src/Test/LessArbitrary/Laws.hs @@ -0,0 +1,36 @@ +-- ~\~ language=Haskell filename=src/Test/LessArbitrary/Laws.hs +-- ~\~ begin <>[0] +{-# language DataKinds #-} +{-# language FlexibleInstances #-} +{-# language Rank2Types #-} +{-# language MultiParamTypeClasses #-} +{-# language ScopedTypeVariables #-} +{-# language TypeOperators #-} +{-# language UndecidableInstances #-} +{-# language AllowAmbiguousTypes #-} +module Test.LessArbitrary.Laws( + lessArbitraryLaws + ) where + +import Data.Proxy +import Test.QuickCheck(Gen, property) +import Test.QuickCheck.Classes(Laws(..)) +import Test.LessArbitrary +import qualified Data.HashMap.Strict as Map +import Data.HashMap.Strict(HashMap) + +-- ~\~ begin <>[0] +lessArbitraryLaws :: LessArbitrary a + => (a -> Bool) -> Laws +lessArbitraryLaws cheapestPred = + Laws "LessArbitrary" + [("always selects cheapest", + property $ + prop_alwaysCheapest cheapestPred)] + +prop_alwaysCheapest :: LessArbitrary a + => (a -> Bool) -> Gen Bool +prop_alwaysCheapest cheapestPred = + cheapestPred <$> withCost 0 lessArbitrary +-- ~\~ end +-- ~\~ end diff --git a/test/Test/Arbitrary.hs b/test/Test/Arbitrary.hs deleted file mode 100644 --- a/test/Test/Arbitrary.hs +++ /dev/null @@ -1,41 +0,0 @@ --- ~\~ language=Haskell filename=test/Test/Arbitrary.hs --- ~\~ begin <>[0] -{-# language DataKinds #-} -{-# language FlexibleInstances #-} -{-# language Rank2Types #-} -{-# language MultiParamTypeClasses #-} -{-# language ScopedTypeVariables #-} -{-# language TypeOperators #-} -{-# language UndecidableInstances #-} -{-# language AllowAmbiguousTypes #-} -module Test.Arbitrary( - arbitraryLaws - ) where - -import Data.Proxy -import Test.QuickCheck -import Test.QuickCheck.Classes -import qualified Data.HashMap.Strict as Map -import Data.HashMap.Strict(HashMap) - --- ~\~ begin <>[0] -shrinkCheck :: forall term. - (Arbitrary term - ,Eq term) - => term - -> Bool -shrinkCheck term = - term `notElem` shrink term - -arbitraryLaws :: forall ty. - (Arbitrary ty - ,Show ty - ,Eq ty) - => Proxy ty - -> Laws -arbitraryLaws (Proxy :: Proxy ty) = - Laws "arbitrary" - [("does not shrink to itself", - property (shrinkCheck :: ty -> Bool))] --- ~\~ end --- ~\~ end diff --git a/test/less/LessArbitrary.hs b/test/less/LessArbitrary.hs --- a/test/less/LessArbitrary.hs +++ b/test/less/LessArbitrary.hs @@ -17,7 +17,8 @@ import Test.QuickCheck.Classes import Test.LessArbitrary -import Test.Arbitrary +import Test.Arbitrary.Laws +import Test.LessArbitrary.Laws -- ~\~ begin <>[0] data Tree a = @@ -52,18 +53,5 @@ isLeaf :: Tree Int -> Bool isLeaf (Leaf _) = True isLeaf (Branch _) = False - -lessArbitraryLaws :: LessArbitrary a - => (a -> Bool) -> Laws -lessArbitraryLaws cheapestPred = - Laws "LessArbitrary" - [("always selects cheapest", - property $ - prop_alwaysCheapest cheapestPred)] - -prop_alwaysCheapest :: LessArbitrary a - => (a -> Bool) -> Gen Bool -prop_alwaysCheapest cheapestPred = - cheapestPred <$> withCost 0 lessArbitrary -- ~\~ end -- ~\~ end