summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichalGajda <>2020-10-17 17:58:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-10-17 17:58:00 (GMT)
commitd73f1d795f8688d21d48a2059af22c31b0a08e46 (patch)
treee6b88bee7a189f535eef5c3e5cc8c5b039f6a463
version 0.1.0.00.1.0.0
-rw-r--r--CHANGELOG.md5
-rw-r--r--LICENSE32
-rw-r--r--README.md10
-rw-r--r--Setup.hs2
-rw-r--r--less-arbitrary.cabal101
-rw-r--r--src/Test/LessArbitrary.hs350
-rw-r--r--test/Test/Arbitrary.hs41
-rw-r--r--test/less/LessArbitrary.hs69
8 files changed, 610 insertions, 0 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..318a83f
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for less-arbitrary
+
+0.1.0.0 -- 20200-10-17
+
+* First version of less-arbitrary on Hackage.
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..30686c6
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,32 @@
+Copyright (c) 2020, Michal J. Gajda
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Michal J. Gajda nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+Note: this license does not apply to Spring and ACM template files
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..dc14ad1
--- /dev/null
+++ b/README.md
@@ -0,0 +1,10 @@
+To build this you need:
+* pandoc
+* xelatex with standard science article packages
+ - easiest to get as MacTeX on Mac
+ - `apt-get install -y texlive-recommended` on Ubuntu
+* markdown-unlit
+* pandoc-hide-codeblocks
+* enTangleD for code generation (if you want to edit `.md` source file)
+
+To read more, look into `less-arbitrary.md` which is literate source file.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/less-arbitrary.cabal b/less-arbitrary.cabal
new file mode 100644
index 0000000..50dc69f
--- /dev/null
+++ b/less-arbitrary.cabal
@@ -0,0 +1,101 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.33.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: c900031eb7b423dc49cd1e66dd3e62ca0955e19cca79a555beda12a781ba8615
+
+name: less-arbitrary
+version: 0.1.0.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?
+ .
+ Never let it bother you again:
+ this variant of Arbitrary is automatically generating instances, and allows you to see predictable linear time generators
+ for most types (providing that you have any terminating constructor, that is constructor that does not go deeper into the data structure.)
+ .
+ Usage:
+ ```
+ import Test.LessArbitrary
+ .
+ data MyDataType = ...
+ deriving (Show, Generic)
+ .
+ instance LessArbitrary MyDataType
+ instance Arbitrary where
+ arbitrary = lessArbitrary
+ ```
+category: Web
+author: Michał J. Gajda <mjgajda@migamake.com>
+maintainer: Michał J. Gajda <mjgajda@migamake.com>
+license: BSD3
+license-file: LICENSE
+build-type: Simple
+extra-source-files:
+ CHANGELOG.md
+ README.md
+
+library
+ exposed-modules:
+ Test.LessArbitrary
+ other-modules:
+ Paths_less_arbitrary
+ hs-source-dirs:
+ src
+ build-depends:
+ QuickCheck
+ , base >=4.5 && <=4.15
+ , containers
+ , email-validate
+ , generic-arbitrary
+ , genvalidity
+ , genvalidity-hspec
+ , genvalidity-property
+ , hashable
+ , hspec
+ , mtl
+ , random
+ , scientific
+ , text
+ , time
+ , transformers
+ , unordered-containers
+ , validity
+ , vector
+ default-language: Haskell2010
+
+test-suite less-arbitrary
+ type: exitcode-stdio-1.0
+ main-is: LessArbitrary.hs
+ other-modules:
+ Test.Arbitrary
+ Paths_less_arbitrary
+ hs-source-dirs:
+ test/less/
+ test
+ build-depends:
+ QuickCheck
+ , base >=4.5 && <=4.15
+ , containers
+ , email-validate
+ , generic-arbitrary
+ , genvalidity
+ , genvalidity-hspec
+ , genvalidity-property
+ , hashable
+ , hspec
+ , less-arbitrary
+ , mtl
+ , quickcheck-classes
+ , quickcheck-instances
+ , random
+ , scientific
+ , text
+ , time
+ , transformers
+ , unordered-containers
+ , validity
+ , vector
+ default-language: Haskell2010
diff --git a/src/Test/LessArbitrary.hs b/src/Test/LessArbitrary.hs
new file mode 100644
index 0000000..54033c3
--- /dev/null
+++ b/src/Test/LessArbitrary.hs
@@ -0,0 +1,350 @@
+-- ~\~ language=Haskell filename=src/Test/LessArbitrary.hs
+-- ~\~ begin <<less-arbitrary.md|src/Test/LessArbitrary.hs>>[0]
+{-# language DefaultSignatures #-}
+{-# language FlexibleInstances #-}
+{-# language FlexibleContexts #-}
+{-# language GeneralizedNewtypeDeriving #-}
+{-# language Rank2Types #-}
+{-# language PolyKinds #-}
+{-# language MultiParamTypeClasses #-}
+{-# language MultiWayIf #-}
+{-# language ScopedTypeVariables #-}
+{-# language TypeApplications #-}
+{-# language TypeOperators #-}
+{-# language TypeFamilies #-}
+{-# language UndecidableInstances #-}
+{-# language AllowAmbiguousTypes #-}
+{-# language DataKinds #-}
+module Test.LessArbitrary(
+ LessArbitrary(..)
+ , oneof
+ , choose
+ , CostGen(..)
+ , (<$$$>)
+ , ($$$?)
+ , currentBudget
+ , fasterArbitrary
+ , genericLessArbitrary
+ , genericLessArbitraryMonoid
+ , flatLessArbitrary
+ , spend
+ , withCost
+ , elements
+ , forAll
+ , sizedCost
+ ) where
+
+import qualified Data.HashMap.Strict as Map
+import qualified Data.Set as Set
+import qualified Data.Vector as Vector
+import qualified Data.Text as Text
+import Control.Monad(replicateM)
+import Data.Scientific
+import Data.Proxy
+import qualified Test.QuickCheck.Gen as QC
+import qualified Control.Monad.State.Strict as State
+import Control.Monad.Trans.Class
+import System.Random(Random)
+import GHC.Generics as G
+import GHC.Generics as Generic
+import GHC.TypeLits
+import qualified Test.QuickCheck as QC
+import Data.Hashable
+
+-- ~\~ begin <<less-arbitrary.md|costgen>>[0]
+newtype Cost = Cost Int
+ deriving (Eq,Ord,Enum,Bounded,Num)
+
+newtype CostGen a =
+ CostGen {
+ runCostGen :: State.StateT Cost QC.Gen a }
+ deriving (Functor, Applicative, Monad, State.MonadFix)
+-- ~\~ end
+
+-- Mark a costly constructor with this instead of `<$>`
+(<$$$>) :: (a -> b) -> CostGen a -> CostGen b
+costlyConstructor <$$$> arg = do
+ spend 1
+ costlyConstructor <$> arg
+
+-- ~\~ begin <<less-arbitrary.md|spend>>[0]
+spend :: Cost -> CostGen ()
+spend c = CostGen $ State.modify (-c+)
+-- ~\~ end
+
+-- ~\~ begin <<less-arbitrary.md|budget>>[0]
+($$$?) :: CostGen a
+ -> CostGen a
+ -> CostGen a
+cheapVariants $$$? costlyVariants = do
+ budget <- CostGen State.get
+ if | budget > (0 :: Cost) -> costlyVariants
+ | budget > -10000 -> cheapVariants
+ | otherwise -> error $
+ "Recursive structure with no loop breaker."
+
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|budget>>[1]
+currentBudget :: CostGen Cost
+currentBudget = CostGen State.get
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|budget>>[2]
+-- unused: loop breaker message type name
+type family ShowType k where
+ ShowType (D1 ('MetaData name _ _ _) _) = name
+ ShowType other = "unknown type"
+
+showType :: forall a.
+ (Generic a
+ ,KnownSymbol (ShowType (Rep a)))
+ => String
+showType = symbolVal (Proxy :: Proxy (ShowType (Rep a)))
+-- ~\~ end
+
+
+withCost :: Int -> CostGen a -> QC.Gen a
+withCost cost gen = runCostGen gen
+ `State.evalStateT` Cost cost
+
+-- ~\~ begin <<less-arbitrary.md|generic-instances>>[0]
+type family Min m n where
+ Min m n = ChooseSmaller (CmpNat m n) m n
+
+type family ChooseSmaller (o::Ordering)
+ (m::Nat)
+ (n::Nat) where
+ ChooseSmaller 'LT m n = m
+ ChooseSmaller 'EQ m n = m
+ ChooseSmaller 'GT m n = n
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|generic-instances>>[1]
+type family Cheapness a :: Nat where
+ Cheapness (a :*: b) =
+ Cheapness a + Cheapness b
+ Cheapness (a :+: b) =
+ Min (Cheapness a) (Cheapness b)
+ Cheapness U1 = 0
+ -- ~\~ begin <<less-arbitrary.md|flat-types>>[0]
+ Cheapness (S1 a (Rec0 Int )) = 0
+ Cheapness (S1 a (Rec0 Scientific)) = 0
+ Cheapness (S1 a (Rec0 Double )) = 0
+ Cheapness (S1 a (Rec0 Bool )) = 0
+ Cheapness (S1 a (Rec0 Text.Text )) = 1
+ Cheapness (S1 a (Rec0 other )) = 1
+ -- ~\~ end
+ Cheapness (K1 a other) = 1
+ Cheapness (C1 a other) = 1
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|generic-instances>>[2]
+instance GLessArbitrary f
+ => GLessArbitrary (G.C1 c f) where
+ gLessArbitrary = G.M1 <$> gLessArbitrary
+ cheapest = G.M1 <$> cheapest
+
+instance GLessArbitrary f
+ => GLessArbitrary (G.S1 c f) where
+ gLessArbitrary = G.M1 <$> gLessArbitrary
+ cheapest = G.M1 <$> cheapest
+-- ~\~ end
+
+-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[0]
+genericLessArbitraryMonoid :: (Generic a
+ ,GLessArbitrary (Rep a)
+ ,Monoid a )
+ => CostGen a
+genericLessArbitraryMonoid =
+ pure mempty $$$? genericLessArbitrary
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[1]
+class GLessArbitrary datatype where
+ gLessArbitrary :: CostGen (datatype p)
+ cheapest :: CostGen (datatype p)
+
+genericLessArbitrary :: (Generic a
+ ,GLessArbitrary (Rep a))
+ => CostGen a
+genericLessArbitrary = G.to <$> gLessArbitrary
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[2]
+instance GLessArbitrary f
+ => GLessArbitrary (D1 m f) where
+ gLessArbitrary = do
+ spend 1
+ M1 <$> (cheapest $$$? gLessArbitrary)
+ cheapest = M1 <$> cheapest
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[3]
+type family SumLen a :: Nat where
+ SumLen (a G.:+: b) = SumLen a + SumLen b
+ SumLen a = 1
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[4]
+instance GLessArbitrary G.U1 where
+ gLessArbitrary = pure G.U1
+ cheapest = pure G.U1
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[5]
+instance (GLessArbitrary a
+ ,GLessArbitrary b)
+ => GLessArbitrary (a G.:*: b) where
+ gLessArbitrary = (G.:*:) <$> gLessArbitrary
+ <*> gLessArbitrary
+ cheapest = (G.:*:) <$> cheapest
+ <*> cheapest
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[6]
+instance LessArbitrary c
+ => GLessArbitrary (G.K1 i c) where
+ gLessArbitrary = G.K1 <$> lessArbitrary
+ cheapest = G.K1 <$> lessArbitrary
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|generic-less-arbitrary>>[7]
+instance (GLessArbitrary a
+ ,GLessArbitrary b
+ ,KnownNat (SumLen a)
+ ,KnownNat (SumLen b)
+ ,KnownNat (Cheapness a)
+ ,KnownNat (Cheapness b)
+ )
+ => GLessArbitrary (a Generic.:+: b) where
+ gLessArbitrary =
+ frequency
+ [ (lfreq, L1 <$> gLessArbitrary)
+ , (rfreq, R1 <$> gLessArbitrary) ]
+ where
+ lfreq = fromIntegral
+ $ natVal (Proxy :: Proxy (SumLen a))
+ rfreq = fromIntegral
+ $ natVal (Proxy :: Proxy (SumLen b))
+ cheapest =
+ if lcheap <= rcheap
+ then L1 <$> cheapest
+ else R1 <$> cheapest
+ where
+ lcheap, rcheap :: Int
+ lcheap = fromIntegral
+ $ natVal (Proxy :: Proxy (Cheapness a))
+ rcheap = fromIntegral
+ $ natVal (Proxy :: Proxy (Cheapness b))
+-- ~\~ end
+
+-- ~\~ begin <<less-arbitrary.md|less-arbitrary-class>>[0]
+class LessArbitrary a where
+ lessArbitrary :: CostGen a
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|less-arbitrary-class>>[1]
+ default lessArbitrary :: (Generic a
+ ,GLessArbitrary (Rep a))
+ => CostGen a
+ lessArbitrary = genericLessArbitrary
+-- ~\~ end
+
+instance LessArbitrary Bool where
+ lessArbitrary = flatLessArbitrary
+
+instance LessArbitrary Int where
+ lessArbitrary = flatLessArbitrary
+
+instance LessArbitrary Integer where
+ lessArbitrary = flatLessArbitrary
+
+instance LessArbitrary Double where
+ lessArbitrary = flatLessArbitrary
+
+instance LessArbitrary Char where
+ lessArbitrary = flatLessArbitrary
+
+instance (LessArbitrary k
+ ,LessArbitrary v)
+ => LessArbitrary (k,v) where
+
+instance (LessArbitrary k
+ ,Ord k)
+ => LessArbitrary (Set.Set k) where
+ lessArbitrary = Set.fromList <$> lessArbitrary
+
+instance (LessArbitrary k
+ ,Eq k
+ ,Ord k
+ ,Hashable k
+ ,LessArbitrary v)
+ => LessArbitrary (Map.HashMap k v) where
+ lessArbitrary = Map.fromList
+ <$> lessArbitrary
+
+instance LessArbitrary Scientific where
+ lessArbitrary =
+ scientific <$> lessArbitrary
+ <*> lessArbitrary
+
+-- ~\~ begin <<less-arbitrary.md|arbitrary-implementation>>[0]
+fasterArbitrary :: LessArbitrary a => QC.Gen a
+fasterArbitrary = sizedCost lessArbitrary
+
+sizedCost :: CostGen a -> QC.Gen a
+sizedCost gen = QC.sized (`withCost` gen)
+-- ~\~ end
+
+flatLessArbitrary :: QC.Arbitrary a
+ => CostGen a
+flatLessArbitrary = CostGen $ lift QC.arbitrary
+
+instance LessArbitrary a
+ => LessArbitrary (Vector.Vector a) where
+ lessArbitrary = Vector.fromList <$> lessArbitrary
+
+-- ~\~ begin <<less-arbitrary.md|lifting-arbitrary>>[0]
+instance LessArbitrary a
+ => LessArbitrary [a] where
+ lessArbitrary = pure [] $$$? do
+ budget <- currentBudget
+ len <- choose (1,fromEnum budget)
+ spend $ Cost len
+ replicateM len lessArbitrary
+
+instance QC.Testable a
+ => QC.Testable (CostGen a) where
+ property = QC.property
+ . sizedCost
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|lifting-arbitrary>>[1]
+forAll :: CostGen a -> (a -> CostGen b) -> CostGen b
+forAll gen prop = gen >>= prop
+
+oneof :: [CostGen a] -> CostGen a
+oneof [] = error
+ "LessArbitrary.oneof used with empty list"
+oneof gs = choose (0,length gs - 1) >>= (gs !!)
+
+elements :: [a] -> CostGen a
+elements gs = (gs!!) <$> choose (0,length gs - 1)
+
+choose :: Random a
+ => (a, a)
+ -> CostGen a
+choose (a,b) = CostGen $ lift $ QC.choose (a, b)
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|lifting-arbitrary>>[2]
+frequency :: [(Int, CostGen a)] -> CostGen a
+frequency [] =
+ error $ "LessArbitrary.frequency "
+ ++ "used with empty list"
+frequency xs
+ | any (< 0) (map fst xs) =
+ error $ "LessArbitrary.frequency: "
+ ++ "negative weight"
+ | all (== 0) (map fst xs) =
+ error $ "LessArbitrary.frequency: "
+ ++ "all weights were zero"
+frequency xs0 = choose (1, tot) >>= (`pick` xs0)
+ where
+ tot = sum (map fst xs0)
+
+ pick n ((k,x):xs)
+ | n <= k = x
+ | otherwise = pick (n-k) xs
+ pick _ _ = error
+ "LessArbitrary.pick used with empty list"
+-- ~\~ end
+
+-- ~\~ end
diff --git a/test/Test/Arbitrary.hs b/test/Test/Arbitrary.hs
new file mode 100644
index 0000000..993dcad
--- /dev/null
+++ b/test/Test/Arbitrary.hs
@@ -0,0 +1,41 @@
+-- ~\~ language=Haskell filename=test/Test/Arbitrary.hs
+-- ~\~ begin <<less-arbitrary.md|test/Test/Arbitrary.hs>>[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 <<less-arbitrary.md|arbitrary-laws>>[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
new file mode 100644
index 0000000..66e5fb1
--- /dev/null
+++ b/test/less/LessArbitrary.hs
@@ -0,0 +1,69 @@
+-- ~\~ language=Haskell filename=test/less/LessArbitrary.hs
+-- ~\~ begin <<less-arbitrary.md|test/less/LessArbitrary.hs>>[0]
+-- ~\~ begin <<less-arbitrary.md|test-file-header>>[0]
+{-# language FlexibleInstances #-}
+{-# language Rank2Types #-}
+{-# language MultiParamTypeClasses #-}
+{-# language ScopedTypeVariables #-}
+{-# language TypeOperators #-}
+{-# language UndecidableInstances #-}
+{-# language AllowAmbiguousTypes #-}
+{-# language DeriveGeneric #-}
+module Main where
+
+import Data.Proxy
+import Test.QuickCheck
+import qualified GHC.Generics as Generic
+import Test.QuickCheck.Classes
+
+import Test.LessArbitrary
+import Test.Arbitrary
+
+-- ~\~ begin <<less-arbitrary.md|tree-type>>[0]
+data Tree a =
+ Leaf a
+ | Branch [Tree a]
+ deriving (Eq,Show,Generic.Generic)
+-- ~\~ end
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|test-less-arbitrary-version>>[0]
+instance LessArbitrary a
+ => LessArbitrary (Tree a) where
+
+instance LessArbitrary a
+ => Arbitrary (Tree a) where
+ arbitrary = fasterArbitrary
+-- ~\~ end
+
+-- ~\~ begin <<less-arbitrary.md|test-file-laws>>[0]
+
+main :: IO ()
+main = do
+ lawsCheckMany
+ [("Tree",
+ [arbitraryLaws (Proxy :: Proxy (Tree Int))
+ ,eqLaws (Proxy :: Proxy (Tree Int))
+ ] <> otherLaws)]
+-- ~\~ end
+-- ~\~ begin <<less-arbitrary.md|less-arbitrary-check>>[0]
+otherLaws :: [Laws]
+otherLaws = [lessArbitraryLaws isLeaf]
+ where
+ 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