mirror of
https://github.com/nick8325/quickspec.git
synced 2024-10-26 16:50:54 +03:00
Prettying everything up a little bit
This commit is contained in:
parent
ebfec93555
commit
32fb0b3c37
2
.gitignore
vendored
2
.gitignore
vendored
@ -2,3 +2,5 @@
|
||||
/dist
|
||||
examples/*
|
||||
!examples/*.hs
|
||||
cabal.sandbox.config
|
||||
.cabal-sandbox/
|
||||
|
@ -1,8 +1,10 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
import Control.Monad
|
||||
import Test.QuickCheck
|
||||
import QuickSpec
|
||||
import Data.Dynamic
|
||||
|
||||
|
||||
sig =
|
||||
signature {
|
||||
maxTermSize = Just 8,
|
||||
@ -15,7 +17,7 @@ sig =
|
||||
constant "length" (length :: [A] -> Int),
|
||||
constant "reverse" (reverse :: [A] -> [A])
|
||||
],
|
||||
predicates = [predicate "notNull" ((not . null) :: [Int] -> Bool),
|
||||
predicates = [predicateGen "notNull" ((not . null) :: [Int] -> Bool) notNullGen,
|
||||
predicateGen "eqLen"
|
||||
((\xs ys -> length xs == length ys) :: [Int] -> [Int] -> Bool) eqLenGen]
|
||||
}
|
||||
@ -27,4 +29,10 @@ eqLenGen = do
|
||||
xs2 <- (replicateM len arbitrary :: Gen [Int])
|
||||
return [toDyn xs1, toDyn xs2]
|
||||
|
||||
notNullGen :: Gen [Dynamic]
|
||||
notNullGen = do
|
||||
x <- arbitrary @Int
|
||||
xs <- arbitrary
|
||||
return [toDyn (x:xs)]
|
||||
|
||||
main = quickSpec sig
|
||||
|
@ -28,7 +28,7 @@ instance (Predicateable b, Typeable a, Arbitrary a) => Predicateable (a -> b) wh
|
||||
|
||||
-- here is where we could do the lazy predicate stuff for an instance
|
||||
toPredicates predicate = do
|
||||
a <- arbitrary
|
||||
a <- arbitrary
|
||||
dyns <- toPredicates (predicate a)
|
||||
return $ fmap ((toDyn a):) dyns
|
||||
|
||||
|
@ -75,7 +75,7 @@ event :: (Ord e, Monad m) => RuleT e m e
|
||||
event = RuleT onMatch
|
||||
|
||||
require :: Monad m => Bool -> RuleT e m ()
|
||||
require True = return ()
|
||||
require True = return ()
|
||||
require False = fail ""
|
||||
|
||||
execute :: Monad m => RulesT e m a -> RuleT e m a
|
||||
|
@ -16,7 +16,12 @@ import Control.Monad
|
||||
import Data.Functor.Identity
|
||||
import Twee.Base
|
||||
|
||||
makeTester :: (a -> Term Constant) -> [Type -> Var -> Value Identity] -> [(QCGen, Int)] -> Signature -> Type -> Maybe (Value (TypedTestSet a))
|
||||
makeTester :: (a -> Term Constant)
|
||||
-> [Type -> Var -> Value Identity]
|
||||
-> [(QCGen, Int)]
|
||||
-> Signature
|
||||
-> Type
|
||||
-> Maybe (Value (TypedTestSet a))
|
||||
makeTester toTerm vals tests sig ty = do
|
||||
i <- listToMaybe (findInstanceOf sig (defaultTypes sig ty))
|
||||
case unwrap (i :: Value Observe1) of
|
||||
@ -26,7 +31,14 @@ makeTester toTerm vals tests sig ty = do
|
||||
return . wrap w' $
|
||||
emptyTypedTestSet (tester sig toTerm vals tests (eval . runIdentity . reunwrap w . defaultTypes sig))
|
||||
|
||||
tester :: Ord b => Signature -> (a -> Term Constant) -> [Type -> Var -> Value Identity] -> [(QCGen, Int)] -> (Value Identity -> Gen b) -> a -> Maybe [b]
|
||||
tester :: Ord b
|
||||
=> Signature
|
||||
-> (a -> Term Constant)
|
||||
-> [Type -> Var -> Value Identity]
|
||||
-> [(QCGen, Int)]
|
||||
-> (Value Identity -> Gen b)
|
||||
-> a
|
||||
-> Maybe [b]
|
||||
tester sig toTerm vals tests eval t =
|
||||
Just [ unGen (eval (evaluateTm (defaultTypes sig) val (toTerm t))) g n | (val, (g, n)) <- zip vals tests ]
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user