module Test.Feat.Access(
index,
values,
striped,
bounded,
featCheck,
ioFeat,
ioAll,
ioBounded,
Report,
inputRep,
prePostRep,
uniform,
toSeries,
valuesWith,
stripedWith,
boundedWith,
uniformWith,
toSeriesWith
)where
import Test.Feat.Enumerate
import Test.Feat.Class
import Data.List
import Data.Ratio((%))
import Test.QuickCheck
index :: Enumerable a => Integer -> a
index i0 = go (parts optimal) i0 where
go (Finite crd ix : ps) i = if i < crd then ix i else go ps (icrd)
go [] _ = error $ "index out of bounds: "++show i0
values :: Enumerable a => [(Integer,[a])]
values = valuesWith optimal
striped :: Enumerable a => Index -> Integer -> [(Integer,[a])]
striped = stripedWith optimal
bounded :: Enumerable a => Integer -> [(Integer,[a])]
bounded = boundedWith optimal
featCheck :: (Enumerable a, Show a) => Int -> (a -> Bool) -> IO ()
featCheck p prop = ioAll p (inputRep prop)
type Report a = a -> IO ()
ioFeat :: [(Integer,[a])] -> Report a -> IO ()
ioFeat vs f = go vs 0 0 where
go ((c,xs):xss) s tot = do
putStrLn $ "--- Testing "++show c++" values at size " ++ show s
mapM f xs
go xss (s+1) (tot + c)
go [] s tot = putStrLn $ "--- Done. Tested "++ show tot++" values"
ioAll :: Enumerable a => Int -> Report a -> IO ()
ioAll p = ioFeat (take p values)
ioBounded :: Enumerable a => Integer -> Int -> Report a -> IO ()
ioBounded n p = ioFeat (take p $ bounded n)
inputRep :: Show a => (a -> Bool) -> Report a
inputRep pred a = if pred a
then return ()
else do
putStrLn "Counterexample found:"
print a
putStrLn ""
prePostRep :: (Show a, Show b) => (a -> b) -> (a -> b -> Bool) -> Report a
prePostRep f pred a = let fa = f a in if pred a fa
then return ()
else do
putStrLn "Counterexample found. Input:"
print a
putStrLn "Output:"
print fa
putStrLn ""
uniform :: Enumerable a => Int -> Gen a
uniform = uniformWith optimal
toSeries :: Enumerable a => Int -> [a]
toSeries = toSeriesWith optimal
valuesWith :: Enumerate a -> [(Integer,[a])]
valuesWith = map fromFinite . parts
stripedWith :: Enumerate a -> Index -> Integer -> [(Integer,[a])]
stripedWith e o0 step = stripedWith' (parts e) o0 where
stripedWith' [] o = []
stripedWith' (Finite crd ix : ps) o =
(max 0 d,thisP) : stripedWith' ps o'
where
o' = if space <= 0 then ocrd else stepm1
thisP = map ix (genericTake d $ iterate (+step) o)
space = crd o
(d,m) = divMod space step
boundedWith :: Enumerate a -> Integer -> [(Integer,[a])]
boundedWith e n = map (samplePart n) $ parts e
samplePart :: Index -> Finite a -> (Integer,[a])
samplePart m (Finite crd ix) =
let step = crd % m
in if crd <= m
then (crd, map ix [0..crd 1])
else (m, map ix [ round (k * step)
| k <- map toRational [0..m1]])
uniformWith :: Enumerate a -> Int -> Gen a
uniformWith = uni . parts where
uni :: [Finite a] -> Int -> Gen a
uni [] _ = error "uniform: empty enumeration"
uni ps maxp = let (incl, rest) = splitAt maxp ps
fin = mconcat incl
in case fCard fin of
0 -> uni rest 1
_ -> do i <- choose (0,fCard fin1)
return (fIndex fin i)
toSeriesWith :: Enumerate a -> Int -> [a]
toSeriesWith e d = concat (take (d+1) $ map snd $ valuesWith e)