mirror of
https://github.com/nick8325/quickspec.git
synced 2024-10-27 00:59:15 +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
|
/dist
|
||||||
examples/*
|
examples/*
|
||||||
!examples/*.hs
|
!examples/*.hs
|
||||||
|
cabal.sandbox.config
|
||||||
|
.cabal-sandbox/
|
||||||
|
@ -1,8 +1,10 @@
|
|||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Test.QuickCheck
|
import Test.QuickCheck
|
||||||
import QuickSpec
|
import QuickSpec
|
||||||
import Data.Dynamic
|
import Data.Dynamic
|
||||||
|
|
||||||
|
|
||||||
sig =
|
sig =
|
||||||
signature {
|
signature {
|
||||||
maxTermSize = Just 8,
|
maxTermSize = Just 8,
|
||||||
@ -15,7 +17,7 @@ sig =
|
|||||||
constant "length" (length :: [A] -> Int),
|
constant "length" (length :: [A] -> Int),
|
||||||
constant "reverse" (reverse :: [A] -> [A])
|
constant "reverse" (reverse :: [A] -> [A])
|
||||||
],
|
],
|
||||||
predicates = [predicate "notNull" ((not . null) :: [Int] -> Bool),
|
predicates = [predicateGen "notNull" ((not . null) :: [Int] -> Bool) notNullGen,
|
||||||
predicateGen "eqLen"
|
predicateGen "eqLen"
|
||||||
((\xs ys -> length xs == length ys) :: [Int] -> [Int] -> Bool) eqLenGen]
|
((\xs ys -> length xs == length ys) :: [Int] -> [Int] -> Bool) eqLenGen]
|
||||||
}
|
}
|
||||||
@ -27,4 +29,10 @@ eqLenGen = do
|
|||||||
xs2 <- (replicateM len arbitrary :: Gen [Int])
|
xs2 <- (replicateM len arbitrary :: Gen [Int])
|
||||||
return [toDyn xs1, toDyn xs2]
|
return [toDyn xs1, toDyn xs2]
|
||||||
|
|
||||||
|
notNullGen :: Gen [Dynamic]
|
||||||
|
notNullGen = do
|
||||||
|
x <- arbitrary @Int
|
||||||
|
xs <- arbitrary
|
||||||
|
return [toDyn (x:xs)]
|
||||||
|
|
||||||
main = quickSpec sig
|
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
|
-- here is where we could do the lazy predicate stuff for an instance
|
||||||
toPredicates predicate = do
|
toPredicates predicate = do
|
||||||
a <- arbitrary
|
a <- arbitrary
|
||||||
dyns <- toPredicates (predicate a)
|
dyns <- toPredicates (predicate a)
|
||||||
return $ fmap ((toDyn a):) dyns
|
return $ fmap ((toDyn a):) dyns
|
||||||
|
|
||||||
|
@ -75,7 +75,7 @@ event :: (Ord e, Monad m) => RuleT e m e
|
|||||||
event = RuleT onMatch
|
event = RuleT onMatch
|
||||||
|
|
||||||
require :: Monad m => Bool -> RuleT e m ()
|
require :: Monad m => Bool -> RuleT e m ()
|
||||||
require True = return ()
|
require True = return ()
|
||||||
require False = fail ""
|
require False = fail ""
|
||||||
|
|
||||||
execute :: Monad m => RulesT e m a -> RuleT e m a
|
execute :: Monad m => RulesT e m a -> RuleT e m a
|
||||||
|
@ -16,7 +16,12 @@ import Control.Monad
|
|||||||
import Data.Functor.Identity
|
import Data.Functor.Identity
|
||||||
import Twee.Base
|
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
|
makeTester toTerm vals tests sig ty = do
|
||||||
i <- listToMaybe (findInstanceOf sig (defaultTypes sig ty))
|
i <- listToMaybe (findInstanceOf sig (defaultTypes sig ty))
|
||||||
case unwrap (i :: Value Observe1) of
|
case unwrap (i :: Value Observe1) of
|
||||||
@ -26,7 +31,14 @@ makeTester toTerm vals tests sig ty = do
|
|||||||
return . wrap w' $
|
return . wrap w' $
|
||||||
emptyTypedTestSet (tester sig toTerm vals tests (eval . runIdentity . reunwrap w . defaultTypes sig))
|
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 =
|
tester sig toTerm vals tests eval t =
|
||||||
Just [ unGen (eval (evaluateTm (defaultTypes sig) val (toTerm t))) g n | (val, (g, n)) <- zip vals tests ]
|
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