module Test.Speculate.Misc
( functions1
, functions2
, functions3
, functions4
, fillings
, expressionsOf
, valuedExpressionsOf
)
where
import Test.Speculate
import Test.Speculate.Expr
import Test.Speculate.Utils
import Data.Dynamic
import Test.LeanCheck
functions1 :: (Typeable a, Typeable b) => Expr -> [(Expr,a->b)]
functions1 e =
case l undefined of
[] -> []
_ -> fist l
where
l = \x -> [(e',v) | e' <- fillings e [constant "x" x], let Just v = evaluate e']
functions2 :: (Typeable a, Typeable b, Typeable c) => Expr -> [(Expr,a->b->c)]
functions2 e =
case l undefined undefined of
[] -> []
_ -> fist2 l
where
l = \x y -> [(e',v) | e' <- fillings e [constant "x" x, constant "y" y]
, let Just v = evaluate e']
functions3 :: (Typeable a, Typeable b, Typeable c, Typeable d)
=> Expr -> [(Expr,a->b->c->d)]
functions3 e =
case l undefined undefined undefined of
[] -> []
_ -> fist3 l
where
l = \x y z -> [(e',v) | e' <- fillings e [constant "x" x, constant "y" y, constant "z" z]
, let Just v = evaluate e']
functions4 :: (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e)
=> Expr -> [(Expr,a->b->c->d->e)]
functions4 e =
case l undefined undefined undefined undefined of
[] -> []
_ -> fist4 l
where
l = \x y z w -> [(e',v) | e' <- fillings e [constant "x" x, constant "y" y, constant "z" z, constant "w" w]
, let Just v = evaluate e']
fist :: (a->[(z,b)]) -> [(z,a->b)]
fist f = [ (fst $ f' undefined, snd . f')
| i <- [0..(length (f undefined)1)]
, let f' = (!! i) . f ]
fist2 :: (a->b->[(z,c)]) -> [(z,a->b->c)]
fist2 f = map (id *** curry) $ fist (uncurry f)
fist3 :: (a->b->c->[(z,d)]) -> [(z,a->b->c->d)]
fist3 f = map (id *** curry3) $ fist (uncurry3 f)
fist4 :: (a->b->c->d->[(z,e)]) -> [(z,a->b->c->d->e)]
fist4 f = map (id *** curry4) $ fist (uncurry4 f)
fillings :: Expr -> [Expr] -> [Expr]
fillings e vs = [fill e f | f <- fs]
where
fs = productsList [[v | v <- vs, typ v == h] | h <- holes e]
expressionsOf :: [Expr] -> [[Expr]]
expressionsOf ds = [ds] \/ productMaybeWith ($$) es es `addWeight` 1
where
es = expressionsOf ds
valuedExpressionsOf :: Typeable a => [Expr] -> [[(Expr,a)]]
valuedExpressionsOf = mapTMaybe exprValue . expressionsOf
where
exprValue :: Typeable a => Expr -> Maybe (Expr,a)
exprValue e = (,) e `fmap` evaluate e