module Test.LeanCheck.Function.ListsOfPairs
( functionPairs
, associations
, pairsToFunction
, defaultFunPairsToFunction
)
where
import Test.LeanCheck
import Test.LeanCheck.Tiers
import Data.Maybe (fromMaybe)
instance (Eq a, Listable a, Listable b) => Listable (a -> b) where
tiers = mapT (uncurry $ flip defaultPairsToFunction)
$ functions list tiers
functions :: [[a]] -> [[b]] -> [[([(a,b)],b)]]
functions xss yss =
concatMapT
(\(r,yss) -> mapT (\ps -> (ps,r)) $ functionPairs xss yss)
(choices yss)
associations :: [a] -> [[b]] -> [[ [(a,b)] ]]
associations xs sbs = zip xs `mapT` products (const sbs `map` xs)
functionPairs :: [[a]] -> [[b]] -> [[[(a,b)]]]
functionPairs xss yss = concatMapT (`associations` yss)
(setsOf xss)
pairsToMaybeFunction :: Eq a => [(a,b)] -> a -> Maybe b
pairsToMaybeFunction [] _ = Nothing
pairsToMaybeFunction ((a',r):bs) a | a == a' = Just r
| otherwise = pairsToMaybeFunction bs a
pairsToFunction :: Eq a => [(a,b)] -> a -> b
pairsToFunction bs a = fromMaybe undefined (pairsToMaybeFunction bs a)
defaultPairsToFunction :: Eq a => b -> [(a,b)] -> a -> b
defaultPairsToFunction r bs a = fromMaybe r (pairsToMaybeFunction bs a)
defaultFunPairsToFunction :: Eq a => (a -> b) -> [(a,b)] -> a -> b
defaultFunPairsToFunction f bs a = fromMaybe (f a) (pairsToMaybeFunction bs a)