Prettying everything up a little bit

This commit is contained in:
Maximilian Algehed 2017-01-19 14:01:02 +01:00
parent ebfec93555
commit 32fb0b3c37
5 changed files with 27 additions and 5 deletions

2
.gitignore vendored
View File

@ -2,3 +2,5 @@
/dist
examples/*
!examples/*.hs
cabal.sandbox.config
.cabal-sandbox/

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 ]